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

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

bring back clean --archive since files can persist in incoming/ in some circumstances

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 14.3 KB
Line 
1# et:ts=4
2# portinstall.tcl
3# $Id: portinstall.tcl 106617 2013-06-01 08:55:55Z 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    return [extract_archive_metadata $location $type contents]
303}
304
305proc portinstall::install_main {args} {
306    global subport version portpath categories description long_description \
307    homepage depends_run package-install workdir workpath \
308    worksrcdir UI_PREFIX destroot revision maintainers user_options \
309    portvariants negated_variants targets depends_lib PortInfo epoch license \
310    os.platform os.major portarchivetype installPlist
311
312    set oldpwd [pwd]
313    if {$oldpwd == ""} {
314        set oldpwd $portpath
315    }
316
317    set location [get_portimage_path]
318    set archive_path [find_portarchive_path]
319    if {$archive_path != ""} {
320        set install_dir [file dirname $location]
321        file mkdir $install_dir
322        file rename -force $archive_path $install_dir
323        set location [file join $install_dir [file tail $archive_path]]
324        set current_archive_type [string range [file extension $location] 1 end]
325        set installPlist [extract_contents $location $current_archive_type]
326    } else {
327        # throws an error if an unsupported value has been configured
328        archiveTypeIsSupported $portarchivetype
329        # create archive from the destroot
330        create_archive $location $portarchivetype
331    }
332
333    # can't do this inside the write transaction due to deadlock issues with _get_dep_port
334    set dep_portnames [list]
335    foreach deplist {depends_lib depends_run} {
336        if {[info exists $deplist]} {
337            foreach dep [set $deplist] {
338                set dep_portname [_get_dep_port $dep]
339                if {$dep_portname != ""} {
340                    lappend dep_portnames $dep_portname
341                }
342            }
343        }
344    }
345
346    registry::write {
347
348        set regref [registry::entry create $subport $version $revision $portvariants $epoch]
349
350        if {[info exists user_options(ports_requested)]} {
351            $regref requested $user_options(ports_requested)
352        } else {
353            $regref requested 0
354        }
355        $regref os_platform ${os.platform}
356        $regref os_major ${os.major}
357        $regref archs [get_canonical_archs]
358        # Trick to have a portable GMT-POSIX epoch-based time.
359        $regref date [expr [clock scan now -gmt true] - [clock scan "1970-1-1 00:00:00" -gmt true]]
360        if {[info exists negated_variants]} {
361            $regref negated_variants $negated_variants
362        }
363
364        foreach dep_portname $dep_portnames {
365            $regref depends $dep_portname
366        }
367
368        $regref installtype image
369        $regref state imaged
370        $regref location $location
371
372        if {[info exists installPlist]} {
373            # register files
374            $regref map $installPlist
375        }
376       
377        # store portfile
378        set fd [open [file join ${portpath} Portfile]]
379        $regref portfile [read $fd]
380        close $fd
381    }
382
383    _cd $oldpwd
384    return 0
385}
Note: See TracBrowser for help on using the repository browser.