source: branches/gsoc09-logging/base/src/package1.0/portunarchive.tcl @ 52218

Last change on this file since 52218 was 52218, checked in by enl@…, 11 years ago

Merge from trunk

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 11.0 KB
Line 
1# vim:ts=4 sw=4 fo=croq
2# portunarchive.tcl
3# $Id: portunarchive.tcl 52218 2009-06-12 08:57:53Z enl@macports.org $
4#
5# Copyright (c) 2004 Robert Shaw <rshaw@opendarwin.org>
6# Copyright (c) 2002 - 2003 Apple Computer, Inc.
7# All rights reserved.
8#
9# Redistribution and use in source and binary forms, with or without
10# modification, are permitted provided that the following conditions
11# are met:
12# 1. Redistributions of source code must retain the above copyright
13#    notice, this list of conditions and the following disclaimer.
14# 2. Redistributions in binary form must reproduce the above copyright
15#    notice, this list of conditions and the following disclaimer in the
16#    documentation and/or other materials provided with the distribution.
17# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
18#    may be used to endorse or promote products derived from this software
19#    without specific prior written permission.
20#
21# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
22# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
23# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
25# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
26# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
27# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
28# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
29# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
30# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31# POSSIBILITY OF SUCH DAMAGE.
32#
33
34package provide portunarchive 1.0
35package require portutil 1.0
36
37set org.macports.unarchive [target_new org.macports.unarchive portunarchive::unarchive_main]
38target_runtype ${org.macports.unarchive} always
39target_init ${org.macports.unarchive} portunarchive::unarchive_init
40target_provides ${org.macports.unarchive} unarchive
41target_requires ${org.macports.unarchive} main
42target_prerun ${org.macports.unarchive} portunarchive::unarchive_start
43target_postrun ${org.macports.unarchive} portunarchive::unarchive_finish
44
45namespace eval portunarchive {
46}
47
48# defaults
49default unarchive.dir {${destpath}}
50default unarchive.env {}
51default unarchive.cmd {}
52default unarchive.pre_args {}
53default unarchive.args {}
54default unarchive.post_args {}
55
56default unarchive.srcpath {${portarchivepath}}
57default unarchive.type {}
58default unarchive.file {}
59default unarchive.path {}
60
61set_ui_prefix
62
63proc portunarchive::unarchive_init {args} {
64        global UI_PREFIX target_state_fd variations workpath
65        global ports_force ports_source_only ports_binary_only
66        global name version revision portvariants portpath
67        global unarchive.srcpath unarchive.type unarchive.file unarchive.path unarchive.fullsrcpath
68
69        # Check mode in case archive called directly by user
70        if {[option portarchivemode] != "yes"} {
71                return -code error "Archive mode is not enabled!"
72        }
73
74        # Define port variants if not already defined
75        if { ![info exists portvariants] } {
76                set portvariants ""
77                set vlist [lsort -ascii [array names variations]]
78                # Put together variants in the form +foo+bar for the archive name
79                foreach v $vlist {
80                        if { ![string equal $v [option os.platform]] && ![string equal $v [option os.arch]] } {
81                                set portvariants "${portvariants}+${v}"
82                        }
83                }
84        }
85
86        # Define archive directory, file, and path
87        if {![string equal ${unarchive.srcpath} ${workpath}] && ![string equal ${unarchive.srcpath} ""]} {
88                set unarchive.fullsrcpath [file join ${unarchive.srcpath} [option os.platform] [option os.arch]]
89        } else {
90            set unarchive.fullsrcpath ${unarchive.srcpath}
91        }
92
93        # Determine if unarchive should be skipped
94        set skipped 0
95        if {[check_statefile target org.macports.unarchive $target_state_fd]} {
96                return 0
97        } elseif {[info exists ports_source_only] && $ports_source_only == "yes"} {
98                ui_debug "Skipping unarchive ($name) since source-only is set"
99                set skipped 1
100        } elseif {[check_statefile target org.macports.destroot $target_state_fd]} {
101                ui_debug "Skipping unarchive ($name) since destroot completed"
102                set skipped 1
103        } elseif {[info exists ports_force] && $ports_force == "yes"} {
104                ui_debug "Skipping unarchive ($name) since force is set"
105                set skipped 1
106        } else {
107                set found 0
108                set unsupported 0
109                foreach unarchive.type [option portarchivetype] {
110                        if {[catch {archiveTypeIsSupported ${unarchive.type}} errmsg] == 0} {
111                                set unarchive.file "${name}-${version}_${revision}${portvariants}.[option os.arch].${unarchive.type}"
112                                set unarchive.path "[file join ${unarchive.fullsrcpath} ${unarchive.file}]"
113                                if {[file exist ${unarchive.path}]} {
114                                        set found 1
115                                        break
116                                } else {
117                                        ui_debug "No [string toupper ${unarchive.type}] archive: ${unarchive.path}"
118                                }
119                        } else {
120                                ui_debug "Skipping [string toupper ${unarchive.type}] archive: $errmsg"
121                                set unsupported [expr $unsupported + 1]
122                        }
123                }
124                if {$found == 1} {
125                        ui_debug "Found [string toupper ${unarchive.type}] archive: ${unarchive.path}"
126                } else {
127                        if {[info exists ports_binary_only] && $ports_binary_only == "yes"} {
128                                return -code error "Archive for ${name} ${version}_${revision}${portvariants} not found, required when binary-only is set!"
129                        } else {
130                                if {[llength [option portarchivetype]] == $unsupported} {
131                                        ui_debug "Skipping unarchive ($name) since specified archive types not supported"
132                                } else {
133                                        ui_debug "Skipping unarchive ($name) since no archive found"
134                                }
135                                set skipped 1
136                        }
137                }
138        }
139        # Skip unarchive target by setting state
140        if {$skipped == 1} {
141                write_statefile target "org.macports.unarchive" $target_state_fd
142        }
143
144        return 0
145}
146
147proc portunarchive::unarchive_start {args} {
148        global UI_PREFIX name version revision portvariants
149        global unarchive.type
150
151        ui_msg "$UI_PREFIX [format [msgcat::mc "Unpacking ${unarchive.type} archive for %s %s_%s%s"] $name $version $revision $portvariants]"
152
153        return 0
154}
155
156proc portunarchive::unarchive_command_setup {args} {
157        global unarchive.env unarchive.cmd
158        global unarchive.pre_args unarchive.args unarchive.post_args
159        global unarchive.type unarchive.path
160        global unarchive.pipe_cmd
161        global os.platform os.version env
162
163        # Define appropriate unarchive command and options
164        set unarchive.env {}
165        set unarchive.cmd {}
166        set unarchive.pre_args {}
167        set unarchive.args {}
168        set unarchive.post_args {}
169        set unarchive.pipe_cmd ""
170        switch -regex ${unarchive.type} {
171                cp(io|gz) {
172                        set pax "pax"
173                        if {[catch {set pax [findBinary $pax ${portutil::autoconf::pax_path}]} errmsg] == 0} {
174                                ui_debug "Using $pax"
175                                set unarchive.cmd "$pax"
176                                if {[info exists env(USER)] && $env(USER) == "root"} {
177                                        set unarchive.pre_args {-r -v -p e}
178                                } else {
179                                        set unarchive.pre_args {-r -v -p p}
180                                }
181                                if {[regexp {z$} ${unarchive.type}]} {
182                                        set unarchive.args {.}
183                                        set gzip "gzip"
184                                        if {[catch {set gzip [findBinary $gzip ${portutil::autoconf::gzip_path}]} errmsg] == 0} {
185                                                ui_debug "Using $gzip"
186                                                set unarchive.pipe_cmd "$gzip -d -c ${unarchive.path} |"
187                                        } else {
188                                                ui_debug $errmsg
189                                                return -code error "No '$gzip' was found on this system!"
190                                        }
191                                } else {
192                                        set unarchive.args "-f ${unarchive.path} ."
193                                }
194                        } else {
195                                ui_debug $errmsg
196                                return -code error "No '$pax' was found on this system!"
197                        }
198                }
199                t(ar|bz|lz|xz|gz) {
200                        set tar "tar"
201                        if {[catch {set tar [findBinary $tar ${portutil::autoconf::tar_path}]} errmsg] == 0} {
202                                ui_debug "Using $tar"
203                                set unarchive.cmd "$tar"
204                                set unarchive.pre_args {-xvpf}
205                                if {[regexp {z2?$} ${unarchive.type}]} {
206                                        set unarchive.args {-}
207                                        if {[regexp {bz2?$} ${unarchive.type}]} {
208                                                set gzip "bzip2"
209                                        } elseif {[regexp {lz$} ${unarchive.type}]} {
210                                                set gzip "lzma"
211                                        } elseif {[regexp {xz$} ${unarchive.type}]} {
212                                                set gzip "xz"
213                                        } else {
214                                                set gzip "gzip"
215                                        }
216                                        if {[info exists portutil::autoconf::${gzip}_path]} {
217                                            set hint [set portutil::autoconf::${gzip}_path]
218                                        } else {
219                                            set hint ""
220                                        }
221                                        if {[catch {set gzip [findBinary $gzip $hint]} errmsg] == 0} {
222                                                ui_debug "Using $gzip"
223                                                set unarchive.pipe_cmd "$gzip -d -c ${unarchive.path} |"
224                                        } else {
225                                                ui_debug $errmsg
226                                                return -code error "No '$gzip' was found on this system!"
227                                        }
228                                } else {
229                                        set unarchive.args "${unarchive.path}"
230                                }
231                        } else {
232                                ui_debug $errmsg
233                                return -code error "No '$tar' was found on this system!"
234                        }
235                }
236                xar {
237                        set xar "xar"
238                        if {[catch {set xar [findBinary $xar ${portutil::autoconf::xar_path}]} errmsg] == 0} {
239                                ui_debug "Using $xar"
240                                set unarchive.cmd "$xar"
241                                set unarchive.pre_args {-xvpf}
242                                set unarchive.args "${unarchive.path}"
243                        } else {
244                                ui_debug $errmsg
245                                return -code error "No '$xar' was found on this system!"
246                        }
247                }
248                zip {
249                        set unzip "unzip"
250                        if {[catch {set unzip [findBinary $unzip ${portutil::autoconf::unzip_path}]} errmsg] == 0} {
251                                ui_debug "Using $unzip"
252                                set unarchive.cmd "$unzip"
253                                if {[info exists env(USER)] && $env(USER) == "root"} {
254                                        set unarchive.pre_args {-oX}
255                                } else {
256                                        set unarchive.pre_args {-o}
257                                }
258                                set unarchive.args "${unarchive.path} -d ."
259                        } else {
260                                ui_debug $errmsg
261                                return -code error "No '$unzip' was found on this system!"
262                        }
263                }
264                default {
265                        return -code error "Invalid port archive type '${unarchive.type}' specified!"
266                }
267        }
268
269        return 0
270}
271
272proc portunarchive::unarchive_main {args} {
273        global UI_PREFIX
274        global name version revision portvariants
275        global unarchive.dir unarchive.file unarchive.pipe_cmd
276
277        # Setup unarchive command
278        unarchive_command_setup
279
280        # Create destination directory for unpacking
281        if {![file isdirectory ${unarchive.dir}]} {
282                file mkdir ${unarchive.dir}
283        }
284
285        # Unpack the archive
286        ui_info "$UI_PREFIX [format [msgcat::mc "Extracting %s"] ${unarchive.file}]"
287        if {${unarchive.pipe_cmd} == ""} {
288                command_exec unarchive
289        } else {
290                command_exec unarchive "${unarchive.pipe_cmd} (" ")"
291        }
292
293        return 0
294}
295
296proc portunarchive::unarchive_finish {args} {
297        global UI_PREFIX target_state_fd unarchive.file name workpath destpath
298
299        # Reset state file with archive version
300    set statefile [file join $workpath .macports.${name}.state]
301        file copy -force [file join $destpath "+STATE"] $statefile
302        file mtime $statefile [clock seconds]
303
304# Hack to temporarily move com.apple.* strings in statefiles extracted from old archives
305# to the org.macports.* namespace. "temporarily" because old archives will still have a
306# +STATE file with the old strings in it, as we only update them on the unpacked statefile.
307    set fd_new_sf [open $statefile r]
308    set fd_tmp [open ${statefile}.tmp w+]
309    while {[gets $fd_new_sf line] >= 0} {
310        puts $fd_tmp "[regsub com.apple $line org.macports]"
311    }
312    close $fd_new_sf
313    close $fd_tmp
314    file rename -force ${statefile}.tmp $statefile
315
316    # Update the state from unpacked archive version
317    set target_state_fd [open_statefile]
318   
319        # Cleanup all control files when finished
320        set control_files [glob -nocomplain -types f [file join $destpath +*]]
321        foreach file $control_files {
322                ui_debug "Removing $file"
323                file delete -force $file
324        }
325
326        ui_info "$UI_PREFIX [format [msgcat::mc "Archive %s unpacked"] ${unarchive.file}]"
327        return 0
328}
329
Note: See TracBrowser for help on using the repository browser.