source: trunk/base/portmgr/dpkgall.tcl @ 15488

Last change on this file since 15488 was 15338, checked in by jmpp, 15 years ago

Submitted by: jmpp@
Reviewed by: jberry@

The pormgr/ dir is now out of src/, as it doesn't have much to do with our sources.

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