source: trunk/base/src/port1.0/portinstall.tcl @ 106615

Last change on this file since 106615 was 106615, checked in by jmr@…, 7 years ago

remove orphaned portinstall helper procs _fake_fileinfo_for_index and proc_disasm

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 16.2 KB
Line 
1# et:ts=4
2# portinstall.tcl
3# $Id: portinstall.tcl 106615 2013-06-01 05:15:31Z jmr@macports.org $
4#
5# Copyright (c) 2002 - 2004 Apple Inc.
6# Copyright (c) 2004 Robert Shaw <rshaw@opendarwin.org>
7# Copyright (c) 2005, 2007 - 2012 The MacPorts Project
8# All rights reserved.
9#
10# Redistribution and use in source and binary forms, with or without
11# modification, are permitted provided that the following conditions
12# are met:
13# 1. Redistributions of source code must retain the above copyright
14#    notice, this list of conditions and the following disclaimer.
15# 2. Redistributions in binary form must reproduce the above copyright
16#    notice, this list of conditions and the following disclaimer in the
17#    documentation and/or other materials provided with the distribution.
18# 3. Neither the name of Apple Inc. nor the names of its contributors
19#    may be used to endorse or promote products derived from this software
20#    without specific prior written permission.
21#
22# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
23# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
24# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
25# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
26# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
27# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
28# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
29# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
30# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
31# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32# POSSIBILITY OF SUCH DAMAGE.
33#
34
35package provide portinstall 1.0
36package require portutil 1.0
37package require registry2 2.0
38
39set org.macports.install [target_new org.macports.install portinstall::install_main]
40target_provides ${org.macports.install} install
41target_runtype ${org.macports.install} always
42target_requires ${org.macports.install} main archivefetch fetch checksum extract patch configure build destroot
43target_prerun ${org.macports.install} portinstall::install_start
44
45namespace eval portinstall {
46}
47
48# define options
49options install.asroot
50
51# Set defaults
52default install.asroot no
53
54set_ui_prefix
55
56proc portinstall::install_start {args} {
57    global UI_PREFIX subport version revision portvariants \
58           prefix registry_open registry.path
59    ui_notice "$UI_PREFIX [format [msgcat::mc "Installing %s @%s_%s%s"] $subport $version $revision $portvariants]"
60   
61    # start gsoc08-privileges
62    if {![file writable $prefix] || ([getuid] == 0 && [geteuid] != 0)} {
63        # if install location is not writable, need root privileges to install
64        # Also elevate if started as root, since 'file writable' doesn't seem
65        # to take euid into account.
66        elevateToRoot "install"
67    }
68    # end gsoc08-privileges
69   
70    if {![info exists registry_open]} {
71        registry::open [file join ${registry.path} registry registry.db]
72        set registry_open yes
73    }
74
75    # create any users and groups needed by the port
76    handle_add_users
77}
78
79proc portinstall::create_archive {location archive.type} {
80    global workpath destpath portpath subport version revision portvariants \
81           epoch os.platform PortInfo installPlist \
82           archive.env archive.cmd archive.pre_args archive.args \
83           archive.post_args archive.dir \
84           depends_fetch depends_extract depends_build depends_lib depends_run
85    set archive.env {}
86    set archive.cmd {}
87    set archive.pre_args {}
88    set archive.args {}
89    set archive.post_args {}
90    set archive.dir ${destpath}
91
92    switch -regex -- ${archive.type} {
93        cp(io|gz) {
94            set pax "pax"
95            if {[catch {set pax [findBinary $pax ${portutil::autoconf::pax_path}]} errmsg] == 0} {
96                ui_debug "Using $pax"
97                set archive.cmd "$pax"
98                set archive.pre_args {-w -v -x cpio}
99                if {[regexp {z$} ${archive.type}]} {
100                    set gzip "gzip"
101                    if {[catch {set gzip [findBinary $gzip ${portutil::autoconf::gzip_path}]} errmsg] == 0} {
102                        ui_debug "Using $gzip"
103                        set archive.args {.}
104                        set archive.post_args "| $gzip -c9 > ${location}"
105                    } else {
106                        ui_debug $errmsg
107                        return -code error "No '$gzip' was found on this system!"
108                    }
109                } else {
110                    set archive.args "-f ${location} ."
111                }
112            } else {
113                ui_debug $errmsg
114                return -code error "No '$pax' was found on this system!"
115            }
116        }
117        t(ar|bz|lz|xz|gz) {
118            set tar "tar"
119            if {[catch {set tar [findBinary $tar ${portutil::autoconf::tar_path}]} errmsg] == 0} {
120                ui_debug "Using $tar"
121                set archive.cmd "$tar"
122                set archive.pre_args {-cvf}
123                if {[regexp {z2?$} ${archive.type}]} {
124                    if {[regexp {bz2?$} ${archive.type}]} {
125                        set gzip "bzip2"
126                        set level 9
127                    } elseif {[regexp {lz$} ${archive.type}]} {
128                        set gzip "lzma"
129                        set level ""
130                    } elseif {[regexp {xz$} ${archive.type}]} {
131                        set gzip "xz"
132                        set level 6
133                    } else {
134                        set gzip "gzip"
135                        set level 9
136                    }
137                    if {[info exists portutil::autoconf::${gzip}_path]} {
138                        set hint [set portutil::autoconf::${gzip}_path]
139                    } else {
140                        set hint ""
141                    }
142                    if {[catch {set gzip [findBinary $gzip $hint]} errmsg] == 0} {
143                        ui_debug "Using $gzip"
144                        set archive.args {- .}
145                        set archive.post_args "| $gzip -c$level > ${location}"
146                    } else {
147                        ui_debug $errmsg
148                        return -code error "No '$gzip' was found on this system!"
149                    }
150                } else {
151                    set archive.args "${location} ."
152                }
153            } else {
154                ui_debug $errmsg
155                return -code error "No '$tar' was found on this system!"
156            }
157        }
158        xar {
159            set xar "xar"
160            if {[catch {set xar [findBinary $xar ${portutil::autoconf::xar_path}]} errmsg] == 0} {
161                ui_debug "Using $xar"
162                set archive.cmd "$xar"
163                set archive.pre_args {-cvf}
164                set archive.args "${location} ."
165            } else {
166                ui_debug $errmsg
167                return -code error "No '$xar' was found on this system!"
168            }
169        }
170        zip {
171            set zip "zip"
172            if {[catch {set zip [findBinary $zip ${portutil::autoconf::zip_path}]} errmsg] == 0} {
173                ui_debug "Using $zip"
174                set archive.cmd "$zip"
175                set archive.pre_args {-ry9}
176                set archive.args "${location} ."
177            } else {
178                ui_debug $errmsg
179                return -code error "No '$zip' was found on this system!"
180            }
181        }
182    }
183
184    set archive.fulldestpath [file dirname $location]
185    # Create archive destination path (if needed)
186    if {![file isdirectory ${archive.fulldestpath}]} {
187        file mkdir ${archive.fulldestpath}
188    }
189
190    # Create (if no files) destroot for archiving
191    if {![file isdirectory ${destpath}]} {
192        return -code error "no destroot found at: ${destpath}"
193    }
194
195    # Copy state file into destroot for archiving
196    # +STATE contains a copy of the MacPorts state information
197    set statefile [file join $workpath .macports.${subport}.state]
198    file copy -force $statefile [file join $destpath "+STATE"]
199
200    # Copy Portfile into destroot for archiving
201    # +PORTFILE contains a copy of the MacPorts Portfile
202    set portfile [file join $portpath Portfile]
203    file copy -force $portfile [file join $destpath "+PORTFILE"]
204
205    # Create some informational files that we don't really use just yet,
206    # but we may in the future in order to allow port installation from
207    # archives without a full "ports" tree of Portfiles.
208    #
209    # Note: These have been modeled after FreeBSD type package files to
210    # start. We can change them however we want for actual future use if
211    # needed.
212    #
213    # +COMMENT contains the port description
214    set fd [open [file join $destpath "+COMMENT"] w]
215    if {[exists description]} {
216        puts $fd "[option description]"
217    }
218    close $fd
219    # +DESC contains the port long_description and homepage
220    set fd [open [file join $destpath "+DESC"] w]
221    if {[exists long_description]} {
222        puts $fd "[option long_description]"
223    }
224    if {[exists homepage]} {
225        puts $fd "\nWWW: [option homepage]"
226    }
227    close $fd
228    # +CONTENTS contains the port version/name info and all installed
229    # files and checksums
230    set control [list]
231    set fd [open [file join $destpath "+CONTENTS"] w]
232    puts $fd "@name ${subport}-${version}_${revision}${portvariants}"
233    puts $fd "@portname ${subport}"
234    puts $fd "@portepoch ${epoch}"
235    puts $fd "@portversion ${version}"
236    puts $fd "@portrevision ${revision}"
237    puts $fd "@archs [get_canonical_archs]"
238    array set ourvariations $PortInfo(active_variants)
239    set vlist [lsort -ascii [array names ourvariations]]
240    foreach v $vlist {
241        if {$ourvariations($v) == "+"} {
242            puts $fd "@portvariant +${v}"
243        }
244    }
245
246    foreach key "depends_lib depends_run" {
247         if {[info exists $key]} {
248             foreach depspec [set $key] {
249                 set depname [lindex [split $depspec :] end]
250                 set dep [mport_lookup $depname]
251                 if {[llength $dep] < 2} {
252                     ui_debug "Dependency $depname not found"
253                 } else {
254                     array set portinfo [lindex $dep 1]
255                     set depver $portinfo(version)
256                     set deprev $portinfo(revision)
257                     puts $fd "@pkgdep $portinfo(name)-${depver}_${deprev}"
258                 }
259             }
260         }
261    }
262
263    # also save the contents for our own use later
264    set installPlist {}
265    fs-traverse -depth fullpath $destpath {
266        if {[file type $fullpath] == "directory"} {
267            continue
268        }
269        set relpath [strsed $fullpath "s|^$destpath/||"]
270        if {![regexp {^[+]} $relpath]} {
271            puts $fd "$relpath"
272            lappend installPlist [file join [file separator] $relpath]
273            if {[file isfile $fullpath]} {
274                ui_debug "checksum file: $fullpath"
275                set checksum [md5 file $fullpath]
276                puts $fd "@comment MD5:$checksum"
277            }
278        } else {
279            lappend control $relpath
280        }
281    }
282    foreach relpath $control {
283        puts $fd "@ignore"
284        puts $fd "$relpath"
285    }
286    close $fd
287
288    # Now create the archive
289    ui_debug "Creating [file tail $location]"
290    command_exec archive
291    ui_debug "Archive [file tail $location] packaged"
292
293    # Cleanup all control files when finished
294    set control_files [glob -nocomplain -types f [file join $destpath +*]]
295    foreach file $control_files {
296        ui_debug "removing file: $file"
297        file delete -force $file
298    }
299}
300
301proc portinstall::extract_contents {location type} {
302    set qflag ${portutil::autoconf::tar_q}
303    switch -- $type {
304        tbz -
305        tbz2 {
306            set raw_contents [exec [findBinary tar ${portutil::autoconf::tar_path}] -xOj${qflag}f $location ./+CONTENTS]
307        }
308        tgz {
309            set raw_contents [exec [findBinary tar ${portutil::autoconf::tar_path}] -xOz${qflag}f $location ./+CONTENTS]
310        }
311        tar {
312            set raw_contents [exec [findBinary tar ${portutil::autoconf::tar_path}] -xO${qflag}f $location ./+CONTENTS]
313        }
314        txz {
315            set raw_contents [exec [findBinary tar ${portutil::autoconf::tar_path}] -xO${qflag}f $location --use-compress-program [findBinary xz ""] ./+CONTENTS]
316        }
317        tlz {
318            set raw_contents [exec [findBinary tar ${portutil::autoconf::tar_path}] -xO${qflag}f $location --use-compress-program [findBinary lzma ""] ./+CONTENTS]
319        }
320        xar {
321            system "cd ${workpath} && [findBinary xar ${portutil::autoconf::xar_path}] -xf $location +CONTENTS"
322            set twostep 1
323        }
324        zip {
325            set raw_contents [exec [findBinary unzip ${portutil::autoconf::unzip_path}] -p $location +CONTENTS]
326        }
327        cpgz {
328            system "cd ${workpath} && [findBinary pax ${portutil::autoconf::pax_path}] -rzf $location +CONTENTS"
329            set twostep 1
330        }
331        cpio {
332            system "cd ${workpath} && [findBinary pax ${portutil::autoconf::pax_path}] -rf $location +CONTENTS"
333            set twostep 1
334        }
335    }
336    if {[info exists twostep]} {
337        set fd [open "${workpath}/+CONTENTS"]
338        set raw_contents [read $fd]
339        close $fd
340    }
341    set contents {}
342    set ignore 0
343    set sep [file separator]
344    foreach line [split $raw_contents \n] {
345        if {$ignore} {
346            set ignore 0
347            continue
348        }
349        if {[string index $line 0] != "@"} {
350            lappend contents "${sep}${line}"
351        } elseif {$line == "@ignore"} {
352            set ignore 1
353        }
354    }
355    return $contents
356}
357
358proc portinstall::install_main {args} {
359    global subport version portpath categories description long_description \
360    homepage depends_run package-install workdir workpath \
361    worksrcdir UI_PREFIX destroot revision maintainers user_options \
362    portvariants negated_variants targets depends_lib PortInfo epoch license \
363    os.platform os.major portarchivetype installPlist
364
365    set oldpwd [pwd]
366    if {$oldpwd == ""} {
367        set oldpwd $portpath
368    }
369
370    set location [get_portimage_path]
371    set archive_path [find_portarchive_path]
372    if {$archive_path != ""} {
373        set install_dir [file dirname $location]
374        file mkdir $install_dir
375        file rename -force $archive_path $install_dir
376        set location [file join $install_dir [file tail $archive_path]]
377        set current_archive_type [string range [file extension $location] 1 end]
378        set installPlist [extract_contents $location $current_archive_type]
379    } else {
380        # throws an error if an unsupported value has been configured
381        archiveTypeIsSupported $portarchivetype
382        # create archive from the destroot
383        create_archive $location $portarchivetype
384    }
385
386    # can't do this inside the write transaction due to deadlock issues with _get_dep_port
387    set dep_portnames [list]
388    foreach deplist {depends_lib depends_run} {
389        if {[info exists $deplist]} {
390            foreach dep [set $deplist] {
391                set dep_portname [_get_dep_port $dep]
392                if {$dep_portname != ""} {
393                    lappend dep_portnames $dep_portname
394                }
395            }
396        }
397    }
398
399    registry::write {
400
401        set regref [registry::entry create $subport $version $revision $portvariants $epoch]
402
403        if {[info exists user_options(ports_requested)]} {
404            $regref requested $user_options(ports_requested)
405        } else {
406            $regref requested 0
407        }
408        $regref os_platform ${os.platform}
409        $regref os_major ${os.major}
410        $regref archs [get_canonical_archs]
411        # Trick to have a portable GMT-POSIX epoch-based time.
412        $regref date [expr [clock scan now -gmt true] - [clock scan "1970-1-1 00:00:00" -gmt true]]
413        if {[info exists negated_variants]} {
414            $regref negated_variants $negated_variants
415        }
416
417        foreach dep_portname $dep_portnames {
418            $regref depends $dep_portname
419        }
420
421        $regref installtype image
422        $regref state imaged
423        $regref location $location
424
425        if {[info exists installPlist]} {
426            # register files
427            $regref map $installPlist
428        }
429       
430        # store portfile
431        set fd [open [file join ${portpath} Portfile]]
432        $regref portfile [read $fd]
433        close $fd
434    }
435
436    _cd $oldpwd
437    return 0
438}
Note: See TracBrowser for help on using the repository browser.