source: trunk/base/portmgr/packaging/dpkgall.tcl @ 116517

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

portmgr/packaging: Tcl cleanup, patch by Gustaf Neumann, Tcl8.4-clean

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 25.7 KB
Line 
1#!/usr/bin/env tclsh8.4
2# dpkgbuild.tcl
3# $Id: dpkgall.tcl 116517 2014-01-27 15:31:02Z cal@macports.org $
4#
5# Copyright (c) 2009-2011 The MacPorts Project
6# Copyright (c) 2004 Landon Fuller <landonf@macports.org>
7# Copyright (c) 2003 Kevin Van Vechten <kevin@opendarwin.org>
8# Copyright (c) 2002 Apple Inc.
9# All rights reserved.
10#
11# Redistribution and use in source and binary forms, with or without
12# modification, are permitted provided that the following conditions
13# are met:
14# 1. Redistributions of source code must retain the above copyright
15#    notice, this list of conditions and the following disclaimer.
16# 2. Redistributions in binary form must reproduce the above copyright
17#    notice, this list of conditions and the following disclaimer in the
18#    documentation and/or other materials provided with the distribution.
19# 3. Neither the name of Apple Inc. nor the names of its contributors
20#    may be used to endorse or promote products derived from this software
21#    without specific prior written permission.
22#
23# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
24# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
25# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
26# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
27# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
28# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
29# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
30# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
31# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
32# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33# POSSIBILITY OF SUCH DAMAGE.
34
35#######################################
36#
37# Must be installed outside of dports tree:
38#       tcl 8.4
39#       curl
40#       tar
41#       gzip
42#       unzip
43#       dports tree
44#
45# A tar file containing full /${portprefix} directory tree, stored in:
46#       $pkgrepo/$architecture/root.tar.gz
47# The /${portprefix} directory tree must contain:
48#       MacPorts installation
49#       dpkg
50#
51# Configuration:
52#       /etc/ports/dpkg.conf
53#       /etc/ports/dpkg
54#
55#######################################
56
57package require darwinports
58
59# Configuration Namespace
60namespace eval dpkg {
61        variable configopts "pkgrepo architecture portlistfile portprefix dportsrc silentmode initialports"
62
63        # Preferences
64        variable silentmode false
65        variable configfile "/etc/ports/dpkg.conf"
66        variable portlist ""
67        variable portprefix "/usr/dports"
68        variable dportsrc "/usr/darwinports"
69        variable pkgrepo "/export/dpkg/"
70        # architecture is set in main
71        variable architecture
72        variable initialports "dpkg apt"
73        variable aptpackagedir
74        variable packagedir
75        # portlistfile defaults to ${pkgrepo}/${architecture}/etc/buildlist.txt (set in main)
76        variable portlistfile
77        # baselistfile defaults to ${pkgrepo}/${architecture}/etc/baselist.txt (set in main)
78        variable baselistfile
79
80        # Non-user modifiable.
81        # Ports required for building. Format:
82        # <binary> <portname> <binary> <portname> ...
83        variable requiredports "dpkg dpkg apt-get apt"
84
85        # Current log file descriptor
86        variable logfd
87}
88
89# MacPorts UI Event Callbacks
90proc ui_prefix {priority} {
91    switch $priority {
92        debug {
93                return "Debug: "
94        }
95        error {
96                return "Error: "
97        }
98        warn {
99                return "Warning: "
100        }
101        default {
102                return ""
103        }
104    }
105}
106
107proc ui_channels {priority} {
108        global dpkg::logfd
109        if {[info exists logfd] && $logfd ne ""} {
110                return {$logfd}
111        } elseif {$message(priority) ne "debug"} {
112                # If there's no log file, echo to stdout
113                return {stdout}
114        }
115}
116
117proc ui_silent {message} {
118        global dpkg::silentmode
119        if {"${silentmode}" != true} {
120                puts $message
121                ui_msg $message
122        } else {
123                ui_msg $message
124        }
125}
126
127# Outputs message to console and to log
128# Should only be used with errors
129proc ui_noisy_error {message} {
130        puts $message
131        ui_error $message
132}
133
134proc log_message {channel message} {
135        seek $channel 0 end
136        puts $channel $message
137        flush $channel
138}
139
140# Read in configuration file
141proc readConfig {file} {
142        global dpkg::configopts
143
144        set fd [open $file r]
145        while {[gets $fd line] >= 0} {
146                foreach option $configopts {
147                        if {[regexp "^$option\[ \t\]+(\[A-Za-z0-9_:,\./-\]+$)" $line match val] == 1} {
148                                set dpkg::$option $val
149                        }
150                }
151        }
152}
153
154# Read a list of newline seperated port names from $file
155proc readPortList {file} {
156        set fd [open $file r]
157        set portlist ""
158
159        while {[gets $fd line] >= 0} {
160                lappend portlist $line
161        }
162
163        return $portlist
164}
165
166# Escape all regex characters in a portname
167proc regex_escape_portname {portname} {
168        regsub -all "(\\(){1}|(\\)){1}|(\\{1}){1}|(\\+){1}|(\\{1}){1}|(\\{){1}|(\\}){1}|(\\^){1}|(\\$){1}|(\\.){1}|(\\\\){1}" $portname "\\\\&" escaped_string
169        return $escaped_string
170}
171
172# Print usage string
173proc print_usage {args} {
174        global argv0
175        puts "Usage: [file tail $argv0] \[-qa\] \[-f configfile\] \[-p portlist\]"
176        puts "  -q      Quiet mode (only errors reported)"
177        puts "  -w      No warnings (progress still reported)"
178        puts "  -a      Build all ports"
179        puts "  -b      Re-generate base install archive"
180        puts "  -p      Attempt to build ports that do not advertise support for the build platform"
181        puts "  -i      Initialize Build System (Should only be run on a new build system)"
182}
183
184# Delete and restore the build system
185proc reset_tree {args} {
186        global dpkg::portprefix dpkg::pkgrepo dpkg::architecture
187
188        ui_silent "Restoring pristine ${portprefix} from ${pkgrepo}/${architecture}/root.tar.gz"
189        if {[catch {system "rm -Rf ${portprefix}"} error]} {
190                global errorInfo
191                ui_debug "$errorInfo"
192                ui_noisy_error "Internal error: $error"
193                exit 1
194        }
195
196        if {[catch {system "rm -Rf /usr/X11R6"} error]} {
197                global errorInfo
198                ui_debug "$errorInfo"
199                ui_noisy_error "Internal error: $error"
200                exit 1
201        }
202
203        if {[catch {system "rm -Rf /etc/X11"} error]} {
204                global errorInfo
205                ui_debug "$errorInfo"
206                ui_noisy_error "Internal error: $error"
207                exit 1
208        }
209
210        if {[catch {system "cd / && tar xvf ${pkgrepo}/${architecture}/root.tar.gz"} error]} {
211                global errorInfo
212                ui_debug "$errorInfo"
213                ui_noisy_error "Internal error: $error"
214                exit 1
215        }
216
217        ui_silent "Linking static distfiles directory to ${portprefix}/var/db/dports/distfiles."
218        if {[file isdirectory ${portprefix}/var/db/dports/distfiles"]} {
219                if {[catch {system "rm -rf ${portprefix}/var/db/dports/distfiles"} error]} {
220                        global errorInfo
221                        ui_debug "$errorInfo"
222                        ui_noisy_error "Internal error: $error"
223                        exit 1
224                }
225
226                if {[catch {system "ln -s ${pkgrepo}/distfiles ${portprefix}/var/db/dports/distfiles"} error]} {
227                        global errorInfo
228                        ui_debug "$errorInfo"
229                        ui_noisy_error "Internal error: $error"
230                        exit 1
231                }
232        }
233}
234
235proc main {argc argv} {
236        global dpkg::configfile dpkg::pkgrepo dpkg::architecture dpkg::portlistfile
237        global dpkg::portsArray dpkg::portprefix dpkg::silentmode dpkg::logfd dpkg::packagedir dpkg::aptpackagedir
238        global dpkg::requiredports dpkg::baselistfile tcl_platform
239
240        # First time through, we reset the tree
241        set firstrun_flag true
242
243        # Read command line options
244        set buildall_flag false
245        set anyplatform_flag false
246        set nowarn_flag false
247        set basegen_flag false
248        set initialize_flag false
249
250        for {set i 0} {$i < $argc} {incr i} {
251                set arg [lindex $argv $i]
252                switch -- $arg {
253                        -a {
254                                set buildall_flag true
255                        }
256                        -b {
257                                set basegen_flag true
258                        }
259                        -f {
260                                incr i
261                                set configfile [lindex $argv $i]
262
263                                if {![file readable $configfile]} {
264                                        return -code error "Configuration file \"$configfile\" is unreadable."
265                                }
266                        }
267                        -i {
268                                set initialize_flag true
269                        }
270                        -p {
271                                incr i
272                                set portlistfile [lindex $argv $i]
273                                if {![file readable $portlistfile]} {
274                                        return -code error "Port list file \"$portlistfile\" is unreadable."
275                                }
276                        }
277                        -q {
278                                set silentmode true
279                        }
280                        -w {
281                                set nowarn_flag true
282                        }
283                        -p {
284                                set anyplatform_flag true
285                        }
286                        default {
287                                print_usage
288                                exit 1
289                        }
290                }
291        }
292
293        # Initialize System
294        array set ui_options {}
295        array set options {}
296        array set variations {}
297        mportinit ui_options options variations
298
299        # If -i was specified, install base system and exit
300        if {$initialize_flag == "true"} {
301                initialize_system
302                exit 0
303        }
304
305        # We must have dpkg by now
306        if {[catch {set_architecture} result]} {
307                puts "$result."
308                puts "Have you initialized the build system? Use the -i flag:"
309                print_usage
310                exit 1
311        }
312
313        # Set the platform
314        set platformString [string tolower $tcl_platform(os)]
315
316        set packagedir ${pkgrepo}/${architecture}/packages/
317        set aptpackagedir ${pkgrepo}/apt/dists/stable/main/binary-${architecture}/
318
319        # Read configuration files
320        if {[file readable $configfile]} {
321                readConfig $configfile
322        }
323
324        # If portlistfile has not been set, supply a reasonable default
325        if {![info exists portlistfile]} {
326                # The default portlist file
327                set portlistfile [file join $pkgrepo $architecture etc buildlist.txt]
328        }
329
330        # If baselistfile has not been set, supply a reasonable default
331        if {![info exists baselistfile]} {
332                # The default baselist file
333                set baselistfile [file join $pkgrepo $architecture etc baselist.txt]
334        }
335
336        # Read the port list
337        if {[file readable $portlistfile]} {
338                set portlist [readPortList $portlistfile]
339        } else {
340                set portlist ""
341        }
342
343        if {[file readable $baselistfile]} {
344                set baselist [readPortList $baselistfile]
345        } else {
346                set baselist ""
347        }
348
349        # If no portlist file was specified, create a portlist that includes all ports
350        if {[llength $portlist] == 0 || "$buildall_flag" == "true"} {
351                set res [mportlistall]
352                foreach {name array} $res {
353                        lappend portlist $name
354                }
355        } else {
356                # Port list was specified. Ensure that all the specified ports are available.
357                # Add ${baselist} and get_required_ports to the list
358                set portlist [lsort -unique [concat $portlist $baselist [get_required_ports]]]
359                foreach port $portlist {
360                        set fail false
361
362                        if {[catch {set res [get_portinfo $port]} result]} {
363                                global errorInfo
364                                ui_debug "$errorInfo"
365                                ui_noisy_error "Error: $result"
366                                set fail true
367                        }
368
369                        # Add all of the specified ports' dependencies to the portlist
370                        set dependencies [get_dependencies $port false]
371                        foreach dep $dependencies {
372                                lappend portlist [lindex $dep 0]
373                        }
374                }
375                if {"$fail" == "true"} {
376                        exit 1
377                }
378        }
379
380        # Clean out duplicates
381        set portlist [lsort -unique $portlist]
382
383        # Ensure that the log directory exists, and open up
384        # the default debug log
385        open_default_log w
386
387        # Set the dport options
388        # Package build path
389        set options(package.destpath) ${packagedir}
390
391        # Ensure that it exists
392        file mkdir $options(package.destpath)
393
394        # Force mode
395        set options(ports_force) yes
396
397        # Set variations (empty)
398        set variations [list]
399
400
401        if {"$silentmode" != "true" && "$nowarn_flag" != "true"} {
402                puts "WARNING: The full contents of ${portprefix}, /usr/X11R6, and /etc/X11 will be deleted by this script. If you do not want this, control-C NOW."
403                exec sleep 10
404        }
405
406        # Destroy the existing apt repository
407        if {[catch {system "rm -Rf ${aptpackagedir}"} error]} {
408                global errorInfo
409                ui_debug "$errorInfo"
410                ui_noisy_error "Internal error: $error"
411                exit 1
412        }
413
414        # Recreate
415        file mkdir ${aptpackagedir}
416
417        close_default_log
418
419        foreach port $portlist {
420                # Open the default debug log write/append
421                open_default_log
422
423                if {[catch {set res [get_portinfo $port]} error]} {
424                        global errorInfo
425                        ui_debug "$errorInfo"
426                        ui_noisy_error "Internal error: port search failed: $error"
427                        exit 1
428                }
429
430                # Reset array from previous runs
431                unset -nocomplain portinfo
432                array set portinfo [lindex $res 1]
433
434                if {![info exists portinfo(name)] ||
435                        ![info exists portinfo(version)] || 
436                        ![info exists portinfo(revision)] || 
437                        ![info exists portinfo(categories)]} {
438                        ui_noisy_error "Internal error: $name missing some portinfo keys"
439                        close $logfd
440                        continue
441                }
442
443        # open correct subport
444        set options(subport) $portinfo(name)
445
446                # Skip un-supported ports
447                if {[info exists portinfo(platforms)] && ${anyplatform_flag} != "true"} {
448                        if {[lsearch $portinfo(platforms) $platformString] == -1} {
449                                ui_silent "Skipping unsupported port $portinfo(name) (platform: $platformString supported: $portinfo(platforms))"
450                                continue
451                        }
452                }
453
454
455                # Add apt override line. dpkg is special cased and marked 'required'
456                # TODO: add the ability to specify the "required" priority for specific
457                # ports in a config file.
458                if {"$portinfo(name)" == "dpkg"} {
459                        set pkg_priority required
460                } else {
461                        set pkg_priority optional
462                }
463                add_override $portinfo(name) $pkg_priority [lindex $portinfo(categories) 0]
464
465                # Skip up-to-date software
466                set pkgfile [get_pkgpath $portinfo(name) $portinfo(version) $portinfo(revision)]
467                if {[file exists ${pkgfile}]} {
468                        if {[regsub {^file://} $portinfo(porturl) "" portpath]} {
469                                if {[file readable $pkgfile] && ([file mtime ${pkgfile}] > [file mtime ${portpath}/Portfile])} {
470                                        ui_silent "Skipping ${portinfo(name)}-${portinfo(version)}-${portinfo(revision)}; package is up to date."
471                                        # Shove the package into the apt repository
472                                        copy_pkg_to_apt $portinfo(name) $portinfo(version) $portinfo(revision) [lindex $portinfo(categories) 0]
473                                        continue
474                                }
475                        }
476                }
477
478                # We're going to actually build the package, reset the tree
479                # if this is our first time through. The tree is always reset
480                # at the end of a packaging run, too.
481                if {$firstrun_flag == true} {
482                        reset_tree
483                        set firstrun_flag false
484                }
485
486                ui_silent "Building $portinfo(name) ..."
487
488                # Close the main debug log
489                close_default_log
490
491                # Create log directory and open the build log
492                file mkdir [file join ${pkgrepo} ${architecture} log build ${port}]
493                set logfd [open ${pkgrepo}/${architecture}/log/build/${port}/build.log w 0644]
494
495                # Install binary dependencies if possible
496                set dependencies [get_dependencies $portinfo(name)]
497                foreach dep $dependencies {
498                        install_binary_if_available $dep
499                }
500
501                if {[catch {set workername [mportopen $portinfo(porturl) [array get options] [array get variations] yes]} result] || $result == 1} {
502                        global errorInfo
503                        ui_debug "$errorInfo"
504                        ui_noisy_error "Internal error: unable to open port: $result"
505                        exit 1
506                }
507
508                if {[catch {set result [mportexec $workername clean]} result] || $result == 1} {
509                        ui_noisy_error "Cleaning $portinfo(name) failed, consult build log"
510
511                        # Close the log
512                        close $logfd
513
514                        # Copy the log to the failure directory
515                        copy_failure_log $portinfo(name)
516
517                        # Close the port
518                        mportclose $workername
519
520                        continue
521                }
522
523                # Re-open the port. MacPorts doesn't play well with multiple targets, apparently
524                mportclose $workername
525                if {[catch {set workername [mportopen $portinfo(porturl) [array get options] [array get variations] yes]} result] || $result == 1} {
526                        global errorInfo
527                        ui_debug "$errorInfo"
528                        ui_noisy_error "Internal error: unable to open port: $result"
529                        exit 1
530                }
531
532                if {[catch {set result [mportexec $workername dpkg]} result] || $result == 1} {
533                        ui_noisy_error "Packaging $portinfo(name) failed, consult build log"
534
535                        # Copy the log to the failure directory
536                        copy_failure_log $portinfo(name)
537
538                        # Close the port
539                        mportclose $workername
540
541                        # Close the log
542                        close $logfd
543
544                        # Open default log
545                        open_default_log
546
547                        ui_silent "Resetting /usr/dports ..."
548                        reset_tree
549                        ui_silent "Done."
550
551                        # Close the log
552                        close $logfd
553
554                        continue
555                }
556
557                ui_silent "Package build for $portinfo(name) succeeded"
558               
559                # Into the apt repository you go!
560                copy_pkg_to_apt $portinfo(name) $portinfo(version) $portinfo(revision) [lindex $portinfo(categories) 0]
561
562                ui_silent "Resetting /usr/dports ..."
563                reset_tree
564                ui_silent "Done."
565
566                # Close the log
567                close $logfd
568
569                # Delete any previous failure logs
570                delete_failure_log $portinfo(name)
571
572                # Close the port
573                mportclose $workername
574        }
575
576        open_default_log
577
578        # If required, rebuild the clientinstall.tgz
579        if {$basegen_flag == true} {
580                # dpkg is always required
581                set pkglist [lsort -unique [concat dpkg $baselist [get_required_ports]]]
582                set workdir [file join ${pkgrepo} ${architecture}]
583                set rootdir [file join $workdir clientroot]
584                set rootfile [file join $workdir client-root.tar.gz]
585                file mkdir ${rootdir}
586
587                # dpkg is required
588                array set portinfo [lindex [get_portinfo dpkg] 1]
589                set pkgfile [get_pkgpath $portinfo(name) $portinfo(version) $portinfo(revision)]
590                system "cd \"${rootdir}\" && ar x \"${pkgfile}\" data.tar.gz"
591                system "cd \"${rootdir}\" && tar xvf data.tar.gz; rm data.tar.gz"
592
593                foreach port $pkglist {
594                        set dependencies [get_dependencies $port false]
595                        foreach dep $dependencies {
596                                lappend newpkglist [lindex $dep 0]
597                        }
598                }
599
600                if {[info exists newpkglist]} {         
601                        set pkglist [lsort -unique [concat $newpkglist $pkglist]]
602                }
603
604                foreach port $pkglist {
605                        array set portinfo [lindex [get_portinfo $port] 1]
606                        system "dpkg --root \"${rootdir}\" --force-depends -i \"[get_pkgpath $portinfo(name) $portinfo(version) $portinfo(revision)]\""
607                }
608
609                system "cd \"${rootdir}\" && tar cf \"[file join ${workdir} clientinstall.tar.gz]\" ."
610                file delete -force ${rootdir}
611        }
612
613        ui_silent "Building apt-get index ..."
614        if {[catch {system "cd ${pkgrepo}/apt && dpkg-scanpackages dists override >${aptpackagedir}/Packages"} error]} {
615                global errorInfo
616                ui_debug "$errorInfo"
617                ui_noisy_error "Internal error: $error"
618                exit 1
619        }
620
621        if {[catch {system "cd ${aptpackagedir} && gzip Packages"} error]} {
622                global errorInfo
623                ui_debug "$errorInfo"
624                ui_noisy_error "Internal error: $error"
625                exit 1
626        }
627        remove_override_file
628        ui_silent "Done."
629
630        ui_silent "Package run finished."
631        close_default_log
632
633        exit 0
634}
635
636# Return ports listed in $dpkg::requiredports that are not
637# installed
638proc get_required_ports {args} {
639        global dpkg::requiredports
640        set reqlist ""
641
642        foreach {binary port} $requiredports {
643                if {[find_binary $binary] eq ""} {
644                        lappend reqlist $port
645                }
646        }
647        return $reqlist
648}
649
650# Given a binary name, searches PATH
651proc find_binary {binary} {
652        global env
653        set path [split $env(PATH) :]
654        foreach dir $path {
655                set file [file join $dir $binary]
656                if {[file exists $file]} {
657                        return $file
658                }
659        }
660        return ""
661}
662
663# Set the architecture global
664proc set_architecture {args} {
665        set dpkg::architecture "[exec dpkg --print-installation-architecture]"
666}
667
668# Initialize a new build system
669proc initialize_system {args} {
670        global dpkg::initialports dpkg::pkgrepo
671        global dpkg::architecture dpkg::portprefix
672
673        # Create standard directories
674        ui_msg "Creating ${pkgrepo} directory"
675        file mkdir ${pkgrepo}
676
677        set builddeps ""
678        set rundeps ""
679
680        foreach port [get_required_ports] {
681                set builddeps [concat $builddeps [get_dependencies $port true]]
682                set rundeps [concat $rundeps [get_dependencies $port false]]
683        }
684
685        set buildlist [lsort -unique $builddeps]
686
687        foreach port $builddeps {
688                if {[lsearch -exact $port $rundeps] >= 0} {
689                        lappend removelist $port
690                }
691        }
692
693        set options ""
694        set variations ""
695
696        foreach port [get_required_ports] {
697            set options(subport) $port
698                if {[catch {do_portexec $port [array get options] [array get variants] activate} result]} {
699                        global errorInfo
700                        ui_debug "$errorInfo"
701                        ui_noisy_error "Fatal error: $result"
702                        exit 1
703                }
704        }
705
706        if {[info exists removelist]} {
707                ui_msg "Removing build dependencies ..."
708                foreach portlist $removelist {
709                        set port [lindex $portlist 0]
710
711                        ui_msg "Uninstalling $port."
712                        if { [catch {registry_uninstall::uninstall $portname $portversion "" 0 [array get options]} result] } {
713                                global errorInfo
714                                ui_debug "$errorInfo"
715                                ui_noisy_errorr "Fatal error: Uninstalling $port failed: $result"
716                                exit 1
717                        }
718                }
719                ui_msg "Done."
720        }
721                       
722
723        if {[catch {set_architecture} result]} {
724                puts "Fatal error: $result."
725                exit 1
726        }
727
728        ui_msg "Creating [file join ${pkgrepo} ${architecture}] directory"
729        file mkdir [file join ${pkgrepo} ${architecture}]
730        file mkdir [file join ${pkgrepo} ${architecture} etc]
731
732        ui_msg "Generating pristine archive: [file join ${pkgrepo} ${architecture} root.tar.gz]"
733        if {[catch {system "tar -zcf \"[file join ${pkgrepo} ${architecture} root.tar.gz]\" \"${portprefix}\""} result]} {
734                global errorInfo
735                ui_debug "$errorInfo"
736                ui_noisy_error "Fatal error: Archive creation failed: $result"
737                exit 1
738        }
739
740        ui_msg "Build system successfully initialized!"
741}
742
743# Execute a target on a port (by port name)
744proc do_portexec {port options variants target} {
745
746        array set portinfo [lindex [get_portinfo $port] 1]
747
748        if {[catch {set workername [mportopen $portinfo(porturl) $options $variants yes]} result] || $result == 1} {
749                return -code error "Internal error: unable to open port: $result"
750                exit 1
751        }
752
753        if {[catch {set result [mportexec $workername $target]} result] || $result == 1} {
754
755                # Close the port
756                mportclose $workername
757
758                # Return error
759                return -code error "Executing target $target on $portinfo(name) failed."
760        }
761}
762
763proc get_portinfo {port} {
764        set searchstring [regex_escape_portname $port]
765        set res [mportlookup ${searchstring}]
766
767        if {[llength $res] < 2} {
768                return -code error "Port \"$port\" not found in index."
769        }
770
771        return $res
772}
773
774# Given name, version, and revision, returns the path to a package file
775proc get_pkgpath {name version revision} {
776        global dpkg::pkgrepo dpkg::architecture
777        global dpkg::packagedir
778        if {${revision} == 0} {
779                set revision ""
780        } else {
781                set revision "-${revision}"
782        }
783
784        return [string tolower ${packagedir}/${name}_${version}${revision}_${architecture}.deb]
785}
786
787# Opens the default log file and sets dpkg::logfd
788proc open_default_log {{mode a}} {
789        global dpkg::pkgrepo dpkg::architecture dpkg::logfd
790        # Ensure that the log directory exists, and open up
791        # the default debug log
792        file mkdir ${pkgrepo}/${architecture}/log/
793        set logfd [open ${pkgrepo}/${architecture}/log/debug.log ${mode} 0644]
794}
795
796# Closes the current logfile
797proc close_default_log {args} {
798        global dpkg::logfd
799        close $logfd
800}
801
802# Copies a port log file to the failure directory
803proc copy_failure_log {name} {
804        global dpkg::pkgrepo dpkg::architecture
805        # Copy the log to the failure log directory
806        file mkdir ${pkgrepo}/${architecture}/log/failure/${name}
807        file copy -force ${pkgrepo}/${architecture}/log/build/${name}/build.log ${pkgrepo}/${architecture}/log/failure/${name}/
808}
809
810# Deletes a port's failure log
811proc delete_failure_log {name} {
812        global dpkg::pkgrepo dpkg::architecture
813        if {[catch {system "rm -Rf ${pkgrepo}/${architecture}/log/failure/${name}"} error]} {
814                global errorInfo
815                ui_debug "$errorInfo"
816                ui_noisy_error "Internal error: $error"
817                exit 1
818        }
819}
820
821# Add an override entry to the apt override file
822proc add_override {name priority section {maintainer ""}} {
823        global dpkg::aptpackagedir dpkg::pkgrepo
824        set output "${name}     ${priority}     ${section}"
825        if {${maintainer} != ""} {
826                append output " ${maintainer}"
827        }
828        set fd [open "${pkgrepo}/apt/override" a 0644]
829        puts $fd $output
830        close $fd
831}
832
833# Deletes the apt override file
834proc remove_override_file {args} {
835        global dpkg::aptpackagedir dpkg::pkgrepo
836        if {[catch {file delete -force ${pkgrepo}/apt/override} error]} {
837                global errorInfo
838                ui_debug "$errorInfo"
839                ui_noisy_error "Internal error: $error"
840                exit 1
841        }
842}
843
844# Copies a given package to the apt repository
845proc copy_pkg_to_apt {name version revision category} {
846        global dpkg::aptpackagedir
847
848        set pkgfile [get_pkgpath $name $version $revision]
849        file mkdir $aptpackagedir/main/$category
850        file link -hard $aptpackagedir/main/$category/[file tail $pkgfile] $pkgfile
851}
852
853# Recursive bottom-up approach of building a list of dependencies.
854proc get_dependencies {portname {includeBuildDeps "true"}} {
855        set result [get_dependencies_recurse $portname $includeBuildDeps]
856        return [lsort -unique $result]
857}
858
859proc get_dependencies_recurse {portname includeBuildDeps} {
860        set result {}
861       
862        set res [get_portinfo $portname]
863
864        foreach {name array} $res {
865                array set portinfo $array
866                if {![info exists portinfo(name)] ||
867                        ![info exists portinfo(version)] || 
868                        ![info exists portinfo(revision)] || 
869                        ![info exists portinfo(categories)]} {
870                        ui_error "Internal error: $name missing some portinfo keys"
871                        continue
872                }
873
874                lappend result [list $portinfo(name) $portinfo(version) $portinfo(revision) [lindex $portinfo(categories) 0]]
875
876                # Append the package's dependents to the result list
877                set depends {}
878                if {[info exists portinfo(depends_run)]} { eval "lappend depends $portinfo(depends_run)" }
879                if {[info exists portinfo(depends_lib)]} { eval "lappend depends $portinfo(depends_lib)" }
880                if {$includeBuildDeps == "true" && [info exists portinfo(depends_build)]} { 
881                        eval "lappend depends $portinfo(depends_build)"
882                }
883                if {$includeBuildDeps == "true" && [info exists portinfo(depends_fetch)]} { 
884                        eval "lappend depends $portinfo(depends_fetch)"
885                }
886                if {$includeBuildDeps == "true" && [info exists portinfo(depends_extract)]} { 
887                        eval "lappend depends $portinfo(depends_extract)"
888                }
889                foreach depspec $depends {
890                        set dep [lindex [split $depspec :] end]
891                        set x [get_dependencies_recurse $dep $includeBuildDeps]
892                        eval "lappend result $x"
893                        set result [lsort -unique $result]
894                }
895        }
896        return $result
897}
898
899# Install binary packages if they've already been built.  This will
900# speed up the testing, since we won't have to recompile dependencies
901# which have already been compiled.
902
903proc install_binary_if_available {dep} {
904        global dpkg::architecture dpkg::pkgrepo dpkg::portprefix
905
906        set portname [lindex $dep 0]
907        set portversion [lindex $dep 1]
908        set portrevision [lindex $dep 2]
909        set category [lindex $dep 3]
910
911        if {${portrevision} != ""} {
912                set verstring ${portversion}_${portrevision}
913        } else {
914                set verstring ${portversion}
915        }
916       
917        set receiptdir [file join $portprefix var db receipts ${portname} ${verstring}]
918        set pkgpath [get_pkgpath ${portname} ${portversion} ${portrevision}]
919
920        # Check if the package is available, and ensure that it has not already been
921        # installed through MacPorts (bootstrap packages such as dpkg and its
922        # dependencies are always installed)
923        if {[file readable $pkgpath] && ![file exists $receiptdir/receipt.bz2]} {
924                ui_silent "Installing binary: $pkgpath"
925                if {[catch {system "dpkg --force-depends -i ${pkgpath}"} error]} {
926                        global errorInfo
927                        ui_debug "$errorInfo"
928                        ui_noisy_error "Internal error: $error"
929                        exit 1
930                }
931                # Touch the receipt
932                file mkdir $receiptdir
933                if {[catch {system "touch [file join $receiptdir receipt.bz2]"} error]} {
934                        global errorInfo
935                        ui_debug "$errorInfo"
936                        ui_noisy_error "Internal error: $error"
937                        exit 1
938                }
939        }
940}
941
942### main() entry point ####
943main $argc $argv
Note: See TracBrowser for help on using the repository browser.