source: branches/gsoc09-logging/base/src/package1.0/portarchive.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: 16.2 KB
Line 
1# vim:ts=4 sw=4 fo=croq
2# portarchive.tcl
3# $Id: portarchive.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 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 name version revision 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 ($name) 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 ($name) 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 "${name}-${version}_${revision}${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 ($name) 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 ($name) 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 name version revision 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"] $name $version $revision $portvariants]"
150        } else {
151                ui_msg "$UI_PREFIX [format [msgcat::mc "Packaging [option portarchivetype] archive for %s %s_%s%s"] $name $version $revision $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 name epoch version revision 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.${name}.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 ${name}-${version}_${revision}${portvariants}"
352        puts $fd "@portname ${name}"
353        puts $fd "@portepoch ${epoch}"
354        puts $fd "@portversion ${version}"
355        puts $fd "@portrevision ${revision}"
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        fs-traverse fullpath $destpath {
363            if {[file isdirectory $fullpath]} {
364                continue
365            }
366                set relpath [strsed $fullpath "s|^$destpath/||"]
367                if {![regexp {^[+]} $relpath]} {
368                        puts $fd "$relpath"
369                        if {[file isfile $fullpath]} {
370                                ui_debug "checksum file: $fullpath"
371                                set checksum [md5 file $fullpath]
372                                puts $fd "@comment MD5:$checksum"
373                        }
374                } else {
375                        lappend control $relpath
376                }
377        }
378        foreach relpath $control {
379                puts $fd "@ignore"
380                puts $fd "$relpath"
381        }
382        close $fd
383
384        # the XML package metadata, for XAR package
385        # (doesn't contain any file list/checksums)
386        if {${archive.meta}} {
387                set archive.metaname "xpkg"
388                set archive.metapath [file join $workpath "${archive.metaname}.xml"]
389                set sd [open ${archive.metapath} w]
390                puts $sd "<xpkg version='0.2'>"
391                # TODO: split contents into <buildinfo> (new) and <package> (current)
392                #       see existing <portpkg> for the matching source package layout
393
394                putel $sd name ${name}
395                putel $sd epoch ${epoch}
396                putel $sd version ${version}
397                putel $sd revision ${revision}
398                putel $sd major 0
399                putel $sd minor 0
400
401                putel $sd platform ${os.platform}
402                putel $sd arch ${os.arch}
403                set vlist [lsort -ascii [array names variations]]
404                putlist $sd variants variant $vlist
405
406                if {[exists categories]} {
407                        set primary [lindex [split [option categories] " "] 0]
408                        putel $sd category $primary
409                }
410                if {[exists description]} {
411                        putel $sd comment "[option description]"
412                }
413                if {[exists long_description]} {
414                        putel $sd desc "[option long_description]"
415                }
416                if {[exists homepage]} {
417                        putel $sd homepage "[option homepage]"
418                }
419
420            # Emit dependencies provided by this package
421            puts $sd "<provides>"
422                set name ${name}
423                puts $sd "<item>"
424                putel $sd name $name
425                putel $sd major 0
426                putel $sd minor 0
427                puts $sd "</item>"
428            puts $sd "</provides>"
429           
430    set res [mport_lookup $name]
431    if {[llength $res] < 2} {
432        ui_error "Dependency $name not found"
433    } else {
434    array set portinfo [lindex $res 1]
435
436            # Emit build, library, and runtime dependencies
437            puts $sd "<requires>"
438            foreach {key type} {
439                depends_fetch "fetch"
440                depends_extract "extract"
441                depends_build "build"
442                depends_lib "library"
443                depends_run "runtime"
444            } {
445                if {[info exists portinfo($key)]} {
446                    set name [lindex [split $portinfo($key) :] end]
447                    puts $sd "<item type=\"$type\">"
448                    putel $sd name $name
449                    putel $sd major 0
450                    putel $sd minor 0
451                    puts $sd "</item>"
452                }
453            }
454            puts $sd "</requires>"
455    }
456
457                puts $sd "</xpkg>"
458                close $sd
459        }
460
461        # Now create the archive(s)
462        # Loop through archive types
463        foreach archive.type [option portarchivetype] {
464                if {[catch {archiveTypeIsSupported ${archive.type}} errmsg] == 0} {
465                        # Define archive file/path
466                        set archive.file "${name}-${version}_${revision}${portvariants}.[option os.arch].${archive.type}"
467                        set archive.path "[file join ${archive.fulldestpath} ${archive.file}]"
468
469                        # Setup archive command
470                        archive_command_setup
471
472                        # Remove existing archive
473                        if {[file exists ${archive.path}]} {
474                                ui_info "$UI_PREFIX [format [msgcat::mc "Deleting previous %s"] ${archive.file}]"
475                                file delete -force ${archive.path}
476                        }
477
478                        ui_info "$UI_PREFIX [format [msgcat::mc "Creating %s"] ${archive.file}]"
479                        command_exec archive
480                        ui_info "$UI_PREFIX [format [msgcat::mc "Archive %s packaged"] ${archive.file}]"
481                }
482        }
483
484    return 0
485}
486
487proc portarchive::archive_finish {args} {
488        global UI_PREFIX
489        global name version revision portvariants
490        global destpath
491
492        # Cleanup all control files when finished
493        set control_files [glob -nocomplain -types f [file join $destpath +*]]
494        foreach file $control_files {
495                ui_debug "removing file: $file"
496                file delete -force $file
497        }
498
499        if {[llength [option portarchivetype]] > 1} {
500                ui_info "$UI_PREFIX [format [msgcat::mc "Archives for %s %s_%s%s packaged"] $name $version $revision $portvariants]"
501        } else {
502                ui_info "$UI_PREFIX [format [msgcat::mc "Archive for %s %s_%s%s packaged"] $name $version $revision $portvariants]"
503        }
504        return 0
505}
506
Note: See TracBrowser for help on using the repository browser.