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

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

double check that old port is active before trying to deactivate due to replaced_by

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