source: trunk/base/src/macports1.0/macports.tcl @ 68996

Last change on this file since 68996 was 68996, checked in by jmr@…, 10 years ago

Added integrity checking for fetched archives via signed digests. New pubkeys.conf file allows configuring keys to trust. The private counterpart of the installed public key will of course need to live on our binary building server.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 134.9 KB
Line 
1# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:filetype=tcl:et:sw=4:ts=4:sts=4
2# macports.tcl
3# $Id: macports.tcl 68996 2010-06-19 23:21:02Z jmr@macports.org $
4#
5# Copyright (c) 2002 Apple Computer, Inc.
6# Copyright (c) 2004 - 2005 Paul Guyot, <pguyot@kallisys.net>.
7# Copyright (c) 2004 - 2006 Ole Guldberg Jensen <olegb@opendarwin.org>.
8# Copyright (c) 2004 - 2005 Robert Shaw <rshaw@opendarwin.org>
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 Computer, 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#
35package provide macports 1.0
36package require macports_dlist 1.0
37package require macports_index 1.0
38package require macports_util 1.0
39
40namespace eval macports {
41    namespace export bootstrap_options user_options portinterp_options open_mports ui_priorities port_phases
42    variable bootstrap_options "\
43        portdbpath libpath binpath auto_path extra_env sources_conf prefix portdbformat \
44        portinstalltype portarchivemode portarchivepath portarchivetype portautoclean \
45        porttrace portverbose keeplogs destroot_umask variants_conf rsync_server rsync_options \
46        rsync_dir startupitem_type place_worksymlink xcodeversion xcodebuildcmd \
47        mp_remote_url mp_remote_submit_url configureccache configuredistcc configurepipe buildnicevalue buildmakejobs \
48        applications_dir frameworks_dir developer_dir universal_archs build_arch macosx_deployment_target \
49        macportsuser proxy_override_env proxy_http proxy_https proxy_ftp proxy_rsync proxy_skip"
50    variable user_options "submitter_name submitter_email submitter_key"
51    variable portinterp_options "\
52        portdbpath porturl portpath portbuildpath auto_path prefix prefix_frozen portsharepath \
53        registry.path registry.format registry.installtype portarchivemode portarchivepath \
54        portarchivetype archivefetch_pubkeys portautoclean porttrace keeplogs portverbose destroot_umask \
55        rsync_server rsync_options rsync_dir startupitem_type place_worksymlink macportsuser \
56        mp_remote_url mp_remote_submit_url configureccache configuredistcc configurepipe buildnicevalue buildmakejobs \
57        applications_dir current_phase frameworks_dir developer_dir universal_archs build_arch \
58        os_arch os_endian os_version os_major os_platform macosx_version macosx_deployment_target $user_options"
59
60    # deferred options are only computed when needed.
61    # they are not exported to the trace thread.
62    # they are not exported to the interpreter in system_options array.
63    variable portinterp_deferred_options "xcodeversion xcodebuildcmd"
64
65    variable open_mports {}
66
67    variable ui_priorities "error warn msg notice info debug any"
68    variable port_phases "any fetch checksum"
69    variable current_phase "main"
70}
71
72# Provided UI instantiations
73# For standard messages, the following priorities are defined
74#     debug, info, msg, warn, error
75# Clients of the library are expected to provide ui_prefix and ui_channels with
76# the following prototypes.
77#     proc ui_prefix {priority}
78#     proc ui_channels {priority}
79# ui_prefix returns the prefix for the messages, if any.
80# ui_channels returns a list of channels to output the message to, empty for
81#     no message.
82# if these functions are not provided, defaults are used.
83# Clients of the library may optionally provide ui_init with the following
84# prototype.
85#     proc ui_init {priority prefix channels message}
86# ui_init needs to correctly define the proc ::ui_$priority {message} or throw
87# an error.
88# if this function is not provided or throws an error, default procedures for
89# ui_$priority are defined.
90
91# ui_options accessor
92proc macports::ui_isset {val} {
93    if {[info exists macports::ui_options($val)]} {
94        if {$macports::ui_options($val) == "yes"} {
95            return 1
96        }
97    }
98    return 0
99}
100
101
102# global_options accessor
103proc macports::global_option_isset {val} {
104    if {[info exists macports::global_options($val)]} {
105        if {$macports::global_options($val) == "yes"} {
106            return 1
107        }
108    }
109    return 0
110}
111
112proc macports::init_logging {mport} {
113    global macports::channels macports::portdbpath
114
115    if {[getuid] == 0 && [geteuid] != 0} {
116        seteuid 0
117    }
118    if {[catch {macports::ch_logging $mport} err]} {
119        ui_debug "Logging disabled, error opening log file: $err"
120        return 1
121    }
122    # Add our log-channel to all already initialized channels
123    foreach key [array names channels] {
124        set macports::channels($key) [concat $macports::channels($key) "debuglog"]
125    }
126    return 0
127}
128proc macports::ch_logging {mport} {
129    global ::debuglog ::debuglogname
130
131    set portname [_mportkey $mport name]
132    set portpath [_mportkey $mport portpath]
133
134    ui_debug "Starting logging for $portname"
135
136    set logname [macports::getportlogpath $portpath]
137    file mkdir $logname
138    set logname [file join $logname "main.log"]
139
140    set ::debuglogname $logname
141
142    # Truncate the file if already exists
143    set ::debuglog [open $::debuglogname w]
144    puts $::debuglog "version:1"
145}
146proc macports::push_log {mport} {
147    global ::logstack ::logenabled ::debuglog ::debuglogname
148    if {![info exists ::logenabled]} {
149        if {[macports::init_logging $mport] == 0} {
150            set ::logenabled yes
151            set ::logstack [list [list $::debuglog $::debuglogname]]
152            return
153        } else {
154            set ::logenabled no
155        }
156    }
157    if {$::logenabled} {
158        if {[catch {macports::ch_logging $mport} err]} {
159            ui_debug "Logging disabled, error opening log file: $err"
160            return
161        }
162        lappend ::logstack [list $::debuglog $::debuglogname]
163    }
164}
165proc macports::pop_log {} {
166    global ::logenabled ::logstack ::debuglog ::debuglogname
167    if {![info exists ::logenabled]} {
168        return -code error "pop_log called before push_log"
169    }
170    if {$::logenabled && [llength $::logstack] > 0} {
171        close $::debuglog
172        set ::logstack [lreplace $::logstack end end]
173        if {[llength $::logstack] > 0} {
174            set top [lindex $::logstack end]
175            set ::debuglog [lindex $top 0]
176            set ::debuglogname [lindex $top 1]
177        } else {
178            unset ::debuglog
179            unset ::debuglogname
180        }
181    }
182}
183
184proc set_phase {phase} {
185    global macports::current_phase
186    set macports::current_phase $phase
187    if {$phase != "main"} {
188        set cur_time [clock format [clock seconds] -format  {%+}]
189        ui_debug "$phase phase started at $cur_time"
190    }
191}
192
193proc ui_message {priority prefix phase args} {
194    global macports::channels ::debuglog macports::current_phase
195    foreach chan $macports::channels($priority) {
196        if {[info exists ::debuglog] && ($chan == "debuglog")} {
197            set chan $::debuglog
198            if {[info exists macports::current_phase]} {
199                set phase $macports::current_phase
200            }
201            set strprefix ":$priority:$phase "
202            if {[lindex $args 0] == "-nonewline"} {
203                puts -nonewline $chan "$strprefix[lindex $args 1]"
204            } else {
205                puts $chan "$strprefix[lindex $args 0]"
206            }
207 
208        } else {
209            if {[lindex $args 0] == "-nonewline"} {
210                puts -nonewline $chan "$prefix[lindex $args 1]"
211            } else {
212                puts $chan "$prefix[lindex $args 0]"
213            }
214        }
215    }
216}
217proc macports::ui_init {priority args} {
218    global macports::channels ::debuglog
219    set default_channel [macports::ui_channels_default $priority]
220    # Get the list of channels.
221    if {[llength [info commands ui_channels]] > 0} {
222        set channels($priority) [ui_channels $priority]
223    } else {
224        set channels($priority) $default_channel
225    }
226   
227    # if some priority initialized after log file is being created
228    if {[info exists ::debuglog]} {
229        set channels($priority) [concat $channels($priority) "debuglog"]
230    }
231    # Simplify ui_$priority.
232    try {
233        set prefix [ui_prefix $priority]
234    } catch * {
235        set prefix [ui_prefix_default $priority]
236    }
237    set phases {fetch checksum}
238    try {
239        eval ::ui_init $priority $prefix $channels($priority) $args
240    } catch * {
241        interp alias {} ui_$priority {} ui_message $priority $prefix ""
242        foreach phase $phases {
243            interp alias {} ui_${priority}_${phase} {} ui_message $priority $prefix $phase
244        }
245    }
246}
247
248# Default implementation of ui_prefix
249proc macports::ui_prefix_default {priority} {
250    switch $priority {
251        debug {
252            return "DEBUG: "
253        }
254        error {
255            return "Error: "
256        }
257        warn {
258            return "Warning: "
259        }
260        default {
261            return ""
262        }
263    }
264}
265
266# Default implementation of ui_channels:
267# ui_options(ports_debug) - If set, output debugging messages
268# ui_options(ports_verbose) - If set, output info messages (ui_info)
269# ui_options(ports_quiet) - If set, don't output "standard messages"
270proc macports::ui_channels_default {priority} {
271    switch $priority {
272        debug {
273            if {[ui_isset ports_debug]} {
274                return {stderr}
275            } else {
276                return {}
277            }
278        }
279        info {
280            if {[ui_isset ports_verbose]} {
281                return {stdout}
282            } else {
283                return {}
284            }
285        }
286        notice {
287            if {[ui_isset ports_quiet]} {
288                return {}
289            } else {
290                return {stdout}
291            }
292        }
293        msg {
294            return {stdout}
295        }
296        warn -
297        error {
298            return {stderr}
299        }
300        default {
301            return {stdout}
302        }
303    }
304}
305
306proc ui_warn_once {id msg} {
307    variable macports::warning_done
308    if {![info exists macports::warning_done($id)]} {
309        ui_warn $msg
310        set macports::warning_done($id) 1
311    }
312}
313
314# Replace puts to catch errors (typically broken pipes when being piped to head)
315rename puts tcl::puts
316proc puts {args} {
317    catch "tcl::puts $args"
318}
319
320# find a binary either in a path defined at MacPorts' configuration time
321# or in the PATH environment variable through macports::binaryInPath (fallback)
322proc macports::findBinary {prog {autoconf_hint ""}} {
323    if {${autoconf_hint} != "" && [file executable ${autoconf_hint}]} {
324        return ${autoconf_hint}
325    } else {
326        if {[catch {set cmd_path [macports::binaryInPath ${prog}]} result] == 0} {
327            return ${cmd_path}
328        } else {
329            return -code error "${result} or at its MacPorts configuration time location, did you move it?"
330        }
331    }
332}
333
334# check for a binary in the path
335# returns an error code if it cannot be found
336proc macports::binaryInPath {prog} {
337    global env
338    foreach dir [split $env(PATH) :] {
339        if {[file executable [file join $dir $prog]]} {
340            return [file join $dir $prog]
341        }
342    }
343    return -code error [format [msgcat::mc "Failed to locate '%s' in path: '%s'"] $prog $env(PATH)];
344}
345
346# deferred option processing
347proc macports::getoption {name} {
348    global macports::$name
349    return [expr $$name]
350}
351
352# deferred and on-need extraction of xcodeversion and xcodebuildcmd.
353proc macports::setxcodeinfo {name1 name2 op} {
354    global macports::xcodeversion
355    global macports::xcodebuildcmd
356
357    trace remove variable macports::xcodeversion read macports::setxcodeinfo
358    trace remove variable macports::xcodebuildcmd read macports::setxcodeinfo
359
360    if {[catch {set xcodebuild [binaryInPath "xcodebuild"]}] == 0} {
361        if {![info exists xcodeversion]} {
362            # Determine xcode version
363            set macports::xcodeversion "2.0orlower"
364            if {[catch {set xcodebuildversion [exec -- $xcodebuild -version 2> /dev/null]}] == 0} {
365                if {[regexp {Xcode ([0-9.]+)} $xcodebuildversion - xcode_v] == 1} {
366                    set macports::xcodeversion $xcode_v
367                } elseif {[regexp "DevToolsCore-(.*);" $xcodebuildversion - devtoolscore_v] == 1} {
368                    if {$devtoolscore_v >= 921.0} {
369                        set macports::xcodeversion "3.0"
370                    } elseif {$devtoolscore_v >= 798.0} {
371                        set macports::xcodeversion "2.5"
372                    } elseif {$devtoolscore_v >= 762.0} {
373                        set macports::xcodeversion "2.4.1"
374                    } elseif {$devtoolscore_v >= 757.0} {
375                        set macports::xcodeversion "2.4"
376                    } elseif {$devtoolscore_v > 650.0} {
377                        # XXX find actual version corresponding to 2.3
378                        set macports::xcodeversion "2.3"
379                    } elseif {$devtoolscore_v >= 650.0} {
380                        set macports::xcodeversion "2.2.1"
381                    } elseif {$devtoolscore_v > 620.0} {
382                        # XXX find actual version corresponding to 2.2
383                        set macports::xcodeversion "2.2"
384                    } elseif {$devtoolscore_v >= 620.0} {
385                        set macports::xcodeversion "2.1"
386                    }
387                }
388            }
389        }
390        if {![info exists xcodebuildcmd]} {
391            set macports::xcodebuildcmd "$xcodebuild"
392        }
393    } else {
394        if {![info exists xcodeversion]} {
395            set macports::xcodeversion "none"
396        }
397        if {![info exists xcodebuildcmd]} {
398            set macports::xcodebuildcmd "none"
399        }
400    }
401}
402
403proc mportinit {{up_ui_options {}} {up_options {}} {up_variations {}}} {
404    if {$up_ui_options eq ""} {
405        array set macports::ui_options {}
406    } else {
407        upvar $up_ui_options temp_ui_options
408        array set macports::ui_options [array get temp_ui_options]
409    }
410    if {$up_options eq ""} {
411        array set macports::global_options {}
412    } else {
413        upvar $up_options temp_options
414        array set macports::global_options [array get temp_options]
415    }
416    if {$up_variations eq ""} {
417        array set variations {}
418    } else {
419        upvar $up_variations variations
420    }
421
422    # Initialize ui_*
423    foreach priority ${macports::ui_priorities} {
424        macports::ui_init $priority
425    }
426
427    global auto_path env tcl_platform
428    global macports::autoconf::macports_conf_path
429    global macports::macports_user_dir
430    global macports::bootstrap_options
431    global macports::user_options
432    global macports::extra_env
433    global macports::portconf
434    global macports::portdbpath
435    global macports::portsharepath
436    global macports::registry.format
437    global macports::registry.path
438    global macports::sources
439    global macports::sources_default
440    global macports::sources_conf
441    global macports::destroot_umask
442    global macports::libpath
443    global macports::prefix
444    global macports::macportsuser
445    global macports::prefix_frozen
446    global macports::registry.installtype
447    global macports::rsync_dir
448    global macports::rsync_options
449    global macports::rsync_server
450    global macports::variants_conf
451    global macports::xcodebuildcmd
452    global macports::xcodeversion
453    global macports::configureccache
454    global macports::configuredistcc
455    global macports::configurepipe
456    global macports::buildnicevalue
457    global macports::buildmakejobs
458    global macports::universal_archs
459    global macports::build_arch
460    global macports::os_arch
461    global macports::os_endian
462    global macports::os_version
463    global macports::os_major
464    global macports::os_platform
465    global macports::macosx_version
466    global macports::macosx_deployment_target
467    global macports::archivefetch_pubkeys
468
469    # Set the system encoding to utf-8
470    encoding system utf-8
471
472    # Ensure that the macports user directory exists if HOME is defined
473    if {[info exists env(HOME)]} {
474        set macports::macports_user_dir [file normalize $macports::autoconf::macports_user_dir]
475    } else {
476        # Otherwise define the user directory as a direcotory that will never exist
477        set macports::macports_user_dir "/dev/null/NO_HOME_DIR"
478    }
479
480    # set up platform info variables
481    set os_arch $tcl_platform(machine)
482    if {$os_arch == "Power Macintosh"} { set os_arch "powerpc" }
483    if {$os_arch == "i586" || $os_arch == "i686" || $os_arch == "x86_64"} { set os_arch "i386" }
484    set os_version $tcl_platform(osVersion)
485    set os_major [lindex [split $os_version .] 0]
486    set os_platform [string tolower $tcl_platform(os)]
487    # Remove trailing "Endian"
488    set os_endian [string range $tcl_platform(byteOrder) 0 end-6]
489    set macosx_version {}
490    if {$os_platform == "darwin"} {
491        # This will probably break when Apple changes versioning
492        set macosx_version [expr 10.0 + ($os_major - 4) / 10.0]
493    }
494
495    # Configure the search path for configuration files
496    set conf_files ""
497    lappend conf_files "${macports_conf_path}/macports.conf"
498    if { [file isdirectory $macports_user_dir] } {
499        lappend conf_files "${macports_user_dir}/macports.conf"
500    }
501    if {[info exists env(PORTSRC)]} {
502        set PORTSRC $env(PORTSRC)
503        lappend conf_files ${PORTSRC}
504    }
505
506    # Process all configuration files we find on conf_files list
507    foreach file $conf_files {
508        if [file exists $file] {
509            set portconf $file
510            set fd [open $file r]
511            while {[gets $fd line] >= 0} {
512                if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
513                    if {[lsearch $bootstrap_options $option] >= 0} {
514                        set macports::$option [string trim $val]
515                        global macports::$option
516                    }
517                }
518            }
519            close $fd
520        }
521    }
522
523    # Process per-user only settings
524    set per_user "${macports_user_dir}/user.conf"
525    if [file exists $per_user] {
526        set fd [open $per_user r]
527        while {[gets $fd line] >= 0} {
528            if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
529                if {[lsearch $user_options $option] >= 0} {
530                    set macports::$option $val
531                    global macports::$option
532                }
533            }
534        }
535        close $fd
536    }
537
538    if {![info exists sources_conf]} {
539        return -code error "sources_conf must be set in ${macports_conf_path}/macports.conf or in your ${macports_user_dir}/macports.conf file"
540    }
541    set fd [open $sources_conf r]
542    while {[gets $fd line] >= 0} {
543        set line [string trimright $line]
544        if {![regexp {^\s*#|^$} $line]} {
545            if {[regexp {^([\w-]+://\S+)(?:\s+\[(\w+(?:,\w+)*)\])?$} $line _ url flags]} {
546                set flags [split $flags ,]
547                foreach flag $flags {
548                    if {[lsearch -exact [list nosync default] $flag] == -1} {
549                        ui_warn "$sources_conf source '$line' specifies invalid flag '$flag'"
550                    }
551                    if {$flag == "default"} {
552                        if {[info exists sources_default]} {
553                            ui_warn "More than one default port source is defined."
554                        }
555                        set sources_default [concat [list $url] $flags]
556                    }
557                }
558                lappend sources [concat [list $url] $flags]
559            } else {
560                ui_warn "$sources_conf specifies invalid source '$line', ignored."
561            }
562        }
563    }
564    close $fd
565    # Make sure the default port source is defined. Otherwise
566    # [macports::getportresourcepath] fails when the first source doesn't
567    # contain _resources.
568    if {![info exists sources_default]} {
569        ui_warn "No default port source specified in $sources_conf, using last source as default"
570        set sources_default [lindex $sources end]
571    }
572
573    if {![info exists sources]} {
574        if {[file isdirectory ports]} {
575            set sources "file://[pwd]/ports"
576        } else {
577            return -code error "No sources defined in $sources_conf"
578        }
579    }
580
581    if {[info exists variants_conf]} {
582        if {[file exist $variants_conf]} {
583            set fd [open $variants_conf r]
584            while {[gets $fd line] >= 0} {
585                set line [string trimright $line]
586                if {![regexp {^[\ \t]*#.*$|^$} $line]} {
587                    foreach arg [split $line " \t"] {
588                        if {[regexp {^([-+])([-A-Za-z0-9_+\.]+)$} $arg match sign opt] == 1} {
589                            if {![info exists variations($opt)]} {
590                                set variations($opt) $sign
591                            }
592                        } else {
593                            ui_warn "$variants_conf specifies invalid variant syntax '$arg', ignored."
594                        }
595                    }
596                }
597            }
598            close $fd
599        } else {
600            ui_debug "$variants_conf does not exist, variants_conf setting ignored."
601        }
602    }
603    global macports::global_variations
604    array set macports::global_variations [array get variations]
605
606    # pubkeys.conf
607    set macports::archivefetch_pubkeys {}
608    if {[file isfile [file join ${macports_conf_path} pubkeys.conf]]} {
609        set fd [open [file join ${macports_conf_path} pubkeys.conf] r]
610        while {[gets $fd line] >= 0} {
611            set line [string trim $line]
612            if {![regexp {^[\ \t]*#.*$|^$} $line]} {
613                lappend macports::archivefetch_pubkeys $line
614            }
615        }
616        close $fd
617    } else {
618        ui_debug "pubkeys.conf does not exist."
619    }
620
621    if {![info exists portdbpath]} {
622        return -code error "portdbpath must be set in ${macports_conf_path}/macports.conf or in your ${macports_user_dir}/macports.conf"
623    }
624    if {![file isdirectory $portdbpath]} {
625        if {![file exists $portdbpath]} {
626            if {[catch {file mkdir $portdbpath} result]} {
627                return -code error "portdbpath $portdbpath does not exist and could not be created: $result"
628            }
629        } else {
630            return -code error "$portdbpath is not a directory. Please create the directory $portdbpath and try again"
631        }
632    }
633
634    set registry.path $portdbpath
635
636    # Format for receipts, can currently be either "flat" or "sqlite"
637    if {[info exists portdbformat]} {
638        if {$portdbformat == "flat" || $portdbformat == "sqlite"} {
639            set registry.format receipt_${portdbformat}
640        } else {
641            return -code error "unknown registry format '$portdbformat' set in macports.conf"
642        }
643    } else {
644        set registry.format receipt_sqlite
645    }
646
647    # Installation type, whether to use port "images" or install "direct"
648    if {[info exists portinstalltype]} {
649        set registry.installtype $portinstalltype
650    } else {
651        set registry.installtype image
652    }
653
654    # Autoclean mode, whether to automatically call clean after "install"
655    if {![info exists portautoclean]} {
656        set macports::portautoclean "yes"
657        global macports::portautoclean
658    }
659        # whether to keep logs after successful builds
660        if {![info exists keeplogs]} {
661        set macports::keeplogs "no"
662        global macports::keeplogs
663    }
664   
665    # Check command line override for autoclean
666    if {[info exists macports::global_options(ports_autoclean)]} {
667        if {![string equal $macports::global_options(ports_autoclean) $portautoclean]} {
668            set macports::portautoclean $macports::global_options(ports_autoclean)
669        }
670    }
671    # Trace mode, whether to use darwintrace to debug ports.
672    if {![info exists porttrace]} {
673        set macports::porttrace "no"
674        global macports::porttrace
675    }
676    # Check command line override for trace
677    if {[info exists macports::global_options(ports_trace)]} {
678        if {![string equal $macports::global_options(ports_trace) $porttrace]} {
679            set macports::porttrace $macports::global_options(ports_trace)
680        }
681    }
682
683    # Duplicate prefix into prefix_frozen, so that port actions
684    # can always get to the original prefix, even if a portfile overrides prefix
685    set macports::prefix_frozen $prefix
686
687    # Export verbosity.
688    if {![info exists portverbose]} {
689        set macports::portverbose "no"
690        global macports::portverbose
691    }
692    if {[info exists macports::ui_options(ports_verbose)]} {
693        if {![string equal $macports::ui_options(ports_verbose) $portverbose]} {
694            set macports::portverbose $macports::ui_options(ports_verbose)
695        }
696    }
697
698    # Archive mode, whether to create/use binary archive packages
699    if {![info exists portarchivemode]} {
700        set macports::portarchivemode "no"
701        global macports::portarchivemode
702    }
703
704    # Archive path, where to store/retrieve binary archive packages
705    if {![info exists portarchivepath]} {
706        set macports::portarchivepath [file join $portdbpath packages]
707        global macports::portarchivepath
708    }
709    if {$portarchivemode == "yes"} {
710        if {![file exists $portarchivepath] && [catch {file mkdir $portarchivepath} result]} {
711            ui_warn "portarchivepath $portarchivepath does not exist and could not be created; disabling archive mode"
712            set portarchivemode no
713        } elseif {![file isdirectory $portarchivepath]} {
714            return -code error "Archive dir $portarchivepath is not a directory. Please create the directory or reconfigure portarchivepath"
715        }
716    }
717
718    # Archive type, what type of binary archive to use (CPIO, gzipped
719    # CPIO, XAR, etc.)
720    if {![info exists portarchivetype]} {
721        set macports::portarchivetype "tgz"
722        global macports::portarchivetype
723    }
724    # Convert archive type to a list for multi-archive support, colon or
725    # comma separators indicates to use multiple archive formats
726    # (reading and writing)
727    set macports::portarchivetype [split $portarchivetype {:,}]
728
729    # Set rync options
730    if {![info exists rsync_server]} {
731        set macports::rsync_server rsync.macports.org
732        global macports::rsync_server
733    }
734    if {![info exists rsync_dir]} {
735        set macports::rsync_dir release/base/
736        global macports::rsync_dir
737    }
738    if {![info exists rsync_options]} {
739        set rsync_options "-rtzv --delete-after"
740        global macports::rsync_options
741    }
742
743    set portsharepath ${prefix}/share/macports
744    if {![file isdirectory $portsharepath]} {
745        return -code error "Data files directory '$portsharepath' must exist"
746    }
747
748    if {![info exists libpath]} {
749        set libpath "${prefix}/share/macports/Tcl"
750    }
751
752    if {![info exists binpath]} {
753        set env(PATH) "${prefix}/bin:${prefix}/sbin:/bin:/sbin:/usr/bin:/usr/sbin"
754    } else {
755        set env(PATH) "$binpath"
756    }
757
758    # Set startupitem default type (can be overridden by portfile)
759    if {![info exists macports::startupitem_type]} {
760        set macports::startupitem_type "default"
761    }
762
763    # Default place_worksymlink
764    if {![info exists macports::place_worksymlink]} {
765        set macports::place_worksymlink yes
766    }
767
768    # Default mp remote options
769    if {![info exists macports::mp_remote_url]} {
770        set macports::mp_remote_url "http://db.macports.org"
771    }
772    if {![info exists macports::mp_remote_submit_url]} {
773        set macports::mp_remote_submit_url "${macports::mp_remote_url}/submit"
774    }
775
776    # Default mp configure options
777    if {![info exists macports::configureccache]} {
778        set macports::configureccache no
779    }
780    if {![info exists macports::configuredistcc]} {
781        set macports::configuredistcc no
782    }
783    if {![info exists macports::configurepipe]} {
784        set macports::configurepipe yes
785    }
786
787    # Default mp build options
788    if {![info exists macports::buildnicevalue]} {
789        set macports::buildnicevalue 0
790    }
791    if {![info exists macports::buildmakejobs]} {
792        set macports::buildmakejobs 0
793    }
794
795    # default user to run as when privileges can be dropped
796    if {![info exists macports::macportsuser]} {
797        set macports::macportsuser $macports::autoconf::macportsuser
798    }
799
800    # Default mp universal options
801    if {![info exists macports::universal_archs]} {
802        if {$os_major >= 10} {
803            set macports::universal_archs {x86_64 i386}
804        } else {
805            set macports::universal_archs {i386 ppc}
806        }
807    } elseif {[llength $macports::universal_archs] < 2} {
808        ui_warn "invalid universal_archs configured (should contain at least 2 archs)"
809    }
810   
811    # Default arch to build for
812    if {![info exists macports::build_arch]} {
813        if {$os_platform == "darwin"} {
814            if {$os_major >= 10} {
815                if {[sysctl hw.cpu64bit_capable] == 1} {
816                    set macports::build_arch x86_64
817                } else {
818                    set macports::build_arch i386
819                }
820            } else {
821                if {$os_arch == "powerpc"} {
822                    set macports::build_arch ppc
823                } else {
824                    set macports::build_arch i386
825                }
826            }
827        } else {
828            set macports::build_arch ""
829        }
830    } else {
831        set macports::build_arch [lindex $macports::build_arch 0]
832    }
833
834    if {![info exists macports::macosx_deployment_target]} {
835        set macports::macosx_deployment_target $macosx_version
836    }
837
838    # ENV cleanup.
839    set keepenvkeys {
840        DISPLAY DYLD_FALLBACK_FRAMEWORK_PATH
841        DYLD_FALLBACK_LIBRARY_PATH DYLD_FRAMEWORK_PATH
842        DYLD_LIBRARY_PATH DYLD_INSERT_LIBRARIES
843        HOME JAVA_HOME MASTER_SITE_LOCAL ARCHIVE_SITE_LOCAL
844        PATCH_SITE_LOCAL PATH PORTSRC RSYNC_PROXY TMP TMPDIR
845        USER GROUP
846        http_proxy HTTPS_PROXY FTP_PROXY ALL_PROXY NO_PROXY
847        COLUMNS LINES
848    }
849    if {[info exists extra_env]} {
850        set keepenvkeys [concat ${keepenvkeys} ${extra_env}]
851    }
852
853    set env_names [array names env]
854    foreach envkey $env_names {
855        if {[lsearch -exact $keepenvkeys $envkey] == -1} {
856            unset env($envkey)
857        }
858    }
859
860    if {![info exists xcodeversion] || ![info exists xcodebuildcmd]} {
861        # We'll resolve these later (if needed)
862        trace add variable macports::xcodeversion read macports::setxcodeinfo
863        trace add variable macports::xcodebuildcmd read macports::setxcodeinfo
864    }
865
866    # Set the default umask
867    if {![info exists destroot_umask]} {
868        set destroot_umask 022
869    }
870
871    if {[info exists master_site_local] && ![info exists env(MASTER_SITE_LOCAL)]} {
872        set env(MASTER_SITE_LOCAL) "$master_site_local"
873    }
874
875    if {[file isdirectory $libpath]} {
876        lappend auto_path $libpath
877        set macports::auto_path $auto_path
878
879        # XXX: not sure if this the best place, but it needs to happen
880        # early, and after auto_path has been set.  Or maybe Pextlib
881        # should ship with macports1.0 API?
882        package require Pextlib 1.0
883        package require registry 1.0
884        package require registry2 2.0
885    } else {
886        return -code error "Library directory '$libpath' must exist"
887    }
888
889    # unset environment an extra time, to work around bugs in Leopard Tcl
890    if {$macosx_version == "10.5"} {
891        foreach envkey $env_names {
892            if {[lsearch -exact $keepenvkeys $envkey] == -1} {
893                unsetenv $envkey
894            }
895        }
896    }
897
898    # Proxy handling (done this late since Pextlib is needed)
899    if {![info exists proxy_override_env] } {
900        set proxy_override_env "no"
901    }
902    if {[catch {array set sysConfProxies [get_systemconfiguration_proxies]} result]} {
903        return -code error "Unable to get proxy configuration from system: $result"
904    }
905    if {![info exists env(http_proxy)] || $proxy_override_env == "yes" } {
906        if {[info exists proxy_http]} {
907            set env(http_proxy) $proxy_http
908        } elseif {[info exists sysConfProxies(proxy_http)]} {
909            set env(http_proxy) $sysConfProxies(proxy_http)
910        }
911    }
912    if {![info exists env(HTTPS_PROXY)] || $proxy_override_env == "yes" } {
913        if {[info exists proxy_https]} {
914            set env(HTTPS_PROXY) $proxy_https
915        } elseif {[info exists sysConfProxies(proxy_https)]} {
916            set env(HTTPS_PROXY) $sysConfProxies(proxy_https)
917        }
918    }
919    if {![info exists env(FTP_PROXY)] || $proxy_override_env == "yes" } {
920        if {[info exists proxy_ftp]} {
921            set env(FTP_PROXY) $proxy_ftp
922        } elseif {[info exists sysConfProxies(proxy_ftp)]} {
923            set env(FTP_PROXY) $sysConfProxies(proxy_ftp)
924        }
925    }
926    if {![info exists env(RSYNC_PROXY)] || $proxy_override_env == "yes" } {
927        if {[info exists proxy_rsync]} {
928            set env(RSYNC_PROXY) $proxy_rsync
929        }
930    }
931    if {![info exists env(NO_PROXY)] || $proxy_override_env == "yes" } {
932        if {[info exists proxy_skip]} {
933            set env(NO_PROXY) $proxy_skip
934        } elseif {[info exists sysConfProxies(proxy_skip)]} {
935            set env(NO_PROXY) $sysConfProxies(proxy_skip)
936        }
937    }
938
939    # load the quick index
940    _mports_load_quickindex
941
942    set default_source_url [lindex ${sources_default} 0]
943    if {[macports::getprotocol $default_source_url] == "file" || [macports::getprotocol $default_source_url] == "rsync"} {
944        set default_portindex [macports::getindex $default_source_url]
945        if {[file exists $default_portindex] && [expr [clock seconds] - [file mtime $default_portindex]] > 1209600} {
946            ui_warn "port definitions are more than two weeks old, consider using selfupdate"
947        }
948    }
949   
950    # init registry if needed
951    if {${registry.format} == "receipt_sqlite"} {
952        set db_path [file join ${registry.path} registry registry.db]
953        set db_exists [file exists $db_path]
954        registry::open $db_path
955        # for the benefit of the portimage code that is called from multiple interpreters
956        global registry_open
957        set registry_open yes
958        # convert any flat receipts if we just created a new db
959        if {$db_exists == 0 && [file writable $db_path]} {
960            ui_warn "Converting your registry to sqlite format, this might take a while..."
961            if {[catch {registry::convert_to_sqlite}]} {
962                ui_debug "$::errorInfo"
963                file delete -force $db_path
964                error "Failed to convert your registry to sqlite!"
965            } else {
966                ui_warn "Successfully converted your registry to sqlite!"
967            }
968        }
969    }
970}
971
972proc macports::worker_init {workername portpath porturl portbuildpath options variations} {
973    global macports::portinterp_options macports::portinterp_deferred_options registry.installtype
974
975    # Hide any Tcl commands that should be inaccessible to port1.0 and Portfiles
976    # exit: It should not be possible to exit the interpreter
977    interp hide $workername exit
978
979    # cd: This is necessary for some code in port1.0, but should be hidden
980    interp eval $workername "rename cd _cd"
981
982    # Tell the sub interpreter about all the Tcl packages we already
983    # know about so it won't glob for packages.
984    foreach pkgName [package names] {
985        foreach pkgVers [package versions $pkgName] {
986            set pkgLoadScript [package ifneeded $pkgName $pkgVers]
987            $workername eval "package ifneeded $pkgName $pkgVers {$pkgLoadScript}"
988        }
989    }
990
991    # Create package require abstraction procedure
992    $workername eval "proc PortSystem \{version\} \{ \n\
993            package require port \$version \}"
994
995    # Clearly separate slave interpreters and the master interpreter.
996    $workername alias mport_exec mportexec
997    $workername alias mport_open mportopen
998    $workername alias mport_close mportclose
999    $workername alias mport_lookup mportlookup
1000    $workername alias set_phase set_phase
1001
1002    # instantiate the UI call-backs
1003    foreach priority ${macports::ui_priorities} {
1004        $workername alias ui_$priority ui_$priority
1005        foreach phase ${macports::port_phases} {
1006            $workername alias ui_${priority}_${phase} ui_${priority}_${phase}
1007        }
1008 
1009    }
1010
1011    $workername alias ui_prefix ui_prefix
1012    $workername alias ui_channels ui_channels
1013   
1014    $workername alias ui_warn_once ui_warn_once
1015
1016    # Export some utility functions defined here.
1017    $workername alias macports_create_thread macports::create_thread
1018    $workername alias getportworkpath_from_buildpath macports::getportworkpath_from_buildpath
1019    $workername alias getportresourcepath macports::getportresourcepath
1020    $workername alias getportlogpath macports::getportlogpath
1021    $workername alias getdefaultportresourcepath macports::getdefaultportresourcepath
1022    $workername alias getprotocol macports::getprotocol
1023    $workername alias getportdir macports::getportdir
1024    $workername alias findBinary macports::findBinary
1025    $workername alias binaryInPath macports::binaryInPath
1026    $workername alias sysctl sysctl
1027    $workername alias realpath realpath
1028    $workername alias _mportsearchpath _mportsearchpath
1029    $workername alias _portnameactive _portnameactive
1030
1031    # New Registry/Receipts stuff
1032    $workername alias registry_new registry::new_entry
1033    $workername alias registry_open registry::open_entry
1034    $workername alias registry_write registry::write_entry
1035    $workername alias registry_prop_store registry::property_store
1036    $workername alias registry_prop_retr registry::property_retrieve
1037    $workername alias registry_exists registry::entry_exists
1038    $workername alias registry_exists_for_name registry::entry_exists_for_name
1039    $workername alias registry_activate portimage::activate
1040    $workername alias registry_deactivate portimage::deactivate
1041    $workername alias registry_uninstall registry_uninstall::uninstall
1042    $workername alias registry_register_deps registry::register_dependencies
1043    $workername alias registry_fileinfo_for_index registry::fileinfo_for_index
1044    $workername alias registry_bulk_register_files registry::register_bulk_files
1045    $workername alias registry_active registry::active
1046    $workername alias registry_file_registered registry::file_registered
1047
1048    # deferred options processing.
1049    $workername alias getoption macports::getoption
1050
1051    foreach opt $portinterp_options {
1052        if {![info exists $opt]} {
1053            global macports::$opt
1054        }
1055        if {[info exists $opt]} {
1056            $workername eval set system_options($opt) \{[set $opt]\}
1057            $workername eval set $opt \{[set $opt]\}
1058        }
1059    }
1060
1061    foreach opt $portinterp_deferred_options {
1062        global macports::$opt
1063        # define the trace hook.
1064        $workername eval \
1065            "proc trace_$opt {name1 name2 op} { \n\
1066                trace remove variable ::$opt read ::trace_$opt \n\
1067                global $opt \n\
1068                set $opt \[getoption $opt\] \n\
1069            }"
1070        # next access will actually define the variable.
1071        $workername eval "trace add variable ::$opt read ::trace_$opt"
1072        # define some value now
1073        $workername eval set $opt "?"
1074    }
1075
1076    foreach {opt val} $options {
1077        $workername eval set user_options($opt) $val
1078        $workername eval set $opt $val
1079    }
1080
1081    foreach {var val} $variations {
1082        $workername eval set variations($var) $val
1083    }
1084
1085    if { [info exists registry.installtype] } {
1086        $workername eval set installtype ${registry.installtype}
1087    }
1088}
1089
1090# Create a thread with most configuration options set.
1091# The newly created thread is sent portinterp_options vars and knows where to
1092# find all packages we know.
1093proc macports::create_thread {} {
1094    package require Thread
1095
1096    global macports::portinterp_options
1097
1098    # Create the thread.
1099    set result [thread::create -preserved {thread::wait}]
1100
1101    # Tell the thread about all the Tcl packages we already
1102    # know about so it won't glob for packages.
1103    foreach pkgName [package names] {
1104        foreach pkgVers [package versions $pkgName] {
1105            set pkgLoadScript [package ifneeded $pkgName $pkgVers]
1106            thread::send -async $result "package ifneeded $pkgName $pkgVers {$pkgLoadScript}"
1107        }
1108    }
1109
1110    # inherit configuration variables.
1111    thread::send -async $result "namespace eval macports {}"
1112    foreach opt $portinterp_options {
1113        if {![info exists $opt]} {
1114            global macports::$opt
1115        }
1116        if {[info exists $opt]} {
1117            thread::send -async $result "global macports::$opt"
1118            set val [set macports::$opt]
1119            thread::send -async $result "set macports::$opt \"$val\""
1120        }
1121    }
1122
1123    return $result
1124}
1125
1126proc macports::fetch_port {url} {
1127    global macports::portdbpath tcl_platform
1128    set fetchdir [file join $portdbpath portdirs]
1129    set fetchfile [file tail $url]
1130    file mkdir $fetchdir
1131    if {![file writable $fetchdir]} {
1132        return -code error "Port remote fetch failed: You do not have permission to write to $fetchdir"
1133    }
1134    if {[catch {curl fetch $url [file join $fetchdir $fetchfile]} result]} {
1135        return -code error "Port remote fetch failed: $result"
1136    }
1137    cd $fetchdir
1138    if {[catch {exec [findBinary tar $macports::autoconf::tar_path] -zxf $fetchfile} result]} {
1139        return -code error "Port extract failed: $result"
1140    }
1141    if {[regexp {(.+).tgz} $fetchfile match portdir] != 1} {
1142        return -code error "Can't decipher portdir from $fetchfile"
1143    }
1144    return [file join $fetchdir $portdir]
1145}
1146
1147proc macports::getprotocol {url} {
1148    if {[regexp {(?x)([^:]+)://.+} $url match protocol] == 1} {
1149        return ${protocol}
1150    } else {
1151        return -code error "Can't parse url $url"
1152    }
1153}
1154
1155# XXX: this really needs to be rethought in light of the remote index
1156# I've added the destdir parameter.  This is the location a remotely
1157# fetched port will be downloaded to (currently only applies to
1158# mports:// sources).
1159proc macports::getportdir {url {destdir "."}} {
1160    set protocol [macports::getprotocol $url]
1161    switch ${protocol} {
1162        file {
1163            return [file normalize [string range $url [expr [string length $protocol] + 3] end]]
1164        }
1165        mports {
1166            return [macports::index::fetch_port $url $destdir]
1167        }
1168        https -
1169        http -
1170        ftp {
1171            return [macports::fetch_port $url]
1172        }
1173        default {
1174            return -code error "Unsupported protocol $protocol"
1175        }
1176    }
1177}
1178
1179##
1180# Get the path to the _resources directory of the source
1181#
1182# If the file is not available in the current source, it will fall back to the
1183# default source. This behavior is controlled by the fallback parameter.
1184#
1185# @param url port url
1186# @param path path in _resources we are interested in
1187# @param fallback fall back to the default source tree
1188# @return path to the _resources directory or the path to the fallback
1189proc macports::getportresourcepath {url {path ""} {fallback yes}} {
1190    global macports::sources_default
1191
1192    set protocol [getprotocol $url]
1193
1194    switch -- ${protocol} {
1195        file {
1196            set proposedpath [file normalize [file join [getportdir $url] .. ..]]
1197        }
1198        default {
1199            set proposedpath [getsourcepath $url]
1200        }
1201    }
1202
1203    # append requested path
1204    set proposedpath [file join $proposedpath _resources $path]
1205
1206    if {$fallback == "yes" && ![file exists $proposedpath]} {
1207        return [getdefaultportresourcepath $path]
1208    }
1209
1210    return $proposedpath
1211}
1212
1213##
1214# Get the path to the _resources directory of the default source
1215#
1216# @param path path in _resources we are interested in
1217# @return path to the _resources directory of the default source
1218proc macports::getdefaultportresourcepath {{path ""}} {
1219    global macports::sources_default
1220
1221    set default_source_url [lindex ${sources_default} 0]
1222    if {[getprotocol $default_source_url] == "file"} {
1223        set proposedpath [getportdir $default_source_url]
1224    } else {
1225        set proposedpath [getsourcepath $default_source_url]
1226    }
1227
1228    # append requested path
1229    set proposedpath [file join $proposedpath _resources $path]
1230
1231    return $proposedpath
1232}
1233
1234
1235# mportopen
1236# Opens a MacPorts portfile specified by a URL.  The Portfile is
1237# opened with the given list of options and variations.  The result
1238# of this function should be treated as an opaque handle to a
1239# MacPorts Portfile.
1240
1241proc mportopen {porturl {options ""} {variations ""} {nocache ""}} {
1242    global macports::portdbpath macports::portconf macports::open_mports auto_path
1243
1244    # Look for an already-open MPort with the same URL.
1245    # XXX: should compare options and variations here too.
1246    # if found, return the existing reference and bump the refcount.
1247    if {$nocache != ""} {
1248        set mport {}
1249    } else {
1250        set mport [dlist_search $macports::open_mports porturl $porturl]
1251    }
1252    if {$mport != {}} {
1253        set refcnt [ditem_key $mport refcnt]
1254        incr refcnt
1255        ditem_key $mport refcnt $refcnt
1256        return $mport
1257    }
1258
1259    array set options_array $options
1260    if {[info exists options_array(portdir)]} {
1261        set portdir $options_array(portdir)
1262    } else {
1263        set portdir ""
1264    }
1265    if {![info exists options_array(ports_requested)]} {
1266        lappend options ports_requested 0
1267    }
1268
1269    set portpath [macports::getportdir $porturl $portdir]
1270    ui_debug "Changing to port directory: $portpath"
1271    cd $portpath
1272    if {![file isfile Portfile]} {
1273        return -code error "Could not find Portfile in $portpath"
1274    }
1275
1276    set workername [interp create]
1277
1278    set mport [ditem_create]
1279    lappend macports::open_mports $mport
1280    ditem_key $mport porturl $porturl
1281    ditem_key $mport portpath $portpath
1282    ditem_key $mport workername $workername
1283    ditem_key $mport options $options
1284    ditem_key $mport variations $variations
1285    ditem_key $mport refcnt 1
1286
1287    macports::worker_init $workername $portpath $porturl [macports::getportbuildpath $portpath] $options $variations
1288
1289    $workername eval source Portfile
1290
1291    # add the default universal variant if appropriate, and set up flags that
1292    # are conditional on whether universal is set
1293    $workername eval universal_setup
1294
1295    # evaluate the variants
1296    if {[$workername eval eval_variants variations] != 0} {
1297        mportclose $mport
1298        error "Error evaluating variants"
1299    }
1300
1301    ditem_key $mport provides [$workername eval return \$name]
1302
1303    return $mport
1304}
1305
1306# mportopen_installed
1307# opens a portfile stored in the registry
1308proc mportopen_installed {name version revision variants options} {
1309    global macports::registry.format macports::registry.path
1310    if {${registry.format} != "receipt_sqlite"} {
1311        return -code error "mportopen_installed requires sqlite registry"
1312    }
1313    set regref [lindex [registry::entry imaged $name $version $revision $variants] 0]
1314    set portfile_dir [file join ${registry.path} registry portfiles $name "${version}_${revision}${variants}"]
1315    file mkdir $portfile_dir
1316    set fd [open "${portfile_dir}/Portfile" w]
1317    puts $fd [$regref portfile]
1318    close $fd
1319    file mtime "${portfile_dir}/Portfile" [$regref date]
1320
1321    set variations {}
1322    set minusvariant [lrange [split [$regref negated_variants] -] 1 end]
1323    set plusvariant [lrange [split [$regref variants] +] 1 end]
1324    foreach v $plusvariant {
1325        lappend variations $v "+"
1326    }
1327    foreach v $minusvariant {
1328        lappend variations $v "-"
1329    }
1330   
1331    return [mportopen "file://${portfile_dir}/" $options $variations]
1332}
1333
1334# mportclose_installed
1335# close mport opened with mportopen_installed and clean up associated files
1336proc mportclose_installed {mport} {
1337    global macports::registry.path
1338    foreach key {name version revision portvariants} {
1339        set $key [_mportkey $mport $key]
1340    }
1341    mportclose $mport
1342    set portfiles_dir [file join ${registry.path} registry portfiles $name]
1343    set portfile [file join $portfiles_dir "${version}_${revision}${portvariants}" Portfile]
1344    file delete -force $portfile [file dirname $portfile]
1345    if {[llength [glob -nocomplain -directory $portfiles_dir *]] == 0} {
1346        file delete -force $portfiles_dir
1347    }
1348}
1349
1350# Traverse a directory with ports, calling a function on the path of ports
1351# (at the second depth).
1352# I.e. the structure of dir shall be:
1353# category/port/
1354# with a Portfile file in category/port/
1355#
1356# func:     function to call on every port directory (it is passed
1357#           category/port/ as its parameter)
1358# root:     the directory with all the categories directories.
1359proc mporttraverse {func {root .}} {
1360    # Save the current directory
1361    set pwd [pwd]
1362
1363    # Join the root.
1364    set pathToRoot [file join $pwd $root]
1365
1366    # Go to root because some callers expects us to be there.
1367    cd $pathToRoot
1368
1369    foreach category [lsort -increasing -unique [readdir $root]] {
1370        set pathToCategory [file join $root $category]
1371        # process the category dirs but not _resources
1372        if {[file isdirectory $pathToCategory] && [string index [file tail $pathToCategory] 0] != "_"} {
1373            # Iterate on port directories.
1374            foreach port [lsort -increasing -unique [readdir $pathToCategory]] {
1375                set pathToPort [file join $pathToCategory $port]
1376                if {[file isdirectory $pathToPort] &&
1377                  [file exists [file join $pathToPort "Portfile"]]} {
1378                    # Call the function.
1379                    $func [file join $category $port]
1380
1381                    # Restore the current directory because some
1382                    # functions changes it.
1383                    cd $pathToRoot
1384                }
1385            }
1386        }
1387    }
1388
1389    # Restore the current directory.
1390    cd $pwd
1391}
1392
1393### _mportsearchpath is private; subject to change without notice
1394
1395# depregex -> regex on the filename to find.
1396# search_path -> directories to search
1397# executable -> whether we want to check that the file is executable by current
1398#               user or not.
1399proc _mportsearchpath {depregex search_path {executable 0} {return_match 0}} {
1400    set found 0
1401    foreach path $search_path {
1402        if {![file isdirectory $path]} {
1403            continue
1404        }
1405
1406        if {[catch {set filelist [readdir $path]} result]} {
1407            return -code error "$result ($path)"
1408        }
1409
1410        foreach filename $filelist {
1411            if {[regexp $depregex $filename] &&
1412              (($executable == 0) || [file executable [file join $path $filename]])} {
1413                ui_debug "Found Dependency: path: $path filename: $filename regex: $depregex"
1414                set found 1
1415                break
1416            }
1417        }
1418    }
1419    if {$return_match} {
1420        if {$found} {
1421            return [file join $path $filename]
1422        } else {
1423            return ""
1424        }
1425    } else {
1426        return $found
1427    }
1428}
1429
1430
1431### _mportinstalled is private; may change without notice
1432
1433# Determine if a port is already *installed*, as in "in the registry".
1434proc _mportinstalled {mport} {
1435    # Check for the presence of the port in the registry
1436    set workername [ditem_key $mport workername]
1437    return [$workername eval registry_exists_for_name \${name}]
1438}
1439
1440# Determine if a port is active (only for image mode)
1441proc _mportactive {mport} {
1442    set workername [ditem_key $mport workername]
1443    if {![catch {set reslist [$workername eval registry_active \${name}]}] && [llength $reslist] > 0} {
1444        set i [lindex $reslist 0]
1445        set name [lindex $i 0]
1446        set version [lindex $i 1]
1447        set revision [lindex $i 2]
1448        set variants [lindex $i 3]
1449        array set portinfo [mportinfo $mport]
1450        if {$name == $portinfo(name) && $version == $portinfo(version)
1451            && $revision == $portinfo(revision) && $variants == $portinfo(canonical_active_variants)} {
1452            return 1
1453        }
1454    }
1455    return 0
1456}
1457
1458# Determine if the named port is active (only for image mode)
1459proc _portnameactive {portname} {
1460    if {[catch {set reslist [registry::active $portname]}]} {
1461        return 0
1462    } else {
1463        return [expr [llength $reslist] > 0]
1464    }
1465}
1466
1467### _mportispresent is private; may change without notice
1468
1469# Determine if some depspec is satisfied or if the given port is installed
1470# (and active, if we're in image mode).
1471# We actually start with the registry (faster?)
1472#
1473# mport     the port declaring the dep (context in which to evaluate $prefix etc)
1474# depspec   the dependency test specification (path, bin, lib, etc.)
1475proc _mportispresent {mport depspec} {
1476    set portname [lindex [split $depspec :] end]
1477    ui_debug "Searching for dependency: $portname"
1478    if {[string equal ${macports::registry.installtype} "image"]} {
1479        set res [_portnameactive $portname]
1480    } else {
1481        set res [registry::entry_exists_for_name $portname]
1482    }
1483    if {$res != 0} {
1484        ui_debug "Found Dependency: receipt exists for $portname"
1485        return 1
1486    } else {
1487        # The receipt test failed, use one of the depspec regex mechanisms
1488        ui_debug "Didn't find receipt, going to depspec regex for: $portname"
1489        set workername [ditem_key $mport workername]
1490        set type [lindex [split $depspec :] 0]
1491        switch $type {
1492            lib { return [$workername eval _libtest $depspec] }
1493            bin { return [$workername eval _bintest $depspec] }
1494            path { return [$workername eval _pathtest $depspec] }
1495            port { return 0 }
1496            default {return -code error "unknown depspec type: $type"}
1497        }
1498        return 0
1499    }
1500}
1501
1502### _mportconflictsinstalled is private; may change without notice
1503
1504# Determine if the port, per the conflicts option, has any conflicts with
1505# what is installed.
1506#
1507# mport   the port to check for conflicts
1508# Returns a list of which installed ports conflict, or an empty list if none
1509proc _mportconflictsinstalled {mport conflictinfo} {
1510    set conflictlist {}
1511    if {[llength $conflictinfo] > 0} {
1512        ui_debug "Checking for conflicts against [_mportkey $mport name]"
1513        foreach conflictport ${conflictinfo} {
1514            if {[_mportispresent $mport port:${conflictport}]} {
1515                lappend conflictlist $conflictport
1516            }
1517        }
1518    } else {
1519        ui_debug "[_mportkey $mport name] has no conflicts"
1520    }
1521
1522    return $conflictlist
1523}
1524
1525
1526### _mportexec is private; may change without notice
1527
1528proc _mportexec {target mport} {
1529    set portname [_mportkey $mport name]
1530    macports::push_log $mport
1531    # xxx: set the work path?
1532    set workername [ditem_key $mport workername]
1533    if {![catch {$workername eval check_variants $target} result] && $result == 0 &&
1534        ![catch {$workername eval check_supported_archs} result] && $result == 0 &&
1535        ![catch {$workername eval eval_targets $target} result] && $result == 0} {
1536        # If auto-clean mode, clean-up after dependency install
1537        if {[string equal ${macports::portautoclean} "yes"]} {
1538            # Make sure we are back in the port path before clean
1539            # otherwise if the current directory had been changed to
1540            # inside the port,  the next port may fail when trying to
1541            # install because [pwd] will return a "no file or directory"
1542            # error since the directory it was in is now gone.
1543            set portpath [ditem_key $mport portpath]
1544            catch {cd $portpath}
1545            $workername eval eval_targets clean
1546        }
1547        # XXX hack to avoid running out of fds due to sqlite temp files, ticket #24857
1548        interp delete $workername
1549        macports::pop_log
1550        return 0
1551    } else {
1552        # An error occurred.
1553        global ::logenabled ::debuglogname
1554        if {[info exists ::logenabled] && $::logenabled && [info exists ::debuglogname]} {
1555            ui_notice "Log for $portname is at: $::debuglogname"
1556        }
1557        macports::pop_log
1558        return 1
1559    }
1560}
1561
1562# mportexec
1563# Execute the specified target of the given mport.
1564proc mportexec {mport target} {
1565    global macports::registry.installtype
1566
1567    set workername [ditem_key $mport workername]
1568
1569    # check variants
1570    if {[$workername eval check_variants $target] != 0} {
1571        return 1
1572    }
1573    set portname [_mportkey $mport name]
1574    if {$target != "clean"} {
1575        macports::push_log $mport
1576    }
1577
1578    # Before we build the port, we must build its dependencies.
1579    set dlist {}
1580    if {[macports::_target_needs_deps $target]} {
1581
1582        # possibly warn or error out depending on how old xcode is
1583        if {[$workername eval _check_xcode_version] != 0} {
1584            return 1
1585        }
1586        # error out if selected arch(s) not supported by this port
1587        if {[$workername eval check_supported_archs] != 0} {
1588            return 1
1589        }
1590
1591        # upgrade dependencies that are already installed
1592        if {![macports::global_option_isset ports_nodeps]} {
1593            macports::_upgrade_mport_deps $mport $target
1594        }
1595
1596        ui_msg -nonewline "--->  Computing dependencies for [_mportkey $mport name]"
1597        if {[macports::ui_isset ports_debug]} {
1598            # play nice with debug messages
1599            ui_msg ""
1600        }
1601        if {[mportdepends $mport $target] != 0} {
1602            return 1
1603        }
1604        if {![macports::ui_isset ports_debug]} {
1605            ui_msg ""
1606        }
1607
1608        # Select out the dependents along the critical path,
1609        # but exclude this mport, we might not be installing it.
1610        set dlist [dlist_append_dependents $macports::open_mports $mport {}]
1611
1612        dlist_delete dlist $mport
1613       
1614        # print the dep list
1615        if {[llength $dlist] > 0} {
1616            set depstring "--->  Dependencies to be installed:"
1617            foreach ditem $dlist {
1618                append depstring " [ditem_key $ditem provides]"
1619            }
1620            ui_msg $depstring
1621        }
1622
1623        # install them
1624        # xxx: as with below, this is ugly.  and deps need to be fixed to
1625        # understand Port Images before this can get prettier
1626        if { [string equal ${macports::registry.installtype} "image"] } {
1627            set result [dlist_eval $dlist _mportactive [list _mportexec "activate"]]
1628        } else {
1629            set result [dlist_eval $dlist _mportinstalled [list _mportexec "activate"]]
1630        }
1631
1632        if {$result != {}} {
1633            set errstring "The following dependencies failed to build:"
1634            foreach ditem $result {
1635                append errstring " [ditem_key $ditem provides]"
1636            }
1637            ui_error $errstring
1638            foreach ditem $dlist {
1639                catch {mportclose $ditem}
1640            }
1641            return 1
1642        }
1643
1644        # Close the dependencies, we're done installing them.
1645        foreach ditem $dlist {
1646            mportclose $ditem
1647        }
1648    }
1649
1650    set clean 0
1651    if {[string equal ${macports::portautoclean} "yes"] && ([string equal $target "install"] || [string equal $target "activate"])} {
1652        # If we're doing an install, check if we should clean after
1653        set clean 1
1654    }
1655
1656    # Build this port with the specified target
1657    set result [$workername eval eval_targets $target]
1658
1659    # If auto-clean mode and successful install, clean-up after install
1660    if {$result == 0 && $clean == 1} {
1661        # Make sure we are back in the port path, just in case
1662        set portpath [ditem_key $mport portpath]
1663        catch {cd $portpath}
1664        $workername eval eval_targets clean
1665    }
1666   
1667    global ::logenabled ::debuglogname
1668    if {[info exists ::logenabled] && $::logenabled && [info exists ::debuglogname]} {
1669        if {$result != 0} {
1670            ui_notice "Log for $portname is at: $::debuglogname"
1671        }
1672        macports::pop_log
1673    }
1674
1675    return $result
1676}
1677
1678# upgrade any dependencies of mport that are installed and needed for target
1679proc macports::_upgrade_mport_deps {mport target} {
1680    set options [ditem_key $mport options]
1681    set workername [ditem_key $mport workername]
1682    set deptypes [macports::_deptypes_for_target $target]
1683    array set portinfo [mportinfo $mport]
1684    array set depscache {}
1685
1686    set required_archs [$workername eval get_canonical_archs]
1687    set depends_skip_archcheck [_mportkey $mport depends_skip_archcheck]
1688
1689    if {[string equal ${macports::registry.installtype} "image"]} {
1690        set test _portnameactive
1691    } else {
1692        set test registry::entry_exists_for_name
1693    }
1694
1695    foreach deptype $deptypes {
1696        if {![info exists portinfo($deptype)]} {
1697            set portinfo($deptype) ""
1698        }
1699        foreach depspec $portinfo($deptype) {
1700            set dep_portname [$workername eval _get_dep_port $depspec]
1701            if {$dep_portname != "" && ![info exists depscache(port:$dep_portname)] && [$test $dep_portname]} {
1702                set variants {}
1703   
1704                # check that the dep has the required archs
1705                set active_archs [_get_registry_archs $dep_portname]
1706                if {$deptype != "depends_fetch" && $deptype != "depends_extract"
1707                    && $active_archs != "" && $active_archs != "noarch" && $required_archs != "noarch"
1708                    && [lsearch -exact $depends_skip_archcheck $dep_portname] == -1} {
1709                    set missing {}
1710                    foreach arch $required_archs {
1711                        if {[lsearch -exact $active_archs $arch] == -1} {
1712                            lappend missing $arch
1713                        }
1714                    }
1715                    if {[llength $missing] > 0} {
1716                        set res [mportlookup $dep_portname]
1717                        array unset dep_portinfo
1718                        array set dep_portinfo [lindex $res 1]
1719                        if {[info exists dep_portinfo(variants)] && [lsearch $dep_portinfo(variants) universal] != -1} {
1720                            # dep offers a universal variant
1721                            if {[llength $active_archs] == 1} {
1722                                # not installed universal
1723                                set missing {}
1724                                foreach arch $required_archs {
1725                                    if {[lsearch -exact $macports::universal_archs $arch] == -1} {
1726                                        lappend missing $arch
1727                                    }
1728                                }
1729                                if {[llength $missing] > 0} {
1730                                    ui_error "Cannot install [_mportkey $mport name] for the arch(s) '$required_archs' because"
1731                                    ui_error "its dependency $dep_portname is only installed for the arch '$active_archs'"
1732                                    ui_error "and the configured universal_archs '$macports::universal_archs' are not sufficient."
1733                                    return -code error "architecture mismatch"
1734                                } else {
1735                                    # upgrade the dep with +universal
1736                                    lappend variants universal +
1737                                    lappend options ports_upgrade_enforce-variants yes
1738                                    ui_debug "enforcing +universal upgrade for $dep_portname"
1739                                }
1740                            } else {
1741                                # already universal
1742                                ui_error "Cannot install [_mportkey $mport name] for the arch(s) '$required_archs' because"
1743                                ui_error "its dependency $dep_portname is only installed for the archs '$active_archs'."
1744                                return -code error "architecture mismatch"
1745                            }
1746                        } else {
1747                            ui_error "Cannot install [_mportkey $mport name] for the arch(s) '$required_archs' because"
1748                            ui_error "its dependency $dep_portname is only installed for the arch '$active_archs'"
1749                            ui_error "and does not have a universal variant."
1750                            return -code error "architecture mismatch"
1751                        }
1752                    }
1753                }
1754   
1755                set status [macports::upgrade $dep_portname "port:$dep_portname" $variants $options depscache]
1756                # status 2 means the port was not found in the index
1757                if {$status != 0 && $status != 2 && ![macports::ui_isset ports_processall]} {
1758                    return -code error "upgrade $dep_portname failed"
1759                }
1760            }
1761        }
1762    }
1763}
1764
1765# get the archs with which the active version of portname is installed
1766proc macports::_get_registry_archs {portname} {
1767    if {[string equal ${macports::registry.installtype} "image"]} {
1768        set ilist [registry::active $portname]
1769    } else {
1770        set ilist [registry::installed $portname]
1771    }
1772    set i [lindex $ilist 0]
1773    set regref [registry::open_entry [lindex $i 0] [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
1774    set archs [registry::property_retrieve $regref archs]
1775    if {$archs == 0} {
1776        set archs ""
1777    }
1778    return $archs
1779}
1780
1781proc macports::getsourcepath {url} {
1782    global macports::portdbpath
1783
1784    set source_path [split $url ://]
1785
1786    if {[_source_is_snapshot $url]} {
1787        # daily snapshot tarball
1788        return [file join $portdbpath sources [join [lrange $source_path 3 end-1] /] ports]
1789    }
1790
1791    return [file join $portdbpath sources [lindex $source_path 3] [lindex $source_path 4] [lindex $source_path 5]]
1792}
1793
1794##
1795# Checks whether a supplied source URL is for a daily snapshot tarball
1796# (private)
1797#
1798# @param url source URL to check
1799# @return a list containing filename and extension or an empty list
1800proc _source_is_snapshot {url {filename ""} {extension ""}} {
1801    upvar $filename myfilename
1802    upvar $extension myextension
1803
1804    if {[regexp {^(?:https?|ftp)://.+/(.+\.(tar\.gz|tar\.bz2))$} $url -> f e]} {
1805        set myfilename $f
1806        set myextension $e
1807
1808        return 1
1809    }
1810
1811    return 0
1812}
1813
1814proc macports::getportbuildpath {id} {
1815    global macports::portdbpath
1816    regsub {://} $id {.} port_path
1817    regsub -all {/} $port_path {_} port_path
1818    return [file join $portdbpath build $port_path]
1819}
1820
1821proc macports::getportlogpath {id} {
1822    global macports::portdbpath
1823    regsub {://} $id {.} port_path
1824    regsub -all {/} $port_path {_} port_path
1825    return [file join $portdbpath logs $port_path]
1826}
1827
1828proc macports::getportworkpath_from_buildpath {portbuildpath} {
1829    return [file join $portbuildpath work]
1830}
1831
1832proc macports::getportworkpath_from_portdir {portpath} {
1833    return [macports::getportworkpath_from_buildpath [macports::getportbuildpath $portpath]]
1834}
1835
1836proc macports::getindex {source} {
1837    # Special case file:// sources
1838    if {[macports::getprotocol $source] == "file"} {
1839        return [file join [macports::getportdir $source] PortIndex]
1840    }
1841
1842    return [file join [macports::getsourcepath $source] PortIndex]
1843}
1844
1845proc mportsync {{optionslist {}}} {
1846    global macports::sources macports::portdbpath macports::rsync_options tcl_platform
1847    global macports::portverbose
1848    global macports::autoconf::rsync_path
1849    array set options $optionslist
1850
1851    set numfailed 0
1852
1853    ui_debug "Synchronizing ports tree(s)"
1854    foreach source $sources {
1855        set flags [lrange $source 1 end]
1856        set source [lindex $source 0]
1857        if {[lsearch -exact $flags nosync] != -1} {
1858            ui_debug "Skipping $source"
1859            continue
1860        }
1861        set needs_portindex 0
1862        ui_info "Synchronizing local ports tree from $source"
1863        switch -regexp -- [macports::getprotocol $source] {
1864            {^file$} {
1865                set portdir [macports::getportdir $source]
1866                if {[file exists $portdir/.svn]} {
1867                    set svn_commandline "[macports::findBinary svn] update --non-interactive ${portdir}"
1868                    ui_debug $svn_commandline
1869                    if {
1870                        [catch {
1871                            if {[getuid] == 0} {
1872                                set euid [geteuid]
1873                                set egid [getegid]
1874                                ui_debug "changing euid/egid - current euid: $euid - current egid: $egid"
1875                                setegid [name_to_gid [file attributes $portdir -group]]
1876                                seteuid [name_to_uid [file attributes $portdir -owner]]
1877                            }
1878                            system $svn_commandline
1879                            if {[getuid] == 0} {
1880                                seteuid $euid
1881                                setegid $egid
1882                            }
1883                        }]
1884                    } {
1885                        ui_debug "$::errorInfo"
1886                        ui_error "Synchronization of the local ports tree failed doing an svn update"
1887                        incr numfailed
1888                        continue
1889                    }
1890                }
1891                set needs_portindex 1
1892            }
1893            {^mports$} {
1894                macports::index::sync $macports::portdbpath $source
1895            }
1896            {^rsync$} {
1897                # Where to, boss?
1898                set indexfile [macports::getindex $source]
1899                set destdir [file dirname $indexfile]
1900                file mkdir $destdir
1901                # Keep rsync happy with a trailing slash
1902                if {[string index $source end] != "/"} {
1903                    append source "/"
1904                }
1905                # don't sync PortIndex yet; we grab the platform specific one afterwards
1906                set exclude_option "'--exclude=/PortIndex*'"
1907                # Do rsync fetch
1908                set rsync_commandline "${macports::autoconf::rsync_path} ${rsync_options} ${exclude_option} ${source} ${destdir}"
1909                ui_debug $rsync_commandline
1910                if {[catch {system $rsync_commandline}]} {
1911                    ui_error "Synchronization of the local ports tree failed doing rsync"
1912                    incr numfailed
1913                    continue
1914                }
1915                # now sync the index if the local file is missing or older than a day
1916                if {![file isfile $indexfile] || [expr [clock seconds] - [file mtime $indexfile]] > 86400} {
1917                    set remote_indexfile "${source}PortIndex_${macports::os_platform}_${macports::os_major}_${macports::os_arch}/PortIndex"
1918                    set rsync_commandline "${macports::autoconf::rsync_path} ${rsync_options} $remote_indexfile ${destdir}"
1919                    ui_debug $rsync_commandline
1920                    if {[catch {system $rsync_commandline}]} {
1921                        ui_debug "Synchronization of the PortIndex failed doing rsync"
1922                    } else {
1923                        mports_generate_quickindex $indexfile
1924                    }
1925                }
1926                if {[catch {system "chmod -R a+r \"$destdir\""}]} {
1927                    ui_warn "Setting world read permissions on parts of the ports tree failed, need root?"
1928                }
1929                set needs_portindex 1
1930            }
1931            {^https?$|^ftp$} {
1932                if {[_source_is_snapshot $source filename extension]} {
1933                    # sync a daily port snapshot tarball
1934                    set indexfile [macports::getindex $source]
1935                    set destdir [file dirname $indexfile]
1936                    set tarpath [file join [file normalize [file join $destdir ..]] $filename]
1937
1938                    set updated 1
1939                    if {[file isdirectory $destdir]} {
1940                        set moddate [file mtime $destdir]
1941                        if {[catch {set updated [curl isnewer $source $moddate]} error]} {
1942                            ui_warn "Cannot check if $source was updated, ($error)"
1943                        }
1944                    }
1945
1946                    if {(![info exists options(ports_force)] || $options(ports_force) != "yes") && $updated <= 0} {
1947                        ui_info "No updates for $source"
1948                        continue
1949                    }
1950
1951                    file mkdir $destdir
1952
1953                    set verboseflag {}
1954                    if {$macports::portverbose == "yes"} {
1955                        set verboseflag "-v"
1956                    }
1957
1958                    if {[catch {eval curl fetch $verboseflag {$source} {$tarpath}} error]} {
1959                        ui_error "Fetching $source failed ($error)"
1960                        incr numfailed
1961                        continue
1962                    }
1963
1964                    set extflag {}
1965                    switch $extension {
1966                        {tar.gz} {
1967                            set extflag "-z"
1968                        }
1969                        {tar.bz2} {
1970                            set extflag "-j"
1971                        }
1972                    }
1973
1974                    set tar [macports::findBinary tar $macports::autoconf::tar_path]
1975                    if { [catch { system "cd $destdir/.. && $tar ${verboseflag} ${extflag} -xf $filename" } error] } {
1976                        ui_error "Extracting $source failed ($error)"
1977                        incr numfailed
1978                        continue
1979                    }
1980
1981                    if {[catch {system "chmod -R a+r \"$destdir\""}]} {
1982                        ui_warn "Setting world read permissions on parts of the ports tree failed, need root?"
1983                    }
1984
1985                    set platindex "PortIndex_${macports::os_platform}_${macports::os_major}_${macports::os_arch}/PortIndex"
1986                    if {[file isfile ${destdir}/${platindex}] && [file isfile ${destdir}/${platindex}.quick]} {
1987                        file rename -force "${destdir}/${platindex}" "${destdir}/${platindex}.quick" $destdir
1988                    }
1989
1990                    file delete $tarpath
1991                   
1992                    set needs_portindex 1
1993                } else {
1994                    # sync just a PortIndex file
1995                    set indexfile [macports::getindex $source]
1996                    file mkdir [file dirname $indexfile]
1997                    curl fetch ${source}/PortIndex $indexfile
1998                    curl fetch ${source}/PortIndex.quick ${indexfile}.quick
1999                }
2000            }
2001            default {
2002                ui_warn "Unknown synchronization protocol for $source"
2003            }
2004        }
2005       
2006        if {$needs_portindex} {
2007            global macports::prefix
2008            set indexdir [file dirname [macports::getindex $source]]
2009            if {[catch {system "${macports::prefix}/bin/portindex $indexdir"}]} {
2010                ui_error "updating PortIndex for $source failed"
2011            }
2012        }
2013    }
2014
2015    # refresh the quick index if necessary (batch or interactive run)
2016    if {[info exists macports::ui_options(ports_commandfiles)]} {
2017        _mports_load_quickindex
2018    }
2019
2020    if {$numfailed > 0} {
2021        return -code error "Synchronization of $numfailed source(s) failed"
2022    }
2023}
2024
2025proc mportsearch {pattern {case_sensitive yes} {matchstyle regexp} {field name}} {
2026    global macports::portdbpath macports::sources
2027    set matches [list]
2028    set easy [expr { $field == "name" }]
2029
2030    set found 0
2031    foreach source $sources {
2032        set source [lindex $source 0]
2033        set protocol [macports::getprotocol $source]
2034        if {$protocol == "mports"} {
2035            set res [macports::index::search $macports::portdbpath $source [list name $pattern]]
2036            eval lappend matches $res
2037        } else {
2038            if {[catch {set fd [open [macports::getindex $source] r]} result]} {
2039                ui_warn "Can't open index file for source: $source"
2040            } else {
2041                try {
2042                    incr found 1
2043                    while {[gets $fd line] >= 0} {
2044                        array unset portinfo
2045                        set name [lindex $line 0]
2046                        set len [lindex $line 1]
2047                        set line [read $fd $len]
2048
2049                        if {$easy} {
2050                            set target $name
2051                        } else {
2052                            array set portinfo $line
2053                            if {![info exists portinfo($field)]} continue
2054                            set target $portinfo($field)
2055                        }
2056
2057                        switch $matchstyle {
2058                            exact {
2059                                set matchres [expr 0 == ( {$case_sensitive == "yes"} ? [string compare $pattern $target] : [string compare -nocase $pattern $target] )]
2060                            }
2061                            glob {
2062                                set matchres [expr {$case_sensitive == "yes"} ? [string match $pattern $target] : [string match -nocase $pattern $target]]
2063                            }
2064                            regexp -
2065                            default {
2066                                set matchres [expr {$case_sensitive == "yes"} ? [regexp -- $pattern $target] : [regexp -nocase -- $pattern $target]]
2067                            }
2068                        }
2069
2070                        if {$matchres == 1} {
2071                            if {$easy} {
2072                                array set portinfo $line
2073                            }
2074                            switch $protocol {
2075                                rsync {
2076                                    # Rsync files are local
2077                                    set source_url "file://[macports::getsourcepath $source]"
2078                                }
2079                                https -
2080                                http -
2081                                ftp {
2082                                    if {[_source_is_snapshot $source filename extension]} {
2083                                        # daily snapshot tarball
2084                                        set source_url "file://[macports::getsourcepath $source]"
2085                                    } else {
2086                                        # default action
2087                                        set source_url $source
2088                                    }
2089                                }
2090                                default {
2091                                    set source_url $source
2092                                }
2093                            }
2094                            if {[info exists portinfo(portarchive)]} {
2095                                set porturl ${source_url}/$portinfo(portarchive)
2096                            } elseif {[info exists portinfo(portdir)]} {
2097                                set porturl ${source_url}/$portinfo(portdir)
2098                            }
2099                            if {[info exists porturl]} {
2100                                lappend line porturl $porturl
2101                                ui_debug "Found port in $porturl"
2102                            } else {
2103                                ui_debug "Found port info: $line"
2104                            }
2105                            lappend matches $name
2106                            lappend matches $line
2107                        }
2108                    }
2109                } catch {*} {
2110                    ui_warn "It looks like your PortIndex file for $source may be corrupt."
2111                    throw
2112                } finally {
2113                    close $fd
2114                }
2115            }
2116        }
2117    }
2118    if {!$found} {
2119        return -code error "No index(es) found! Have you synced your source indexes?"
2120    }
2121
2122    return $matches
2123}
2124
2125# Returns the PortInfo for a single named port. The info comes from the
2126# PortIndex, and name matching is case-insensitive. Unlike mportsearch, only
2127# the first match is returned, but the return format is otherwise identical.
2128# The advantage is that mportlookup is much faster than mportsearch, due to
2129# the use of the quick index.
2130proc mportlookup {name} {
2131    global macports::portdbpath macports::sources
2132
2133    set sourceno 0
2134    set matches [list]
2135    foreach source $sources {
2136        set source [lindex $source 0]
2137        set protocol [macports::getprotocol $source]
2138        if {$protocol != "mports"} {
2139            global macports::quick_index
2140            if {![info exists quick_index($sourceno,[string tolower $name])]} {
2141                incr sourceno 1
2142                continue
2143            }
2144            # The quick index is keyed on the port name, and provides the
2145            # offset in the main PortIndex where the given port's PortInfo
2146            # line can be found.
2147            set offset $quick_index($sourceno,[string tolower $name])
2148            incr sourceno 1
2149            if {[catch {set fd [open [macports::getindex $source] r]} result]} {
2150                ui_warn "Can't open index file for source: $source"
2151            } else {
2152                try {
2153                    seek $fd $offset
2154                    gets $fd line
2155                    set name [lindex $line 0]
2156                    set len [lindex $line 1]
2157                    set line [read $fd $len]
2158
2159                    array set portinfo $line
2160
2161                    switch $protocol {
2162                        rsync {
2163                            set source_url "file://[macports::getsourcepath $source]"
2164                        }
2165                        https -
2166                        http -
2167                        ftp {
2168                            if {[_source_is_snapshot $source filename extension]} {
2169                                set source_url "file://[macports::getsourcepath $source]"
2170                             } else {
2171                                set source_url $source
2172                             }
2173                        }
2174                        default {
2175                            set source_url $source
2176                        }
2177                    }
2178                    if {[info exists portinfo(portarchive)]} {
2179                        set porturl ${source_url}/$portinfo(portarchive)
2180                    } elseif {[info exists portinfo(portdir)]} {
2181                        set porturl ${source_url}/$portinfo(portdir)
2182                    }
2183                    if {[info exists porturl]} {
2184                        lappend line porturl $porturl
2185                    }
2186                    lappend matches $name
2187                    lappend matches $line
2188                    close $fd
2189                    set fd -1
2190                } catch {*} {
2191                    ui_warn "It looks like your PortIndex file for $source may be corrupt."
2192                } finally {
2193                    if {$fd != -1} {
2194                        close $fd
2195                    }
2196                }
2197                if {[llength $matches] > 0} {
2198                    break
2199                }
2200            }
2201        } else {
2202            set res [macports::index::search $macports::portdbpath $source [list name $name]]
2203            if {[llength $res] > 0} {
2204                eval lappend matches $res
2205                break
2206            }
2207        }
2208    }
2209
2210    return $matches
2211}
2212
2213# Returns all ports in the indices. Faster than 'mportsearch .*'
2214proc mportlistall {args} {
2215    global macports::portdbpath macports::sources
2216    set matches [list]
2217
2218    set found 0
2219    foreach source $sources {
2220        set source [lindex $source 0]
2221        set protocol [macports::getprotocol $source]
2222        if {$protocol != "mports"} {
2223            if {![catch {set fd [open [macports::getindex $source] r]} result]} {
2224                try {
2225                    incr found 1
2226                    while {[gets $fd line] >= 0} {
2227                        array unset portinfo
2228                        set name [lindex $line 0]
2229                        set len [lindex $line 1]
2230                        set line [read $fd $len]
2231
2232                        array set portinfo $line
2233
2234                        switch $protocol {
2235                            rsync {
2236                                set source_url "file://[macports::getsourcepath $source]"
2237                            }
2238                            https -
2239                            http -
2240                            ftp {
2241                                if {[_source_is_snapshot $source filename extension]} {
2242                                    set source_url "file://[macports::getsourcepath $source]"
2243                                } else {
2244                                    set source_url $source
2245                                }
2246                            }
2247                            default {
2248                                set source_url $source
2249                            }
2250                        }
2251                        if {[info exists portinfo(portdir)]} {
2252                            set porturl ${source_url}/$portinfo(portdir)
2253                        } elseif {[info exists portinfo(portarchive)]} {
2254                            set porturl ${source_url}/$portinfo(portarchive)
2255                        }
2256                        if {[info exists porturl]} {
2257                            lappend line porturl $porturl
2258                        }
2259                        lappend matches $name $line
2260                    }
2261                } catch {*} {
2262                    ui_warn "It looks like your PortIndex file for $source may be corrupt."
2263                    throw
2264                } finally {
2265                    close $fd
2266                }
2267            } else {
2268                ui_warn "Can't open index file for source: $source"
2269            }
2270        } else {
2271            set res [macports::index::search $macports::portdbpath $source [list name .*]]
2272            eval lappend matches $res
2273        }
2274    }
2275    if {!$found} {
2276        return -code error "No index(es) found! Have you synced your source indexes?"
2277    }
2278
2279    return $matches
2280}
2281
2282
2283# Loads PortIndex.quick from each source into the quick_index, generating
2284# it first if necessary.
2285proc _mports_load_quickindex {args} {
2286    global macports::sources macports::quick_index
2287
2288    unset -nocomplain macports::quick_index
2289
2290    set sourceno 0
2291    foreach source $sources {
2292        unset -nocomplain quicklist
2293        # chop off any tags
2294        set source [lindex $source 0]
2295        set index [macports::getindex $source]
2296        if {![file exists ${index}]} {
2297            continue
2298        }
2299        if {![file exists ${index}.quick]} {
2300            ui_warn "No quick index file found, attempting to generate one for source: $source"
2301            if {[catch {set quicklist [mports_generate_quickindex ${index}]}]} {
2302                continue
2303            }
2304        }
2305        # only need to read the quick index file if we didn't just update it
2306        if {![info exists quicklist]} {
2307            if {[catch {set fd [open ${index}.quick r]} result]} {
2308                ui_warn "Can't open quick index file for source: $source"
2309                continue
2310            } else {
2311                set quicklist [read $fd]
2312                close $fd
2313            }
2314        }
2315        foreach entry [split $quicklist "\n"] {
2316            set quick_index($sourceno,[lindex $entry 0]) [lindex $entry 1]
2317        }
2318        incr sourceno 1
2319    }
2320    if {!$sourceno} {
2321        ui_warn "No index(es) found! Have you synced your source indexes?"
2322    }
2323}
2324
2325proc mports_generate_quickindex {index} {
2326    if {[catch {set indexfd [open ${index} r]} result] || [catch {set quickfd [open ${index}.quick w]} result]} {
2327        ui_warn "Can't open index file: $index"
2328        return -code error
2329    } else {
2330        try {
2331            set offset [tell $indexfd]
2332            set quicklist ""
2333            while {[gets $indexfd line] >= 0} {
2334                if {[llength $line] != 2} {
2335                    continue
2336                }
2337                set name [lindex $line 0]
2338                append quicklist "[string tolower $name] ${offset}\n"
2339
2340                set len [lindex $line 1]
2341                read $indexfd $len
2342                set offset [tell $indexfd]
2343            }
2344            puts -nonewline $quickfd $quicklist
2345        } catch {*} {
2346            ui_warn "It looks like your PortIndex file $index may be corrupt."
2347            throw
2348        } finally {
2349            close $indexfd
2350            close $quickfd
2351        }
2352    }
2353    if {[info exists quicklist]} {
2354        return $quicklist
2355    } else {
2356        ui_warn "Failed to generate quick index for: $index"
2357        return -code error
2358    }
2359}
2360
2361proc mportinfo {mport} {
2362    set workername [ditem_key $mport workername]
2363    return [$workername eval array get ::PortInfo]
2364}
2365
2366proc mportclose {mport} {
2367    global macports::open_mports
2368    set refcnt [ditem_key $mport refcnt]
2369    incr refcnt -1
2370    ditem_key $mport refcnt $refcnt
2371    if {$refcnt == 0} {
2372        dlist_delete macports::open_mports $mport
2373        set workername [ditem_key $mport workername]
2374        # the hack in _mportexec might have already deleted the worker
2375        if {[interp exists $workername]} {
2376            interp delete $workername
2377        }
2378        ditem_delete $mport
2379    }
2380}
2381
2382##### Private Depspec API #####
2383# This API should be considered work in progress and subject to change without notice.
2384##### "
2385
2386# _mportkey
2387# - returns a variable from the port's interpreter
2388
2389proc _mportkey {mport key} {
2390    set workername [ditem_key $mport workername]
2391    return [$workername eval "return \$${key}"]
2392}
2393
2394# mportdepends builds the list of mports which the given port depends on.
2395# This list is added to $mport.
2396# This list actually depends on the target.
2397# This method can optionally recurse through the dependencies, looking for
2398#   dependencies of dependencies.
2399# This method can optionally cut the search when ports are already installed or
2400#   the dependencies are satisfied.
2401#
2402# mport -> mport item
2403# target -> target to consider the dependency for
2404# recurseDeps -> if the search should be recursive
2405# skipSatisfied -> cut the search tree when encountering installed/satisfied
2406#                  dependencies ports.
2407# accDeps -> accumulator for recursive calls
2408# return 0 if everything was ok, an non zero integer otherwise.
2409proc mportdepends {mport {target ""} {recurseDeps 1} {skipSatisfied 1}} {
2410
2411    array set portinfo [mportinfo $mport]
2412    set deptypes {}
2413
2414    # progress indicator
2415    if {![macports::ui_isset ports_debug]} {
2416        ui_info -nonewline "."
2417        flush stdout
2418    }
2419   
2420    if {[info exists portinfo(conflicts)] && ($target == "" || $target == "install")} {
2421        set conflictports [_mportconflictsinstalled $mport $portinfo(conflicts)]
2422        if {[llength ${conflictports}] != 0} {
2423            if {[macports::global_option_isset ports_force]} {
2424                ui_warn "Force option set; installing $portinfo(name) despite conflicts with: ${conflictports}"
2425            } else {
2426                return -code error "Can't install $portinfo(name) because conflicting ports are installed: ${conflictports}"
2427            }
2428        }
2429    }
2430
2431    set deptypes [macports::_deptypes_for_target $target]
2432
2433    set subPorts {}
2434    if {[llength $deptypes] > 0} {
2435        array set optionsarray [ditem_key $mport options]
2436        # avoid propagating requested flag from parent
2437        set optionsarray(ports_requested) 0
2438        set options [array get optionsarray]
2439        set variations [ditem_key $mport variations]
2440        set workername [ditem_key $mport workername]
2441        set required_archs [$workername eval get_canonical_archs]
2442        set depends_skip_archcheck [_mportkey $mport depends_skip_archcheck]
2443    }
2444
2445    # Process the dependencies for each of the deptypes
2446    foreach deptype $deptypes {
2447        if {![info exists portinfo($deptype)]} {
2448            continue
2449        }
2450        foreach depspec $portinfo($deptype) {
2451            # Is that dependency satisfied or this port installed?
2452            # If we don't skip or if it is not, add it to the list.
2453            set present [_mportispresent $mport $depspec]
2454
2455            # get the portname that satisfies the depspec
2456            set dep_portname [$workername eval _get_dep_port $depspec]
2457            if {!$skipSatisfied && $dep_portname == ""} {
2458                set dep_portname [lindex [split $depspec :] end]
2459            }
2460
2461            set check_archs 0
2462            if {$dep_portname != "" && $deptype != "depends_fetch" && $deptype != "depends_extract" && [lsearch -exact $depends_skip_archcheck $dep_portname] == -1} {
2463                set check_archs 1
2464            }
2465
2466            # need to open the portfile even if the dep is installed if it doesn't have the right archs
2467            set parse 0
2468            if {!$skipSatisfied || !$present || ($check_archs && ![macports::_active_supports_archs $dep_portname $required_archs])} {
2469                set parse 1
2470            }
2471            if {$parse} {
2472                # Find the porturl
2473                if {[catch {set res [mportlookup $dep_portname]} error]} {
2474                    global errorInfo
2475                    ui_debug "$errorInfo"
2476                    ui_error "Internal error: port lookup failed: $error"
2477                    return 1
2478                }
2479
2480                array unset dep_portinfo
2481                array set dep_portinfo [lindex $res 1]
2482                if {![info exists dep_portinfo(porturl)]} {
2483                    if {![macports::ui_isset ports_debug]} {
2484                        ui_msg ""
2485                    }
2486                    ui_error "Dependency '$dep_portname' not found."
2487                    return 1
2488                }
2489                # Figure out the subport. Check the open_mports list first, since
2490                # we potentially leak mport references if we mportopen each time,
2491                # because mportexec only closes each open mport once.
2492                set subport [dlist_search $macports::open_mports porturl $dep_portinfo(porturl)]
2493               
2494                if {$subport == {}} {
2495                    # We haven't opened this one yet.
2496                    set subport [mportopen $dep_portinfo(porturl) $options $variations]
2497                }
2498            }
2499
2500            # check archs
2501            if {$parse && $check_archs
2502                && ![macports::_mport_supports_archs $subport $required_archs]} {
2503
2504                set supported_archs [_mportkey $subport supported_archs]
2505                mportclose $subport
2506                set arch_mismatch 1
2507                set has_universal 0
2508                if {[info exists dep_portinfo(variants)] && [lsearch -exact $dep_portinfo(variants) universal] != -1} {
2509                    # a universal variant is offered
2510                    set has_universal 1
2511                    array unset variation_array
2512                    array set variation_array $variations
2513                    if {![info exists variation_array(universal)] || $variation_array(universal) != "+"} {
2514                        set variation_array(universal) +
2515                        # try again with +universal
2516                        set subport [mportopen $dep_portinfo(porturl) $options [array get variation_array]]
2517                        if {[macports::_mport_supports_archs $subport $required_archs]} {
2518                            set arch_mismatch 0
2519                        }
2520                    }
2521                }
2522                if {$arch_mismatch} {
2523                    macports::_explain_arch_mismatch [_mportkey $mport name] $dep_portname $required_archs $supported_archs $has_universal
2524                    return -code error "architecture mismatch"
2525                }
2526            }
2527
2528            if {$parse} {
2529                if {$recurseDeps} {
2530                    # Add to the list we need to recurse on.
2531                    lappend subPorts $subport
2532                }
2533   
2534                # Append the sub-port's provides to the port's requirements list.
2535                ditem_append_unique $mport requires "[ditem_key $subport provides]"
2536            }
2537        }
2538    }
2539
2540    # Loop on the subports.
2541    if {$recurseDeps} {
2542        foreach subport $subPorts {
2543            # Sub ports should be installed (all dependencies must be satisfied).
2544            set res [mportdepends $subport "" $recurseDeps $skipSatisfied]
2545            if {$res != 0} {
2546                return $res
2547            }
2548        }
2549    }
2550
2551    return 0
2552}
2553
2554# check if the given mport can support dependents with the given archs
2555proc macports::_mport_supports_archs {mport required_archs} {
2556    if {$required_archs == "noarch"} {
2557        return 1
2558    }
2559    set workername [ditem_key $mport workername]
2560    set provided_archs [$workername eval get_canonical_archs]
2561    if {$provided_archs == "noarch"} {
2562        return 1
2563    }
2564    foreach arch $required_archs {
2565        if {[lsearch -exact $provided_archs $arch] == -1} {
2566            return 0
2567        }
2568    }
2569    return 1
2570}
2571
2572# check if the active version of a port supports the given archs
2573proc macports::_active_supports_archs {portname required_archs} {
2574    if {$required_archs == "noarch"} {
2575        return 1
2576    }
2577    if {[catch {set ilist [registry::active $portname]}]} {
2578        return 0
2579    }
2580    set i [lindex $ilist 0]
2581    set regref [registry::open_entry $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
2582    set provided_archs [registry::property_retrieve $regref archs]
2583    if {$provided_archs == "noarch" || $provided_archs == "" || $provided_archs == 0} {
2584        return 1
2585    }
2586    foreach arch $required_archs {
2587        if {[lsearch -exact $provided_archs $arch] == -1} {
2588            return 0
2589        }
2590    }
2591    return 1
2592}
2593
2594# print an error message explaining why a port's archs are not provided by a dependency
2595proc macports::_explain_arch_mismatch {port dep required_archs supported_archs has_universal} {
2596    global macports::universal_archs
2597    if {![macports::ui_isset ports_debug]} {
2598        ui_msg ""
2599    }
2600    ui_error "Cannot install $port for the arch(s) '$required_archs' because"
2601    if {$supported_archs != ""} {
2602        foreach arch $required_archs {
2603            if {[lsearch -exact $supported_archs $arch] == -1} {
2604                ui_error "its dependency $dep only supports the arch(s) '$supported_archs'."
2605                return
2606            }
2607        }
2608    }
2609    if {$has_universal} {
2610        foreach arch $required_archs {
2611            if {[lsearch -exact $universal_archs $arch] == -1} {
2612                ui_error "its dependency $dep does not build for the required arch(s) by default"
2613                ui_error "and the configured universal_archs '$universal_archs' are not sufficient."
2614                return
2615            }
2616        }
2617        ui_error "its dependency $dep cannot build for the required arch(s)."
2618        return
2619    }
2620    ui_error "its dependency $dep does not build for the required arch(s) by default"
2621    ui_error "and does not have a universal variant."
2622}
2623
2624# check if the given target needs dependencies installed first
2625proc macports::_target_needs_deps {target} {
2626    # XXX: need a better way than checking this hardcoded list
2627    switch -- $target {
2628        fetch -
2629        checksum -
2630        extract -
2631        patch -
2632        configure -
2633        build -
2634        test -
2635        destroot -
2636        install -
2637        archive -
2638        activate -
2639        dmg -
2640        mdmg -
2641        pkg -
2642        mpkg -
2643        rpm -
2644        dpkg -
2645        srpm -
2646        portpkg { return 1 }
2647        default { return 0 }
2648    }
2649}
2650
2651# Determine dependency types required for target
2652proc macports::_deptypes_for_target {target} {
2653    switch $target {
2654        fetch       -
2655        checksum    { set deptypes "depends_fetch" }
2656        extract     -
2657        patch       { set deptypes "depends_fetch depends_extract" }
2658        configure   -
2659        build       { set deptypes "depends_fetch depends_extract depends_build depends_lib" }
2660
2661        test        -
2662        destroot    -
2663        install     -
2664        activate    -
2665        archive     -
2666        dmg         -
2667        pkg         -
2668        portpkg     -
2669        mdmg        -
2670        mpkg        -
2671        rpm         -
2672        srpm        -
2673        dpkg        -
2674        ""          { set deptypes "depends_fetch depends_extract depends_build depends_lib depends_run" }
2675    }
2676    return $deptypes
2677}
2678
2679# selfupdate procedure
2680proc macports::selfupdate {{optionslist {}} {updatestatusvar ""}} {
2681    global macports::prefix macports::portdbpath macports::libpath macports::rsync_server macports::rsync_dir macports::rsync_options
2682    global macports::autoconf::macports_version macports::autoconf::rsync_path tcl_platform
2683    array set options $optionslist
2684   
2685    # variable that indicates whether we actually updated base
2686    if {$updatestatusvar != ""} {
2687        upvar $updatestatusvar updatestatus
2688        set updatestatus no
2689    }
2690
2691    # syncing ports tree.
2692    if {![info exists options(ports_selfupdate_nosync)] || $options(ports_selfupdate_nosync) != "yes"} {
2693        ui_msg "--->  Updating the ports tree"
2694        if {[catch {mportsync $optionslist} result]} {
2695            return -code error "Couldn't sync the ports tree: $result"
2696        }
2697    }
2698
2699    # create the path to the to be downloaded sources if it doesn't exist
2700    set mp_source_path [file join $portdbpath sources ${rsync_server} ${rsync_dir}/]
2701    if {![file exists $mp_source_path]} {
2702        file mkdir $mp_source_path
2703    }
2704    ui_debug "MacPorts sources location: $mp_source_path"
2705
2706    # sync the MacPorts sources
2707    ui_msg "--->  Updating MacPorts base sources using rsync"
2708    if { [catch { system "$rsync_path $rsync_options rsync://${rsync_server}/${rsync_dir} $mp_source_path" } result ] } {
2709       return -code error "Error synchronizing MacPorts sources: $result"
2710    }
2711
2712    # echo current MacPorts version
2713    ui_msg "MacPorts base version $macports::autoconf::macports_version installed,"
2714
2715    if { [info exists options(ports_force)] && $options(ports_force) == "yes" } {
2716        set use_the_force_luke yes
2717        ui_debug "Forcing a rebuild and reinstallation of MacPorts"
2718    } else {
2719        set use_the_force_luke no
2720        ui_debug "Rebuilding and reinstalling MacPorts if needed"
2721    }
2722
2723    # Choose what version file to use: old, floating point format or new, real version number format
2724    set version_file [file join $mp_source_path config macports_version]
2725    if {[file exists $version_file]} {
2726        set fd [open $version_file r]
2727        gets $fd macports_version_new
2728        close $fd
2729        # echo downloaded MacPorts version
2730        ui_msg "MacPorts base version $macports_version_new downloaded."
2731    } else {
2732        ui_warn "No version file found, please rerun selfupdate."
2733        set macports_version_new 0
2734    }
2735
2736    # check if we we need to rebuild base
2737    set comp [rpm-vercomp $macports_version_new $macports::autoconf::macports_version]
2738    if {$use_the_force_luke == "yes" || $comp > 0} {
2739        if {[info exists options(ports_dryrun)] && $options(ports_dryrun) == "yes"} {
2740            ui_msg "--->  MacPorts base is outdated, selfupdate would install $macports_version_new (dry run)"
2741        } else {
2742            ui_msg "--->  MacPorts base is outdated, installing new version $macports_version_new"
2743
2744            # get installation user/group and permissions
2745            set owner [file attributes ${prefix} -owner]
2746            set group [file attributes ${prefix} -group]
2747            set perms [string range [file attributes ${prefix} -permissions] end-3 end]
2748            if {$tcl_platform(user) != "root" && ![string equal $tcl_platform(user) $owner]} {
2749                return -code error "User $tcl_platform(user) does not own ${prefix} - try using sudo"
2750            }
2751            ui_debug "Permissions OK"
2752
2753            # where to install a link to our macports1.0 tcl package
2754            set mp_tclpackage_path [file join $portdbpath .tclpackage]
2755            if { [file exists $mp_tclpackage_path]} {
2756                set fd [open $mp_tclpackage_path r]
2757                gets $fd tclpackage
2758                close $fd
2759            } else {
2760                set tclpackage $libpath
2761            }
2762
2763            set configure_args "--prefix=$prefix --with-tclpackage=$tclpackage --with-install-user=$owner --with-install-group=$group --with-directory-mode=$perms"
2764            # too many users have an incompatible readline in /usr/local, see ticket #10651
2765            if {$tcl_platform(os) != "Darwin" || $prefix == "/usr/local"
2766                || ([glob -nocomplain "/usr/local/lib/lib{readline,history}*"] == "" && [glob -nocomplain "/usr/local/include/readline/*.h"] == "")} {
2767                append configure_args " --enable-readline"
2768            } else {
2769                ui_warn "Disabling readline support due to readline in /usr/local"
2770            }
2771
2772            set cc_arg ""
2773            switch -glob -- $::macports::macosx_version {
2774                10.{4,5} { set cc_arg "CC=/usr/bin/gcc-4.0 " }
2775                10.6     { set cc_arg "CC=/usr/bin/gcc-4.2 " }
2776                10.*     { set cc_arg "CC=/usr/bin/llvm-gcc-4.2 " }
2777            }
2778
2779            # do the actual configure, build and installation of new base
2780            ui_msg "Installing new MacPorts release in $prefix as $owner:$group; permissions $perms; Tcl-Package in $tclpackage\n"
2781            if { [catch { system "cd $mp_source_path && ${cc_arg}./configure $configure_args && make && make install" } result] } {
2782                return -code error "Error installing new MacPorts base: $result"
2783            }
2784            if {[info exists updatestatus]} {
2785                set updatestatus yes
2786            }
2787        }
2788    } elseif {$comp < 0} {
2789        ui_msg "--->  MacPorts base is probably trunk or a release candidate"
2790    } else {
2791        ui_msg "--->  MacPorts base is already the latest version"
2792    }
2793
2794    # set the MacPorts sources to the right owner
2795    set sources_owner [file attributes [file join $portdbpath sources/] -owner]
2796    ui_debug "Setting MacPorts sources ownership to $sources_owner"
2797    if { [catch { exec [findBinary chown $macports::autoconf::chown_path] -R $sources_owner [file join $portdbpath sources/] } result] } {
2798        return -code error "Couldn't change permissions of the MacPorts sources at $mp_source_path to $sources_owner: $result"
2799    }
2800
2801    if {![info exists options(ports_selfupdate_nosync)] || $options(ports_selfupdate_nosync) != "yes"} {
2802        ui_msg "\nThe ports tree has been updated. To upgrade your installed ports, you should run"
2803        ui_msg "  port upgrade outdated"
2804    }
2805
2806    return 0
2807}
2808
2809# upgrade API wrapper procedure
2810# return codes: 0 = success, 1 = general failure, 2 = port name not found in index
2811proc macports::upgrade {portname dspec variationslist optionslist {depscachename ""}} {
2812    # only installed ports can be upgraded
2813    if {![registry::entry_exists_for_name $portname]} {
2814        ui_error "$portname is not installed"
2815        return 1
2816    }
2817    if {![string match "" $depscachename]} {
2818        upvar $depscachename depscache
2819    } else {
2820        array set depscache {}
2821    }
2822    # stop upgrade from being called via mportexec as well
2823    set orig_nodeps yes
2824    if {![info exists macports::global_options(ports_nodeps)]} {
2825        set macports::global_options(ports_nodeps) yes
2826        set orig_nodeps no
2827    }
2828   
2829    # run the actual upgrade
2830    set status [macports::_upgrade $portname $dspec $variationslist $optionslist depscache]
2831   
2832    if {!$orig_nodeps} {
2833        unset -nocomplain macports::global_options(ports_nodeps)
2834    }
2835    return $status
2836}
2837
2838# main internal upgrade procedure
2839proc macports::_upgrade {portname dspec variationslist optionslist {depscachename ""}} {
2840    global macports::registry.installtype
2841    global macports::portarchivemode
2842    global macports::global_variations
2843    array set options $optionslist
2844
2845    if {![string match "" $depscachename]} {
2846        upvar $depscachename depscache
2847    }
2848
2849    # Is this a dry run?
2850    set is_dryrun no
2851    if {[info exists options(ports_dryrun)] && $options(ports_dryrun) eq "yes"} {
2852        set is_dryrun yes
2853    }
2854
2855    # check if the port is in tree
2856    if {[catch {mportlookup $portname} result]} {
2857        global errorInfo
2858        ui_debug "$errorInfo"
2859        ui_error "port lookup failed: $result"
2860        return 1
2861    }
2862    # argh! port doesnt exist!
2863    if {$result == ""} {
2864        ui_warn "No port $portname found in the index."
2865        return 2
2866    }
2867    # fill array with information
2868    array set portinfo [lindex $result 1]
2869    # set portname again since the one we were passed may not have had the correct case
2870    set portname $portinfo(name)
2871
2872    set ilist {}
2873    if { [catch {set ilist [registry::installed $portname ""]} result] } {
2874        if {$result == "Registry error: $portname not registered as installed." } {
2875            ui_debug "$portname is *not* installed by MacPorts"
2876
2877            # We need to pass _mportispresent a reference to the mport that is
2878            # actually declaring the dependency on the one we're checking for.
2879            # We got here via _upgrade_dependencies, so we grab it from 2 levels up.
2880            upvar 2 workername parentworker
2881            if {![_mportispresent $parentworker $dspec ] } {
2882                # open porthandle
2883                set porturl $portinfo(porturl)
2884                if {![info exists porturl]} {
2885                    set porturl file://./
2886                }
2887                # Grab the variations from the parent
2888                upvar 2 variations variations
2889
2890                if {[catch {set workername [mportopen $porturl [array get options] [array get variations]]} result]} {
2891                    global errorInfo
2892                    ui_debug "$errorInfo"
2893                    ui_error "Unable to open port: $result"
2894                    return 1
2895                }
2896                # While we're at it, update the portinfo
2897                array unset portinfo
2898                array set portinfo [mportinfo $workername]
2899               
2900                # upgrade its dependencies first
2901                set status [_upgrade_dependencies portinfo depscache variationslist options yes]
2902                if {$status != 0 && $status != 2 && ![ui_isset ports_processall]} {
2903                    catch {mportclose $workername}
2904                    return $status
2905                }
2906                # now install it
2907                if {[catch {set result [mportexec $workername activate]} result]} {
2908                    global errorInfo
2909                    ui_debug "$errorInfo"
2910                    ui_error "Unable to exec port: $result"
2911                    catch {mportclose $workername}
2912                    return 1
2913                }
2914                if {$result > 0} {
2915                    ui_error "Problem while installing $portname"
2916                    catch {mportclose $workername}
2917                    return $result
2918                }
2919                # we just installed it, so mark it done in the cache
2920                set depscache(port:${portname}) 1
2921                mportclose $workername
2922            } else {
2923                # dependency is satisfied by something other than the named port
2924                ui_debug "$portname not installed, soft dependency satisfied"
2925                # mark this depspec as satisfied in the cache
2926                set depscache($dspec) 1
2927            }
2928            # the rest of the proc doesn't matter for a port that is freshly
2929            # installed or not installed
2930            return 0
2931        } else {
2932            ui_error "Checking installed version failed: $result"
2933            return 1
2934        }
2935    } else {
2936        # we'll now take care of upgrading it, so we can add it to the cache
2937        set depscache(port:${portname}) 1
2938    }
2939   
2940    # set version_in_tree and revision_in_tree
2941    if {![info exists portinfo(version)]} {
2942        ui_error "Invalid port entry for $portname, missing version"
2943        return 1
2944    }
2945    set version_in_tree "$portinfo(version)"
2946    set revision_in_tree "$portinfo(revision)"
2947    set epoch_in_tree "$portinfo(epoch)"
2948
2949    # find latest version installed and active version (if any)
2950    set anyactive no
2951    set version_installed {}
2952    foreach i $ilist {
2953        set variant [lindex $i 3]
2954        set version [lindex $i 1]
2955        set revision [lindex $i 2]
2956        set epoch [lindex $i 5]
2957        if { $version_installed == {} || $epoch > $epoch_installed ||
2958                ($epoch == $epoch_installed && [rpm-vercomp $version $version_installed] > 0)
2959                || ($epoch == $epoch_installed
2960                    && [rpm-vercomp $version $version_installed] == 0
2961                    && $revision > $revision_installed)} {
2962            set version_installed $version
2963            set revision_installed $revision
2964            set variant_installed $variant
2965            set epoch_installed $epoch
2966        }
2967
2968        set isactive [lindex $i 4]
2969        if {$isactive == 1} {
2970            set anyactive yes
2971            set version_active $version
2972            set revision_active $revision
2973            set variant_active $variant
2974            set epoch_active $epoch
2975        }
2976    }
2977
2978    # output version numbers
2979    ui_debug "epoch: in tree: $epoch_in_tree installed: $epoch_installed"
2980    ui_debug "$portname ${version_in_tree}_${revision_in_tree} exists in the ports tree"
2981    ui_debug "$portname ${version_installed}_${revision_installed} $variant_installed is the latest installed"
2982    if {$anyactive} {
2983        ui_debug "$portname ${version_active}_${revision_active} $variant_active is active"
2984        # save existing variant for later use
2985        set oldvariant $variant_active
2986        set regref [registry::open_entry $portname $version_active $revision_active $variant_active $epoch_active]
2987    } else {
2988        ui_debug "no version of $portname is active"
2989        set oldvariant $variant_installed
2990        set regref [registry::open_entry $portname $version_installed $revision_installed $variant_installed $epoch_installed]
2991    }
2992    set oldnegatedvariant [registry::property_retrieve $regref negated_variants]
2993    if {$oldnegatedvariant == 0} {
2994        set oldnegatedvariant {}
2995    }
2996    set requestedflag [registry::property_retrieve $regref requested]
2997    set os_platform_installed [registry::property_retrieve $regref os_platform]
2998    set os_major_installed [registry::property_retrieve $regref os_major]
2999
3000    # Before we do
3001    # dependencies, we need to figure out the final variants,
3002    # open the port, and update the portinfo.
3003    set porturl $portinfo(porturl)
3004    if {![info exists porturl]} {
3005        set porturl file://./
3006    }
3007
3008    # Note $variationslist is left alone and so retains the original
3009    # requested variations, which should be passed to recursive calls to
3010    # upgrade; while variations gets existing variants and global variations
3011    # merged in later on, so it applies only to this port's upgrade
3012    array set variations $variationslist
3013   
3014    set globalvarlist [array get macports::global_variations]
3015
3016    set minusvariant [lrange [split $oldnegatedvariant -] 1 end]
3017    set plusvariant [lrange [split $oldvariant +] 1 end]
3018    ui_debug "Merging existing variants '${oldvariant}${oldnegatedvariant}' into variants"
3019    set oldvariantlist [list]
3020    foreach v $plusvariant {
3021        lappend oldvariantlist $v "+"
3022    }
3023    foreach v $minusvariant {
3024        lappend oldvariantlist $v "-"
3025    }
3026
3027    # merge in the old variants
3028    foreach {variation value} $oldvariantlist {
3029        if { ![info exists variations($variation)]} {
3030            set variations($variation) $value
3031        }
3032    }
3033
3034    # Now merge in the global (i.e. variants.conf) variations.
3035    # We wait until now so that existing variants for this port
3036    # override global variations
3037    foreach { variation value } $globalvarlist {
3038        if { ![info exists variations($variation)] } {
3039            set variations($variation) $value
3040        }
3041    }
3042
3043    ui_debug "new fully merged portvariants: [array get variations]"
3044   
3045    # at this point we need to check if a different port will be replacing this one
3046    if {[info exists portinfo(replaced_by)] && ![info exists options(ports_upgrade_no-replace)]} {
3047        ui_msg "--->  $portname is replaced by $portinfo(replaced_by)"
3048        if {[catch {mportlookup $portinfo(replaced_by)} result]} {
3049            global errorInfo
3050            ui_debug "$errorInfo"
3051            ui_error "port lookup failed: $result"
3052            return 1
3053        }
3054        if {$result == ""} {
3055            ui_error "No port $portinfo(replaced_by) found."
3056            return 1
3057        }
3058        array unset portinfo
3059        array set portinfo [lindex $result 1]
3060        set newname $portinfo(name)
3061
3062        set porturl $portinfo(porturl)
3063        if {![info exists porturl]} {
3064            set porturl file://./
3065        }
3066        set depscache(port:${newname}) 1
3067    } else {
3068        set newname $portname
3069    }
3070
3071    array set interp_options [array get options]
3072    set interp_options(ports_requested) $requestedflag
3073
3074    if {[catch {set workername [mportopen $porturl [array get interp_options] [array get variations]]} result]} {
3075        global errorInfo
3076        ui_debug "$errorInfo"
3077        ui_error "Unable to open port: $result"
3078        return 1
3079    }
3080    array unset interp_options
3081
3082    array unset portinfo
3083    array set portinfo [mportinfo $workername]
3084    set version_in_tree "$portinfo(version)"
3085    set revision_in_tree "$portinfo(revision)"
3086    set epoch_in_tree "$portinfo(epoch)"
3087
3088    set build_override 0
3089    set will_install yes
3090    # check installed version against version in ports
3091    if { ( [rpm-vercomp $version_installed $version_in_tree] > 0
3092            || ([rpm-vercomp $version_installed $version_in_tree] == 0
3093                && [rpm-vercomp $revision_installed $revision_in_tree] >= 0 ))
3094        && ![info exists options(ports_upgrade_force)] } {
3095        if {$portname != $newname} { 
3096            ui_debug "ignoring versions, installing replacement port"
3097        } elseif { $epoch_installed < $epoch_in_tree } {
3098            set build_override 1
3099            ui_debug "epoch override ... upgrading!"
3100        } elseif {[info exists options(ports_upgrade_enforce-variants)] && $options(ports_upgrade_enforce-variants) eq "yes"
3101                  && [info exists portinfo(canonical_active_variants)] && $portinfo(canonical_active_variants) != $oldvariant} {
3102            ui_debug "variant override ... upgrading!"
3103        } elseif {$os_platform_installed != "" && $os_major_installed != "" && $os_platform_installed != 0
3104                  && ([_mportkey $workername "{os.platform}"] != $os_platform_installed
3105                  || [_mportkey $workername "{os.major}"] != $os_major_installed)} {
3106            ui_debug "platform mismatch ... upgrading!"
3107            set build_override 1
3108        } else {
3109            if {[info exists portinfo(canonical_active_variants)] && $portinfo(canonical_active_variants) != $oldvariant} {
3110                if {[llength $variationslist] > 0} {
3111                    ui_warn "Skipping upgrade since $portname ${version_installed}_${revision_installed} >= $portname ${version_in_tree}_${revision_in_tree}, even though installed variants \"$oldvariant\" do not match \"$portinfo(canonical_active_variants)\". Use 'upgrade --enforce-variants' to switch to the requested variants."
3112                } else {
3113                    ui_debug "Skipping upgrade since $portname ${version_installed}_${revision_installed} >= $portname ${version_in_tree}_${revision_in_tree}, even though installed variants \"$oldvariant\" do not match \"$portinfo(canonical_active_variants)\"."
3114                }
3115            } else {
3116                ui_debug "No need to upgrade! $portname ${version_installed}_${revision_installed} >= $portname ${version_in_tree}_${revision_in_tree}"
3117            }
3118            set will_install no
3119        }
3120    }
3121
3122    set will_build no
3123    # avoid building again unnecessarily
3124    if {$will_install && ([info exists options(ports_upgrade_force)] || $build_override == 1
3125        || ![registry::entry_exists $newname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)])} {
3126        set will_build yes
3127    }
3128
3129    # first upgrade dependencies
3130    if {![info exists options(ports_nodeps)]} {
3131        set status [_upgrade_dependencies portinfo depscache variationslist options $will_build]
3132        if {$status != 0 && $status != 2 && ![ui_isset ports_processall]} {
3133            catch {mportclose $workername}
3134            return $status
3135        }
3136    } else {
3137        ui_debug "Not following dependencies"
3138    }
3139
3140    if {!$will_install} {
3141        # nothing to do for this port, so just check if we have to do dependents
3142        if {[info exists options(ports_do_dependents)]} {
3143            # We do dependents ..
3144            set options(ports_nodeps) 1
3145
3146            registry::open_dep_map
3147            if {$anyactive} {
3148                set deplist [registry::list_dependents $portname $version_active $revision_active $variant_active]
3149            } else {
3150                set deplist [registry::list_dependents $portname $version_installed $revision_installed $variant_installed]
3151            }
3152
3153            if { [llength deplist] > 0 } {
3154                foreach dep $deplist {
3155                    set mpname [lindex $dep 2]
3156                    if {![llength [array get depscache port:${mpname}]]} {
3157                        set status [macports::_upgrade $mpname port:${mpname} $variationslist [array get options] depscache]
3158                        if {$status != 0 && $status != 2 && ![ui_isset ports_processall]} {
3159                            catch {mportclose $workername}
3160                            return $status
3161                        }
3162                    }
3163                }
3164            }
3165        }
3166        mportclose $workername
3167        return 0
3168    }
3169
3170    if {$will_build} {
3171        # build or unarchive version_in_tree
3172        if {0 == [string compare "yes" ${macports::portarchivemode}]} {
3173            set upgrade_action "archive"
3174        } else {
3175            set upgrade_action "destroot"
3176        }
3177        if {[catch {set result [mportexec $workername $upgrade_action]} result] || $result != 0} {
3178            if {[info exists ::errorInfo]} {
3179                ui_debug "$::errorInfo"
3180            }
3181            ui_error "Unable to upgrade port: $result"
3182            catch {mportclose $workername}
3183            return 1
3184        }
3185    }
3186
3187    # always uninstall old port in direct mode
3188    global macports::registry.format
3189    if { 0 != [string compare "image" ${macports::registry.installtype}] } {
3190        # uninstall old
3191        ui_debug "Uninstalling $portname ${version_installed}_${revision_installed}${variant_installed}"
3192        # we have to force the uninstall in case of dependents
3193        set force_cur [info exists options(ports_force)]
3194        set options(ports_force) yes
3195        if {$is_dryrun eq "yes"} {
3196            ui_msg "Skipping uninstall $portname @${version_installed}_${revision_installed}${variant_installed} (dry run)"
3197        } elseif {(${registry.format} != "receipt_sqlite" || ![registry::run_target $regref uninstall [array get options]])
3198                  && [catch {registry_uninstall::uninstall $portname ${version_installed}_${revision_installed}${variant_installed} [array get options]} result]} {
3199            global errorInfo
3200            ui_debug "$errorInfo"
3201            ui_error "Uninstall $portname ${version_installed}_${revision_installed}${variant_installed} failed: $result"
3202            catch {mportclose $workername}
3203            return 1
3204        }
3205        if {!$force_cur} {
3206            unset options(ports_force)
3207        }
3208    } else {
3209        # are we installing an existing version due to force or epoch override?
3210        if {[registry::entry_exists $newname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)]
3211            && ([info exists options(ports_upgrade_force)] || $build_override == 1)} {
3212             ui_debug "Uninstalling $newname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants)"
3213            # we have to force the uninstall in case of dependents
3214            set force_cur [info exists options(ports_force)]
3215            set options(ports_force) yes
3216            set newregref [registry::open_entry $newname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants) $epoch_in_tree]
3217            if {$is_dryrun eq "yes"} {
3218                ui_msg "Skipping uninstall $newname @${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants) (dry run)"
3219            } elseif {!(${registry.format} == "receipt_sqlite" && [registry::run_target $newregref uninstall [array get options]])
3220                      && [catch {registry_uninstall::uninstall $newname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants) [array get options]} result]} {
3221                global errorInfo
3222                ui_debug "$errorInfo"
3223                ui_error "Uninstall $newname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants) failed: $result"
3224                catch {mportclose $workername}
3225                return 1
3226            }
3227            if {!$force_cur} {
3228                unset options(ports_force)
3229            }
3230            if {$anyactive && $version_in_tree == $version_active && $revision_in_tree == $revision_active
3231                && $portinfo(canonical_active_variants) == $variant_active && $portname == $newname} {
3232                set anyactive no
3233            }
3234        }
3235        if {$anyactive && $portname != $newname} {
3236            # replaced_by in effect, deactivate the old port
3237            # we have to force the deactivate in case of dependents
3238            set force_cur [info exists options(ports_force)]
3239            set options(ports_force) yes
3240            if {$is_dryrun eq "yes"} {
3241                ui_msg "Skipping deactivate $portname @${version_active}_${revision_active}${variant_active} (dry run)"
3242            } elseif {![catch {registry::active $portname}] &&
3243                      !(${registry.format} == "receipt_sqlite" && [registry::run_target $regref deactivate [array get options]])
3244                      && [catch {portimage::deactivate $portname ${version_active}_${revision_active}${variant_active} [array get options]} result]} {
3245                global errorInfo
3246                ui_debug "$errorInfo"
3247                ui_error "Deactivating $portname @${version_active}_${revision_active}${variant_active} failed: $result"
3248                catch {mportclose $workername}
3249                return 1
3250            }
3251            if {!$force_cur} {
3252                unset options(ports_force)
3253            }
3254            set anyactive no
3255        }
3256        if {[info exists options(port_uninstall_old)]} {
3257            # uninstalling now could fail due to dependents when not forced,
3258            # because the new version is not installed
3259            set uninstall_later yes
3260        }
3261    }
3262
3263    if {$is_dryrun eq "yes"} {
3264        if {$anyactive} {
3265            ui_msg "Skipping deactivate $portname @${version_active}_${revision_active}${variant_active} (dry run)"
3266        }
3267        ui_msg "Skipping activate $newname @${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants) (dry run)"
3268    } elseif {[catch {set result [mportexec $workername activate]} result]} {
3269        global errorInfo
3270        ui_debug "$errorInfo"
3271        ui_error "Couldn't activate $newname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants): $result"
3272        catch {mportclose $workername}
3273        return 1
3274    }
3275
3276    # Check if we have to do dependents
3277    if {[info exists options(ports_do_dependents)]} {
3278        # We do dependents ..
3279        set options(ports_nodeps) 1
3280
3281        registry::open_dep_map
3282        if {$portname != $newname} {
3283            set deplist [registry::list_dependents $newname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)]
3284        } else {
3285            set deplist [list]
3286        }
3287        if {$anyactive} {
3288            set deplist [concat $deplist [registry::list_dependents $portname $version_active $revision_active $variant_active]]
3289        } else {
3290            set deplist [concat $deplist [registry::list_dependents $portname $version_installed $revision_installed $variant_installed]]
3291        }
3292
3293        if { [llength deplist] > 0 } {
3294            foreach dep $deplist {
3295                set mpname [lindex $dep 2]
3296                if {![llength [array get depscache port:${mpname}]]} {
3297                    set status [macports::_upgrade $mpname port:${mpname} $variationslist [array get options] depscache]
3298                    if {$status != 0 && $status != 2 && ![ui_isset ports_processall]} {
3299                        catch {mportclose $workername}
3300                        return $status
3301                    }
3302                }
3303            }
3304        }
3305    }
3306
3307    if {[info exists uninstall_later] && $uninstall_later == yes} {
3308        foreach i $ilist {
3309            set version [lindex $i 1]
3310            set revision [lindex $i 2]
3311            set variant [lindex $i 3]
3312            if {$version == $version_in_tree && $revision == $revision_in_tree && $variant == $portinfo(canonical_active_variants) && $portname == $newname} {
3313                continue
3314            }
3315            set epoch [lindex $i 5]
3316            ui_debug "Uninstalling $portname ${version}_${revision}${variant}"
3317            set regref [registry::open_entry $portname $version $revision $variant $epoch]
3318            if {$is_dryrun eq "yes"} {
3319                ui_msg "Skipping uninstall $portname @${version}_${revision}${variant} (dry run)"
3320            } elseif {!(${registry.format} == "receipt_sqlite" && [registry::run_target $regref uninstall $optionslist])
3321                      && [catch {registry_uninstall::uninstall $portname ${version}_${revision}${variant} $optionslist} result]} {
3322                global errorInfo
3323                ui_debug "$errorInfo"
3324                # replaced_by can mean that we try to uninstall all versions of the old port, so handle errors due to dependents
3325                if {$result != "Please uninstall the ports that depend on $portname first." && ![ui_isset ports_processall]} {
3326                    ui_error "Uninstall $portname @${version}_${revision}${variant} failed: $result"
3327                    catch {mportclose $workername}
3328                    return 1
3329                }
3330            }
3331        }
3332    }
3333
3334    # close the port handle
3335    mportclose $workername
3336    return 0
3337}
3338
3339# upgrade_dependencies: helper proc for upgrade
3340# Calls upgrade on each dependency listed in the PortInfo.
3341# Uses upvar to access the variables.
3342proc macports::_upgrade_dependencies {portinfoname depscachename variationslistname optionsname {build_needed yes}} {
3343    upvar $portinfoname portinfo $depscachename depscache \
3344          $variationslistname variationslist \
3345          $optionsname options
3346    upvar workername parentworker
3347
3348    # If we're following dependents, we only want to follow this port's
3349    # dependents, not those of all its dependencies. Otherwise, we would
3350    # end up processing this port's dependents n+1 times (recursively!),
3351    # where n is the number of dependencies this port has, since this port
3352    # is of course a dependent of each of its dependencies. Plus the
3353    # dependencies could have any number of unrelated dependents.
3354
3355    # So we save whether we're following dependents, unset the option
3356    # while doing the dependencies, and restore it afterwards.
3357    set saved_do_dependents [info exists options(ports_do_dependents)]
3358    unset -nocomplain options(ports_do_dependents)
3359
3360    set status 0
3361    # each required dep type is upgraded
3362    if {$build_needed} {
3363        set dtypes {depends_fetch depends_extract depends_build depends_lib depends_run}
3364    } else {
3365        set dtypes {depends_lib depends_run}
3366    }
3367    foreach dtype $dtypes {
3368        if {[info exists portinfo($dtype)]} {
3369            foreach i $portinfo($dtype) {
3370                set parent_interp [ditem_key $parentworker workername]
3371                set d [$parent_interp eval _get_dep_port $i]
3372                if {![llength [array get depscache port:${d}]] && ![llength [array get depscache $i]]} {
3373                    if {$d != ""} {
3374                        set dspec port:$d
3375                    } else {
3376                        set dspec $i
3377                        set d [lindex [split $i :] end]
3378                    }
3379                    set status [macports::_upgrade $d $dspec $variationslist [array get options] depscache]
3380                    if {$status != 0 && $status != 2 && ![ui_isset ports_processall]} break
3381                }
3382            }
3383        }
3384        if {$status != 0 && $status != 2 && ![ui_isset ports_processall]} break
3385    }
3386    # restore dependent-following to its former value
3387    if {$saved_do_dependents} {
3388        set options(ports_do_dependents) yes
3389    }
3390    return $status
3391}
3392
3393# mportselect
3394#   * command: The only valid commands are list, set and show
3395#   * group: This argument should correspond to a directory under
3396#            $macports::prefix/etc/select.
3397#   * version: This argument is only used by the 'set' command.
3398# On error mportselect returns with the code 'error'.
3399proc mportselect {command group {version ""}} {
3400    ui_debug "mportselect \[$command] \[$group] \[$version]"
3401
3402    set conf_path "$macports::prefix/etc/select/$group"
3403    if {![file isdirectory $conf_path]} {
3404        return -code error "The specified group '$group' does not exist."
3405    }
3406
3407    switch -- $command {
3408        list {
3409            if {[catch {set versions [glob -directory $conf_path *]} result]} {
3410                global errorInfo
3411                ui_debug "$result: $errorInfo"
3412                return -code error [concat "No configurations associated " \
3413                                           "with '$group' were found."]
3414            }
3415
3416            # Return the sorted list of versions (excluding base and current).
3417            set lversions {}
3418            foreach v $versions {
3419                # Only the file name corresponds to the version name.
3420                set v [file tail $v]
3421                if {$v eq "base" || $v eq "current"} {
3422                    continue
3423                }
3424                lappend lversions [file tail $v]
3425            }
3426            return [lsort $lversions]
3427        }
3428        set {
3429            # Use $conf_path/$version to read in sources.
3430            if {$version == "base" || $version == "current"
3431                    || [catch {set src_file [open "$conf_path/$version"]} result]} {
3432                global errorInfo
3433                ui_debug "$result: $errorInfo"
3434                return -code error "The specified version '$version' is not valid."
3435            }
3436            set srcs [split [read -nonewline $src_file] "\n"]
3437            close $src_file
3438
3439            # Use $conf_path/base to read in targets.
3440            if {[catch {set tgt_file [open "$conf_path/base"]} result]} {
3441                global errorInfo
3442                ui_debug "$result: $errorInfo"
3443                return -code error [concat "The configuration file " \
3444                                           "'$conf_path/base' could not be " \
3445                                           "opened."]
3446            }
3447            set tgts [split [read -nonewline $tgt_file] "\n"]
3448            close $tgt_file
3449
3450            # Iterate through the configuration files executing the specified
3451            # actions.
3452            set i 0
3453            foreach tgt $tgts {
3454                set src [lindex $srcs $i]
3455
3456                switch -glob -- $src {
3457                    - {
3458                        # The source is unavailable for this file.
3459                        set tgt [file join $macports::prefix $tgt]
3460                        file delete $tgt
3461                        ui_debug "rm -f $tgt"
3462                    }
3463                    /* {
3464                        # The source is an absolute path.
3465                        set tgt [file join $macports::prefix $tgt]
3466                        file delete $tgt
3467                        file link -symbolic $tgt $src
3468                        ui_debug "ln -sf $src $tgt"
3469                    }
3470                    default {
3471                        # The source is a relative path.
3472                        set src [file join $macports::prefix $src]
3473                        set tgt [file join $macports::prefix $tgt]
3474                        file delete $tgt
3475                        file link -symbolic $tgt $src
3476                        ui_debug "ln -sf $src $tgt"
3477                    }
3478                }
3479                set i [expr $i+1]
3480            }
3481
3482            # Update the selected version.
3483            set selected_version "$conf_path/current"
3484            if {[file exists $selected_version]} {
3485                file delete $selected_version
3486            }
3487            symlink $version $selected_version
3488            return
3489        }
3490        show {
3491            set selected_version "$conf_path/current"
3492
3493            if {![file exists $selected_version]} {
3494                return "none"
3495            } else {
3496                return [file readlink $selected_version]
3497            }
3498        }
3499    }
3500    return
3501}
Note: See TracBrowser for help on using the repository browser.