source: branches/gsoc09-logging/base/src/package1.0/portarchive.tcl @ 51384

Last change on this file since 51384 was 51384, 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: 16.3 KB
Line 
1# vim:ts=4 sw=4 fo=croq
2# portarchive.tcl
3# $Id: portarchive.tcl 51384 2009-05-23 20:29:46Z 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 portarchive 1.0
35package require portutil 1.0
36
37set org.macports.archive [target_new org.macports.archive portarchive::archive_main]
38target_init ${org.macports.archive} portarchive::archive_init
39target_provides ${org.macports.archive} archive
40target_requires ${org.macports.archive} main unarchive fetch extract checksum patch configure build destroot
41target_prerun ${org.macports.archive} portarchive::archive_start
42target_postrun ${org.macports.archive} portarchive::archive_finish
43
44namespace eval portarchive {
45}
46
47# defaults
48default archive.dir {${destpath}}
49default archive.env {}
50default archive.cmd {}
51default archive.pre_args {}
52default archive.args {}
53default archive.post_args {}
54
55default archive.destpath {${portarchivepath}}
56default archive.type {}
57default archive.file {}
58default archive.path {}
59
60default archive.meta false
61default archive.metaname {}
62default archive.metapath {}
63
64set_ui_prefix
65
66proc portarchive::archive_init {args} {
67        global UI_PREFIX target_state_fd
68        global variations package.destpath workpath
69        global ports_force ports_source_only ports_binary_only
70        global portname portversion portrevision portvariants
71        global archive.destpath archive.type archive.meta
72        global archive.file archive.path archive.fulldestpath
73
74        # Check mode in case archive called directly by user
75        if {[option portarchivemode] != "yes"} {
76                return -code error "Archive mode is not enabled!"
77        }
78
79        # Define port variants if not already defined
80        if { ![info exists portvariants] } {
81                set portvariants ""
82                set vlist [lsort -ascii [array names variations]]
83                # Put together variants in the form +foo+bar for the archive name
84                foreach v $vlist {
85                        if { ![string equal $v [option os.platform]] && ![string equal $v [option os.arch]] } {
86                                set portvariants "${portvariants}+${v}"
87                        }
88                }
89        }
90
91        # Define archive destination directory and target filename
92        if {![string equal ${archive.destpath} ${workpath}] && ![string equal ${archive.destpath} ""]} {
93                set archive.fulldestpath [file join ${archive.destpath} [option os.platform] [option os.arch]]
94        } else {
95            set archive.fulldestpath ${archive.destpath}
96        }
97
98        # Determine if archive should be skipped
99        set skipped 0
100        if {[check_statefile target org.macports.archive $target_state_fd]} {
101                return 0
102        } elseif {[check_statefile target org.macports.unarchive $target_state_fd] && ([info exists ports_binary_only] && $ports_binary_only == "yes")} {
103                ui_debug "Skipping archive ($portname) since binary-only is set"
104                set skipped 1
105        } elseif {[info exists ports_source_only] && $ports_source_only == "yes"} {
106                ui_debug "Skipping archive ($portname) since source-only is set"
107                set skipped 1
108        } else {
109                set unsupported 0
110                set any_missing no
111                foreach archive.type [option portarchivetype] {
112                        if {[catch {archiveTypeIsSupported ${archive.type}} errmsg] == 0} {
113                                set archive.file "${portname}-${portversion}_${portrevision}${portvariants}.[option os.arch].${archive.type}"
114                                set archive.path "[file join ${archive.fulldestpath} ${archive.file}]"
115                                if {![file exists ${archive.path}]} {
116                                    set any_missing yes
117                                }
118                        } else {
119                                ui_debug "Skipping [string toupper ${archive.type}] archive: $errmsg"
120                                set unsupported [expr $unsupported + 1]
121                        }
122                }
123                if {!$any_missing} {
124                        # might be nice to allow forcing, but let's fix #16061 first
125                        ui_debug "Skipping archive ($portname) since archive(s) already exist"
126                        set skipped 1
127                }
128                if {${archive.type} == "xpkg"} {
129                        set archive.meta true
130                }
131                if {[llength [option portarchivetype]] == $unsupported} {
132                        ui_debug "Skipping archive ($portname) since specified archive types not supported"
133                        set skipped 1
134                }
135        }
136        # Skip archive target by setting state
137        if {$skipped == 1} {
138                write_statefile target "org.macports.archive" $target_state_fd
139        }
140
141        return 0
142}
143
144proc portarchive::archive_start {args} {
145        global UI_PREFIX
146        global portname portversion portrevision portvariants
147
148        if {[llength [option portarchivetype]] > 1} {
149                ui_msg "$UI_PREFIX [format [msgcat::mc "Packaging [join [option portarchivetype] {, }] archives for %s %s_%s%s"] $portname $portversion $portrevision $portvariants]"
150        } else {
151                ui_msg "$UI_PREFIX [format [msgcat::mc "Packaging [option portarchivetype] archive for %s %s_%s%s"] $portname $portversion $portrevision $portvariants]"
152        }
153
154        return 0
155}
156
157proc portarchive::archive_command_setup {args} {
158        global archive.env archive.cmd
159        global archive.pre_args archive.args archive.post_args
160        global archive.type archive.path
161        global archive.metaname archive.metapath
162        global os.platform os.version
163
164        # Define appropriate archive command and options
165        set archive.env {}
166        set archive.cmd {}
167        set archive.pre_args {}
168        set archive.args {}
169        set archive.post_args {}
170        switch -regex ${archive.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 archive.cmd "$pax"
176                                set archive.pre_args {-w -v -x cpio}
177                                if {[regexp {z$} ${archive.type}]} {
178                                        set gzip "gzip"
179                                        if {[catch {set gzip [findBinary $gzip ${portutil::autoconf::gzip_path}]} errmsg] == 0} {
180                                                ui_debug "Using $gzip"
181                                                set archive.args {.}
182                                                set archive.post_args "| $gzip -c9 > ${archive.path}"
183                                        } else {
184                                                ui_debug $errmsg
185                                                return -code error "No '$gzip' was found on this system!"
186                                        }
187                                } else {
188                                        set archive.args "-f ${archive.path} ."
189                                }
190                        } else {
191                                ui_debug $errmsg
192                                return -code error "No '$pax' was found on this system!"
193                        }
194                }
195                t(ar|bz|lz|xz|gz) {
196                        set tar "tar"
197                        if {[catch {set tar [findBinary $tar ${portutil::autoconf::tar_path}]} errmsg] == 0} {
198                                ui_debug "Using $tar"
199                                set archive.cmd "$tar"
200                                set archive.pre_args {-cvf}
201                                if {[regexp {z2?$} ${archive.type}]} {
202                                        if {[regexp {bz2?$} ${archive.type}]} {
203                                                set gzip "bzip2"
204                                                set level 9
205                                        } elseif {[regexp {lz$} ${archive.type}]} {
206                                                set gzip "lzma"
207                                                set level 7
208                                        } elseif {[regexp {xz$} ${archive.type}]} {
209                                                set gzip "xz"
210                                                set level 6
211                                        } else {
212                                                set gzip "gzip"
213                                                set level 9
214                                        }
215                                        if {[info exists portutil::autoconf::${gzip}_path]} {
216                                            set hint [set portutil::autoconf::${gzip}_path]
217                                        } else {
218                                            set hint ""
219                                        }
220                                        if {[catch {set gzip [findBinary $gzip $hint]} errmsg] == 0} {
221                                                ui_debug "Using $gzip"
222                                                set archive.args {- .}
223                                                set archive.post_args "| $gzip -c$level > ${archive.path}"
224                                        } else {
225                                                ui_debug $errmsg
226                                                return -code error "No '$gzip' was found on this system!"
227                                        }
228                                } else {
229                                        set archive.args "${archive.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 archive.cmd "$xar"
241                                set archive.pre_args {-cvf}
242                                set archive.args "${archive.path} ."
243                        } else {
244                                ui_debug $errmsg
245                                return -code error "No '$xar' was found on this system!"
246                        }
247                }
248                xpkg {
249                        set xar "xar"
250                        set compression "bzip2"
251                        if {[catch {set xar [findBinary $xar ${portutil::autoconf::xar_path}]} errmsg] == 0} {
252                                ui_debug "Using $xar"
253                                set archive.cmd "$xar"
254                                set archive.pre_args "-cv --exclude='\./\+.*' --compression=${compression} -n ${archive.metaname} -s ${archive.metapath} -f"
255                                set archive.args "${archive.path} ."
256                        } else {
257                                ui_debug $errmsg
258                                return -code error "No '$xar' was found on this system!"
259                        }
260                }
261                zip {
262                        set zip "zip"
263                        if {[catch {set zip [findBinary $zip ${portutil::autoconf::zip_path}]} errmsg] == 0} {
264                                ui_debug "Using $zip"
265                                set archive.cmd "$zip"
266                                set archive.pre_args {-ry9}
267                                set archive.args "${archive.path} ."
268                        } else {
269                                ui_debug $errmsg
270                                return -code error "No '$zip' was found on this system!"
271                        }
272                }
273                default {
274                        return -code error "Invalid port archive type '${archive.type}' specified!"
275                }
276        }
277
278        return 0
279}
280
281proc portarchive::putel { fd el data } {
282        # Quote xml data
283        set quoted [string map  { & &amp; < &lt; > &gt; } $data]
284        # Write the element
285        puts $fd "<${el}>${quoted}</${el}>"
286}
287
288proc portarchive::putlist { fd listel itemel list } {
289        puts $fd "<$listel>"
290        foreach item $list {
291                putel $fd $itemel $item
292        }
293        puts $fd "</$listel>"
294}
295
296proc portarchive::archive_main {args} {
297        global UI_PREFIX variations
298        global workpath destpath portpath ports_force
299        global portname portepoch portversion portrevision portvariants
300        global archive.fulldestpath archive.type archive.file archive.path
301        global archive.meta archive.metaname archive.metapath
302        global os.platform os.arch
303
304        # Create archive destination path (if needed)
305        if {![file isdirectory ${archive.fulldestpath}]} {
306                system "mkdir -p ${archive.fulldestpath}"
307        }
308
309        # Create (if no files) destroot for archiving
310        if {![file isdirectory ${destpath}]} {
311                system "mkdir -p ${destpath}"
312        }
313
314        # Copy state file into destroot for archiving
315        # +STATE contains a copy of the MacPorts state information
316    set statefile [file join $workpath .macports.${portname}.state]
317        file copy -force $statefile [file join $destpath "+STATE"]
318
319        # Copy Portfile into destroot for archiving
320        # +PORTFILE contains a copy of the MacPorts Portfile
321    set portfile [file join $portpath Portfile]
322        file copy -force $portfile [file join $destpath "+PORTFILE"]
323
324        # Create some informational files that we don't really use just yet,
325        # but we may in the future in order to allow port installation from
326        # archives without a full "ports" tree of Portfiles.
327        #
328        # Note: These have been modeled after FreeBSD type package files to
329        # start. We can change them however we want for actual future use if
330        # needed.
331        #
332        # +COMMENT contains the port description
333        set fd [open [file join $destpath "+COMMENT"] w]
334    if {[exists description]} {
335                puts $fd "[option description]"
336        }
337        close $fd
338        # +DESC contains the port long_description and homepage
339        set fd [open [file join $destpath "+DESC"] w]
340        if {[exists long_description]} {
341                puts $fd "[option long_description]"
342        }
343        if {[exists homepage]} {
344                puts $fd "\nWWW: [option homepage]"
345        }
346        close $fd
347        # +CONTENTS contains the port version/name info and all installed
348        # files and checksums
349        set control [list]
350        set fd [open [file join $destpath "+CONTENTS"] w]
351        puts $fd "@name ${portname}-${portversion}_${portrevision}${portvariants}"
352        puts $fd "@portname ${portname}"
353        puts $fd "@portepoch ${portepoch}"
354        puts $fd "@portversion ${portversion}"
355        puts $fd "@portrevision ${portrevision}"
356        set vlist [lsort -ascii [array names variations]]
357        foreach v $vlist {
358                if {![string equal $v [option os.platform]] && ![string equal $v [option os.arch]]} {
359                        puts $fd "@portvariant +${v}"
360                }
361        }
362        foreach fullpath [exec find $destpath ! -type d] {
363                set relpath [strsed $fullpath "s|^$destpath/||"]
364                if {![regexp {^[+]} $relpath]} {
365                        puts $fd "$relpath"
366                        if {[file isfile $fullpath]} {
367                                ui_debug "checksum file: $fullpath"
368                                set checksum [md5 file $fullpath]
369                                puts $fd "@comment MD5:$checksum"
370                        }
371                } else {
372                        lappend control $relpath
373                }
374        }
375        foreach relpath $control {
376                puts $fd "@ignore"
377                puts $fd "$relpath"
378        }
379        close $fd
380
381        # the XML package metadata, for XAR package
382        # (doesn't contain any file list/checksums)
383        if {${archive.meta}} {
384                set archive.metaname "xpkg"
385                set archive.metapath [file join $workpath "${archive.metaname}.xml"]
386                set sd [open ${archive.metapath} w]
387                puts $sd "<xpkg version='0.2'>"
388                # TODO: split contents into <buildinfo> (new) and <package> (current)
389                #       see existing <portpkg> for the matching source package layout
390
391                putel $sd name ${portname}
392                putel $sd epoch ${portepoch}
393                putel $sd version ${portversion}
394                putel $sd revision ${portrevision}
395                putel $sd major 0
396                putel $sd minor 0
397
398                putel $sd platform ${os.platform}
399                putel $sd arch ${os.arch}
400                set vlist [lsort -ascii [array names variations]]
401                putlist $sd variants variant $vlist
402
403                if {[exists categories]} {
404                        set primary [lindex [split [option categories] " "] 0]
405                        putel $sd category $primary
406                }
407                if {[exists description]} {
408                        putel $sd comment "[option description]"
409                }
410                if {[exists long_description]} {
411                        putel $sd desc "[option long_description]"
412                }
413                if {[exists homepage]} {
414                        putel $sd homepage "[option homepage]"
415                }
416
417            # Emit dependencies provided by this package
418            puts $sd "<provides>"
419                set name ${portname}
420                puts $sd "<item>"
421                putel $sd name $name
422                putel $sd major 0
423                putel $sd minor 0
424                puts $sd "</item>"
425            puts $sd "</provides>"
426           
427    set res [mport_lookup $portname]
428    if {[llength $res] < 2} {
429        ui_error "Dependency $portname not found"
430    } else {
431    array set portinfo [lindex $res 1]
432
433            # Emit build, library, and runtime dependencies
434            puts $sd "<requires>"
435            foreach {key type} {
436                depends_build "build"
437                depends_lib "library"
438                depends_run "runtime"
439            } {
440                if {[info exists portinfo($key)]} {
441                    set name [lindex [split $portinfo($key) :] end]
442                    puts $sd "<item type=\"$type\">"
443                    putel $sd name $name
444                    putel $sd major 0
445                    putel $sd minor 0
446                    puts $sd "</item>"
447                }
448            }
449            puts $sd "</requires>"
450    }
451
452                puts $sd "</xpkg>"
453                close $sd
454        }
455
456        # Now create the archive(s)
457        # Loop through archive types
458        foreach archive.type [option portarchivetype] {
459                if {[catch {archiveTypeIsSupported ${archive.type}} errmsg] == 0} {
460                        # Define archive file/path
461                        set archive.file "${portname}-${portversion}_${portrevision}${portvariants}.[option os.arch].${archive.type}"
462                        set archive.path "[file join ${archive.fulldestpath} ${archive.file}]"
463
464                        # Setup archive command
465                        archive_command_setup
466
467                        # Remove existing archive
468                        if {[file exists ${archive.path}]} {
469                                ui_info "$UI_PREFIX [format [msgcat::mc "Deleting previous %s"] ${archive.file}]"
470                                file delete -force ${archive.path}
471                        }
472
473                        ui_info "$UI_PREFIX [format [msgcat::mc "Creating %s"] ${archive.file}]"
474                        command_exec archive
475                        ui_info "$UI_PREFIX [format [msgcat::mc "Archive %s packaged"] ${archive.file}]"
476                }
477        }
478
479    return 0
480}
481
482proc portarchive::archive_finish {args} {
483        global UI_PREFIX
484        global portname portversion portrevision portvariants
485        global destpath
486
487        # Cleanup all control files when finished
488        set control_files [glob -nocomplain -types f [file join $destpath +*]]
489        foreach file $control_files {
490                ui_debug "removing file: $file"
491                file delete -force $file
492        }
493
494        if {[llength [option portarchivetype]] > 1} {
495                ui_info "$UI_PREFIX [format [msgcat::mc "Archives for %s %s_%s%s packaged"] $portname $portversion $portrevision $portvariants]"
496        } else {
497                ui_info "$UI_PREFIX [format [msgcat::mc "Archive for %s %s_%s%s packaged"] $portname $portversion $portrevision $portvariants]"
498        }
499        return 0
500}
501
Note: See TracBrowser for help on using the repository browser.