source: branches/gsoc09-logging/base/src/macports1.0/macports.tcl @ 52218

Last change on this file since 52218 was 52218, checked in by enl@…, 11 years ago

Merge from trunk

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 102.8 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 52218 2009-06-12 08:57:53Z enl@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
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 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_target universal_sysroot universal_archs \
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 portverbose destroot_umask rsync_server \
55        rsync_options rsync_dir startupitem_type place_worksymlink \
56        mp_remote_url mp_remote_submit_url configureccache configuredistcc configurepipe buildnicevalue buildmakejobs \
57        applications_dir frameworks_dir developer_dir universal_target universal_sysroot universal_archs $user_options"
58
59    # deferred options are only computed when needed.
60    # they are not exported to the trace thread.
61    # they are not exported to the interpreter in system_options array.
62    variable portinterp_deferred_options "xcodeversion xcodebuildcmd"
63
64    variable open_mports {}
65
66    variable ui_priorities "debug info msg error warn"
67}
68
69# Provided UI instantiations
70# For standard messages, the following priorities are defined
71#     debug, info, msg, warn, error
72# Clients of the library are expected to provide ui_prefix and ui_channels with
73# the following prototypes.
74#     proc ui_prefix {priority}
75#     proc ui_channels {priority}
76# ui_prefix returns the prefix for the messages, if any.
77# ui_channels returns a list of channels to output the message to, empty for
78#     no message.
79# if these functions are not provided, defaults are used.
80# Clients of the library may optionally provide ui_init with the following
81# prototype.
82#     proc ui_init {priority prefix channels message}
83# ui_init needs to correctly define the proc ::ui_$priority {message} or throw
84# an error.
85# if this function is not provided or throws an error, default procedures for
86# ui_$priority are defined.
87
88# ui_options accessor
89proc macports::ui_isset {val} {
90    if {[info exists macports::ui_options($val)]} {
91        if {$macports::ui_options($val) == "yes"} {
92            return 1
93        }
94    }
95    return 0
96}
97
98
99# global_options accessor
100proc macports::global_option_isset {val} {
101    if {[info exists macports::global_options($val)]} {
102        if {$macports::global_options($val) == "yes"} {
103            return 1
104        }
105    }
106    return 0
107}
108
109proc macports::init_logging {portname} {
110    global ::debuglog ::debuglogname macports::channels macports::prefix
111    set logname $macports::prefix
112   
113    append logname "/var/macports/logs/$portname"
114    file mkdir $logname
115
116    append logname "/main.log"
117    set ::debuglogname $logname
118
119    # Recreate the file if already exists
120    if {[file exists $::debuglogname]} {
121        file delete -force $::debuglogname
122    }
123    set ::debuglog [open $::debuglogname w]
124
125    # Add our log-channel to all already initialized channels
126    foreach key [array names channels] {
127        set macports::channels($key) [concat $macports::channels($key) $::debuglog]
128    }
129}
130
131proc ui_message {priority prefix args} {
132    global macports::channels
133    foreach chan $macports::channels($priority) {
134        if {[lindex $args 0] == "-nonewline"} {
135            puts -nonewline $chan "$prefix[lindex $args 1]"
136        } else {
137            puts $chan "$prefix[lindex $args 0]"
138        }
139    }
140}
141proc macports::ui_init {priority args} {
142    global macports::channels ::debuglog
143    set default_channel [macports::ui_channels_default $priority]
144    # Get the list of channels.
145    try {
146        set channels($priority) [ui_channels $priority]
147    } catch * {
148        set channels($priority) $default_channel
149    }
150   
151    # if some priority initialized after log file is being created
152    if [info exist ::debuglog] {
153        set channels($priority) [concat $channels($priority) $::debuglog]
154    }
155    # Simplify ui_$priority.
156    try {
157        set prefix [ui_prefix $priority]
158    } catch * {
159        set prefix [ui_prefix_default $priority]
160    }
161
162    try {
163        eval ::ui_init $priority $prefix $channels($priority) $args
164    } catch * {
165        interp alias {} ui_$priority {} ui_message $priority $prefix
166    }
167
168    # Call ui_$priority
169    eval ::ui_$priority $args
170   
171}
172
173# Default implementation of ui_prefix
174proc macports::ui_prefix_default {priority} {
175    switch $priority {
176        debug {
177            return "DEBUG: "
178        }
179        error {
180            return "Error: "
181        }
182        warn {
183            return "Warning: "
184        }
185        default {
186            return ""
187        }
188    }
189}
190
191# Default implementation of ui_channels:
192# ui_options(ports_debug) - If set, output debugging messages
193# ui_options(ports_verbose) - If set, output info messages (ui_info)
194# ui_options(ports_quiet) - If set, don't output "standard messages"
195proc macports::ui_channels_default {priority} {
196    switch $priority {
197        debug {
198            if {[ui_isset ports_debug]} {
199                return {stderr}
200            } else {
201                return {}
202            }
203        }
204        info {
205            if {[ui_isset ports_verbose]} {
206                return {stdout}
207            } else {
208                return {}
209            }
210        }
211        msg {
212            if {[ui_isset ports_quiet]} {
213                return {}
214            } else {
215                return {stdout}
216            }
217        }
218        warn -
219        error {
220            return {stderr}
221        }
222        default {
223            return {stdout}
224        }
225    }
226}
227
228foreach priority ${macports::ui_priorities} {
229    proc ui_$priority {args} [subst { eval macports::ui_init $priority \$args }]
230}
231
232# Replace puts to catch errors (typically broken pipes when being piped to head)
233rename puts tcl::puts
234proc puts {args} {
235    catch "tcl::puts $args"
236}
237
238# find a binary either in a path defined at MacPorts' configuration time
239# or in the PATH environment variable through macports::binaryInPath (fallback)
240proc macports::findBinary {prog {autoconf_hint ""}} {
241    if {${autoconf_hint} != "" && [file executable ${autoconf_hint}]} {
242        return ${autoconf_hint}
243    } else {
244        if {[catch {set cmd_path [macports::binaryInPath ${prog}]} result] == 0} {
245            return ${cmd_path}
246        } else {
247            return -code error "${result} or at its MacPorts configuration time location, did you move it?"
248        }
249    }
250}
251
252# check for a binary in the path
253# returns an error code if it cannot be found
254proc macports::binaryInPath {prog} {
255    global env
256    foreach dir [split $env(PATH) :] {
257        if {[file executable [file join $dir $prog]]} {
258            return [file join $dir $prog]
259        }
260    }
261    return -code error [format [msgcat::mc "Failed to locate '%s' in path: '%s'"] $prog $env(PATH)];
262}
263
264# deferred option processing
265proc macports::getoption {name} {
266    global macports::$name
267    return [expr $$name]
268}
269
270# deferred and on-need extraction of xcodeversion and xcodebuildcmd.
271proc macports::setxcodeinfo {name1 name2 op} {
272    global macports::xcodeversion
273    global macports::xcodebuildcmd
274
275    trace remove variable macports::xcodeversion read macports::setxcodeinfo
276    trace remove variable macports::xcodebuildcmd read macports::setxcodeinfo
277
278    if {[catch {set xcodebuild [binaryInPath "xcodebuild"]}] == 0} {
279        if {![info exists xcodeversion]} {
280            # Determine xcode version (<= 2.0 or 2.1)
281            if {[catch {set xcodebuildversion [exec xcodebuild -version]}] == 0} {
282                if {[regexp "DevToolsCore-(.*); DevToolsSupport-(.*)" $xcodebuildversion devtoolscore_v devtoolssupport_v] == 1} {
283                    if {$devtoolscore_v >= 620.0 && $devtoolssupport_v >= 610.0} {
284                        # for now, we don't need to distinguish 2.1 from 2.1 or higher.
285                        set macports::xcodeversion "2.1"
286                    } else {
287                        set macports::xcodeversion "2.0orlower"
288                    }
289                } else {
290                    set macports::xcodeversion "2.0orlower"
291                }
292            } else {
293                set macports::xcodeversion "2.0orlower"
294            }
295        }
296
297        if {![info exists xcodebuildcmd]} {
298            set macports::xcodebuildcmd "xcodebuild"
299        }
300    } elseif {[catch {set pbxbuild [binaryInPath "pbxbuild"]}] == 0} {
301        if {![info exists xcodeversion]} {
302            set macports::xcodeversion "pb"
303        }
304        if {![info exists xcodebuildcmd]} {
305            set macports::xcodebuildcmd "pbxbuild"
306        }
307    } else {
308        if {![info exists xcodeversion]} {
309            set macports::xcodeversion "none"
310        }
311        if {![info exists xcodebuildcmd]} {
312            set macports::xcodebuildcmd "none"
313        }
314    }
315}
316
317proc mportinit {{up_ui_options {}} {up_options {}} {up_variations {}}} {
318    if {$up_ui_options eq ""} {
319        array set macports::ui_options {}
320    } else {
321        upvar $up_ui_options temp_ui_options
322        array set macports::ui_options [array get temp_ui_options]
323    }
324    if {$up_options eq ""} {
325        array set macports::global_options {}
326    } else {
327        upvar $up_options temp_options
328        array set macports::global_options [array get temp_options]
329    }
330    if {$up_variations eq ""} {
331        array set variations {}
332    } else {
333        upvar $up_variations variations
334    }
335
336    global auto_path env
337    global macports::autoconf::macports_conf_path
338    global macports::macports_user_dir
339    global macports::bootstrap_options
340    global macports::user_options
341    global macports::extra_env
342    global macports::portconf
343    global macports::portdbpath
344    global macports::portsharepath
345    global macports::registry.format
346    global macports::registry.path
347    global macports::sources
348    global macports::sources_default
349    global macports::sources_conf
350    global macports::destroot_umask
351    global macports::libpath
352    global macports::prefix
353    global macports::macportsuser
354    global macports::prefix_frozen
355    global macports::registry.installtype
356    global macports::rsync_dir
357    global macports::rsync_options
358    global macports::rsync_server
359    global macports::variants_conf
360    global macports::xcodebuildcmd
361    global macports::xcodeversion
362    global macports::configureccache
363    global macports::configuredistcc
364    global macports::configurepipe
365    global macports::buildnicevalue
366    global macports::buildmakejobs
367    global macports::universal_target
368    global macports::universal_sysroot
369    global macports::universal_archs
370
371    # Set the system encoding to utf-8
372    encoding system utf-8
373
374    # Ensure that the macports user directory exists if HOME is defined
375    if {[info exists env(HOME)]} {
376        set macports::macports_user_dir [file normalize $macports::autoconf::macports_user_dir]
377    } else {
378        # Otherwise define the user directory as a direcotory that will never exist
379        set macports::macports_user_dir "/dev/null/NO_HOME_DIR"
380    }
381
382    # Configure the search path for configuration files
383    set conf_files ""
384    lappend conf_files "${macports_conf_path}/macports.conf"
385    if { [file isdirectory $macports_user_dir] } {
386        lappend conf_files "${macports_user_dir}/macports.conf"
387    }
388    if {[info exists env(PORTSRC)]} {
389        set PORTSRC $env(PORTSRC)
390        lappend conf_files ${PORTSRC}
391    }
392
393    # Process the first configuration file we find on conf_files list
394    foreach file $conf_files {
395        if [file exists $file] {
396            set portconf $file
397            set fd [open $file r]
398            while {[gets $fd line] >= 0} {
399                if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
400                    if {[lsearch $bootstrap_options $option] >= 0} {
401                        set macports::$option [string trim $val]
402                        global macports::$option
403                    }
404                }
405            }
406            close $fd
407        }
408    }
409
410    # Process per-user only settings
411    set per_user "${macports_user_dir}/user.conf"
412    if [file exists $per_user] {
413        set fd [open $per_user r]
414        while {[gets $fd line] >= 0} {
415            if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
416                if {[lsearch $user_options $option] >= 0} {
417                    set macports::$option $val
418                    global macports::$option
419                }
420            }
421        }
422        close $fd
423    }
424
425    if {![info exists sources_conf]} {
426        return -code error "sources_conf must be set in ${macports_conf_path}/macports.conf or in your ${macports_user_dir}/macports.conf file"
427    }
428    set fd [open $sources_conf r]
429    while {[gets $fd line] >= 0} {
430        set line [string trimright $line]
431        if {![regexp {^\s*#|^$} $line]} {
432            if {[regexp {^([\w-]+://\S+)(?:\s+\[(\w+(?:,\w+)*)\])?$} $line _ url flags]} {
433                set flags [split $flags ,]
434                foreach flag $flags {
435                    if {[lsearch -exact [list nosync default] $flag] == -1} {
436                        ui_warn "$sources_conf source '$line' specifies invalid flag '$flag'"
437                    }
438                    if {$flag == "default"} {
439                        if {[info exists sources_default]} {
440                            ui_warn "More than one default port source is defined."
441                        }
442                        set sources_default [concat [list $url] $flags]
443                    }
444                }
445                lappend sources [concat [list $url] $flags]
446            } else {
447                ui_warn "$sources_conf specifies invalid source '$line', ignored."
448            }
449        }
450    }
451    close $fd
452    # Make sure the default port source is defined. Otherwise
453    # [macports::getportresourcepath] fails when the first source doesn't
454    # contain _resources.
455    if {![info exists sources_default]} {
456        ui_warn "No default port source specified in $sources_conf, using last source as default"
457        set sources_default [lindex $sources end]
458    }
459
460    if {![info exists sources]} {
461        if {[file isdirectory ports]} {
462            set sources "file://[pwd]/ports"
463        } else {
464            return -code error "No sources defined in $sources_conf"
465        }
466    }
467
468    if {[info exists variants_conf]} {
469        if {[file exist $variants_conf]} {
470            set fd [open $variants_conf r]
471            while {[gets $fd line] >= 0} {
472                set line [string trimright $line]
473                if {![regexp {^[\ \t]*#.*$|^$} $line]} {
474                    foreach arg [split $line " \t"] {
475                        if {[regexp {^([-+])([-A-Za-z0-9_+\.]+)$} $arg match sign opt] == 1} {
476                            if {![info exists variations($opt)]} {
477                                set variations($opt) $sign
478                            }
479                        } else {
480                            ui_warn "$variants_conf specifies invalid variant syntax '$arg', ignored."
481                        }
482                    }
483                }
484            }
485            close $fd
486        } else {
487            ui_debug "$variants_conf does not exist, variants_conf setting ignored."
488        }
489    }
490
491    if {![info exists portdbpath]} {
492        return -code error "portdbpath must be set in ${macports_conf_path}/macports.conf or in your ${macports_user_dir}/macports.conf"
493    }
494    if {![file isdirectory $portdbpath]} {
495        if {![file exists $portdbpath]} {
496            if {[catch {file mkdir $portdbpath} result]} {
497                return -code error "portdbpath $portdbpath does not exist and could not be created: $result"
498            }
499        } else {
500            return -code error "$portdbpath is not a directory. Please create the directory $portdbpath and try again"
501        }
502    }
503
504    set registry.path $portdbpath
505
506    # Format for receipts, can currently be either "flat" or "sqlite"
507    if {[info exists portdbformat]} {
508        if { $portdbformat == "sqlite" } {
509            return -code error "SQLite is not yet supported for registry storage."
510        }
511        set registry.format receipt_${portdbformat}
512    } else {
513        set registry.format receipt_flat
514    }
515
516    # Installation type, whether to use port "images" or install "direct"
517    if {[info exists portinstalltype]} {
518        set registry.installtype $portinstalltype
519    } else {
520        set registry.installtype image
521    }
522
523    # Autoclean mode, whether to automatically call clean after "install"
524    if {![info exists portautoclean]} {
525        set macports::portautoclean "yes"
526        global macports::portautoclean
527    }
528    # Check command line override for autoclean
529    if {[info exists macports::global_options(ports_autoclean)]} {
530        if {![string equal $macports::global_options(ports_autoclean) $portautoclean]} {
531            set macports::portautoclean $macports::global_options(ports_autoclean)
532        }
533    }
534    # Trace mode, whether to use darwintrace to debug ports.
535    if {![info exists porttrace]} {
536        set macports::porttrace "no"
537        global macports::porttrace
538    }
539    # Check command line override for trace
540    if {[info exists macports::global_options(ports_trace)]} {
541        if {![string equal $macports::global_options(ports_trace) $porttrace]} {
542            set macports::porttrace $macports::global_options(ports_trace)
543        }
544    }
545
546    # Duplicate prefix into prefix_frozen, so that port actions
547    # can always get to the original prefix, even if a portfile overrides prefix
548    set macports::prefix_frozen $prefix
549
550    # Export verbosity.
551    if {![info exists portverbose]} {
552        set macports::portverbose "no"
553        global macports::portverbose
554    }
555    if {[info exists macports::ui_options(ports_verbose)]} {
556        if {![string equal $macports::ui_options(ports_verbose) $portverbose]} {
557            set macports::portverbose $macports::ui_options(ports_verbose)
558        }
559    }
560
561    # Archive mode, whether to create/use binary archive packages
562    if {![info exists portarchivemode]} {
563        set macports::portarchivemode "yes"
564        global macports::portarchivemode
565    }
566
567    # Archive path, where to store/retrieve binary archive packages
568    if {![info exists portarchivepath]} {
569        set macports::portarchivepath [file join $portdbpath packages]
570        global macports::portarchivepath
571    }
572    if {$portarchivemode == "yes"} {
573        if {![file isdirectory $portarchivepath]} {
574            if {![file exists $portarchivepath]} {
575                if {[catch {file mkdir $portarchivepath} result]} {
576                    return -code error "portarchivepath $portarchivepath does not exist and could not be created: $result"
577                }
578            }
579        }
580        if {![file isdirectory $portarchivepath]} {
581            return -code error "$portarchivepath is not a directory. Please create the directory $portarchivepath and try again"
582        }
583    }
584
585    # Archive type, what type of binary archive to use (CPIO, gzipped
586    # CPIO, XAR, etc.)
587    if {![info exists portarchivetype]} {
588        set macports::portarchivetype "cpgz"
589        global macports::portarchivetype
590    }
591    # Convert archive type to a list for multi-archive support, colon or
592    # comma separators indicates to use multiple archive formats
593    # (reading and writing)
594    set macports::portarchivetype [split $portarchivetype {:,}]
595
596    # Set rync options
597    if {![info exists rsync_server]} {
598        set macports::rsync_server rsync.macports.org
599        global macports::rsync_server
600    }
601    if {![info exists rsync_dir]} {
602        set macports::rsync_dir release/base/
603        global macports::rsync_dir
604    }
605    if {![info exists rsync_options]} {
606        set rsync_options "-rtzv --delete-after"
607        global macports::rsync_options
608    }
609
610    set portsharepath ${prefix}/share/macports
611    if {![file isdirectory $portsharepath]} {
612        return -code error "Data files directory '$portsharepath' must exist"
613    }
614
615    if {![info exists libpath]} {
616        set libpath "${prefix}/share/macports/Tcl"
617    }
618
619    if {![info exists binpath]} {
620        set env(PATH) "${prefix}/bin:${prefix}/sbin:/bin:/sbin:/usr/bin:/usr/sbin"
621    } else {
622        set env(PATH) "$binpath"
623    }
624
625    # Set startupitem default type (can be overridden by portfile)
626    if {![info exists macports::startupitem_type]} {
627        set macports::startupitem_type "default"
628    }
629
630    # Default place_worksymlink
631    if {![info exists macports::place_worksymlink]} {
632        set macports::place_worksymlink yes
633    }
634
635    # Default mp remote options
636    if {![info exists macports::mp_remote_url]} {
637        set macports::mp_remote_url "http://db.macports.org"
638    }
639    if {![info exists macports::mp_remote_submit_url]} {
640        set macports::mp_remote_submit_url "${macports::mp_remote_url}/submit"
641    }
642
643    # Default mp configure options
644    if {![info exists macports::configureccache]} {
645        set macports::configureccache no
646    }
647    if {![info exists macports::configuredistcc]} {
648        set macports::configuredistcc no
649    }
650    if {![info exists macports::configurepipe]} {
651        set macports::configurepipe no
652    }
653
654    # Default mp build options
655    if {![info exists macports::buildnicevalue]} {
656        set macports::buildnicevalue 0
657    }
658    if {![info exists macports::buildmakejobs]} {
659        set macports::buildmakejobs 0
660    }
661   
662    # Default Xcode Tools path
663    if {![info exists macports::developer_dir]} {
664        set macports::developer_dir "/Developer"
665    }
666
667    # Default mp universal options
668    if {![info exists macports::universal_target]} {
669        if {[file exists ${macports::developer_dir}/SDKs/MacOSX10.5.sdk]} {
670            set macports::universal_target "10.5"
671        } else {
672            set macports::universal_target "10.4"
673        }
674    }
675    if {![info exists macports::universal_sysroot]} {
676        if {[file exists ${macports::developer_dir}/SDKs/MacOSX10.5.sdk]} {
677            set macports::universal_sysroot "${macports::developer_dir}/SDKs/MacOSX10.5.sdk"
678        } else {
679            set macports::universal_sysroot "${macports::developer_dir}/SDKs/MacOSX10.4u.sdk"
680        }
681    }
682    if {![info exists macports::universal_archs]} {
683        set macports::universal_archs {ppc i386}
684    }
685
686    # ENV cleanup.
687    set keepenvkeys {
688        DISPLAY DYLD_FALLBACK_FRAMEWORK_PATH
689        DYLD_FALLBACK_LIBRARY_PATH DYLD_FRAMEWORK_PATH
690        DYLD_LIBRARY_PATH DYLD_INSERT_LIBRARIES
691        HOME JAVA_HOME MASTER_SITE_LOCAL
692        PATCH_SITE_LOCAL PATH PORTSRC RSYNC_PROXY TMP TMPDIR
693        USER GROUP
694        http_proxy HTTPS_PROXY FTP_PROXY ALL_PROXY NO_PROXY
695        COLUMNS LINES
696    }
697    if {[info exists extra_env]} {
698        set keepenvkeys [concat ${keepenvkeys} ${extra_env}]
699    }
700
701    foreach envkey [array names env] {
702        if {[lsearch $keepenvkeys $envkey] == -1} {
703            array unset env $envkey
704        }
705    }
706
707    if {![info exists xcodeversion] || ![info exists xcodebuildcmd]} {
708        # We'll resolve these later (if needed)
709        trace add variable macports::xcodeversion read macports::setxcodeinfo
710        trace add variable macports::xcodebuildcmd read macports::setxcodeinfo
711    }
712
713    # Set the default umask
714    if {![info exists destroot_umask]} {
715        set destroot_umask 022
716    }
717
718    if {[info exists master_site_local] && ![info exists env(MASTER_SITE_LOCAL)]} {
719        set env(MASTER_SITE_LOCAL) "$master_site_local"
720    }
721
722    if {[file isdirectory $libpath]} {
723        lappend auto_path $libpath
724        set macports::auto_path $auto_path
725
726        # XXX: not sure if this the best place, but it needs to happen
727        # early, and after auto_path has been set.  Or maybe Pextlib
728        # should ship with macports1.0 API?
729        package require Pextlib 1.0
730        package require registry 1.0
731    } else {
732        return -code error "Library directory '$libpath' must exist"
733    }
734
735    # unset environment an extra time, to work around bugs in Leopard Tcl
736    foreach envkey [array names env] {
737        if {[lsearch $keepenvkeys $envkey] == -1} {
738            unsetenv $envkey
739        }
740    }
741
742    # Proxy handling (done this late since Pextlib is needed)
743    if {![info exists proxy_override_env] } {
744        set proxy_override_env "no"
745    }
746    array set sysConfProxies [get_systemconfiguration_proxies]
747    if {![info exists env(http_proxy)] || $proxy_override_env == "yes" } {
748        if {[info exists proxy_http]} {
749            set env(http_proxy) $proxy_http
750        } elseif {[info exists sysConfProxies(proxy_http)]} {
751            set env(http_proxy) $sysConfProxies(proxy_http)
752        }
753    }
754    if {![info exists env(HTTPS_PROXY)] || $proxy_override_env == "yes" } {
755        if {[info exists proxy_https]} {
756            set env(HTTPS_PROXY) $proxy_https
757        } elseif {[info exists sysConfProxies(proxy_https)]} {
758            set env(HTTPS_PROXY) $sysConfProxies(proxy_https)
759        }
760    }
761    if {![info exists env(FTP_PROXY)] || $proxy_override_env == "yes" } {
762        if {[info exists proxy_ftp]} {
763            set env(FTP_PROXY) $proxy_ftp
764        } elseif {[info exists sysConfProxies(proxy_ftp)]} {
765            set env(FTP_PROXY) $sysConfProxies(proxy_ftp)
766        }
767    }
768    if {![info exists env(RSYNC_PROXY)] || $proxy_override_env == "yes" } {
769        if {[info exists proxy_rsync]} {
770            set env(RSYNC_PROXY) $proxy_rsync
771        }
772    }
773    if {![info exists env(NO_PROXY)] || $proxy_override_env == "yes" } {
774        if {[info exists proxy_skip]} {
775            set env(NO_PROXY) $proxy_skip
776        } elseif {[info exists sysConfProxies(proxy_skip)]} {
777            set env(NO_PROXY) $sysConfProxies(proxy_skip)
778        }
779    }
780
781    # load the quick index
782    _mports_load_quickindex
783}
784
785proc macports::worker_init {workername portpath porturl portbuildpath options variations} {
786    global macports::portinterp_options macports::portinterp_deferred_options registry.installtype
787
788    # Hide any Tcl commands that should be inaccessible to port1.0 and Portfiles
789    # exit: It should not be possible to exit the interpreter
790    interp hide $workername exit
791
792    # cd: This is necessary for some code in port1.0, but should be hidden
793    interp eval $workername "rename cd _cd"
794
795    # Tell the sub interpreter about all the Tcl packages we already
796    # know about so it won't glob for packages.
797    foreach pkgName [package names] {
798        foreach pkgVers [package versions $pkgName] {
799            set pkgLoadScript [package ifneeded $pkgName $pkgVers]
800            $workername eval "package ifneeded $pkgName $pkgVers {$pkgLoadScript}"
801        }
802    }
803
804    # Create package require abstraction procedure
805    $workername eval "proc PortSystem \{version\} \{ \n\
806            package require port \$version \}"
807
808    # Clearly separate slave interpreters and the master interpreter.
809    $workername alias mport_exec mportexec
810    $workername alias mport_open mportopen
811    $workername alias mport_close mportclose
812    $workername alias mport_lookup mportlookup
813
814    # instantiate the UI call-backs
815    foreach priority ${macports::ui_priorities} {
816        $workername alias ui_$priority ui_$priority
817    }
818    $workername alias ui_prefix ui_prefix
819    $workername alias ui_channels ui_channels
820
821    # Export some utility functions defined here.
822    $workername alias macports_create_thread macports::create_thread
823    $workername alias getportworkpath_from_buildpath macports::getportworkpath_from_buildpath
824    $workername alias getportresourcepath macports::getportresourcepath
825    $workername alias getdefaultportresourcepath macports::getdefaultportresourcepath
826    $workername alias getprotocol macports::getprotocol
827    $workername alias getportdir macports::getportdir
828
829    # New Registry/Receipts stuff
830    $workername alias registry_new registry::new_entry
831    $workername alias registry_open registry::open_entry
832    $workername alias registry_write registry::write_entry
833    $workername alias registry_prop_store registry::property_store
834    $workername alias registry_prop_retr registry::property_retrieve
835    $workername alias registry_delete registry::delete_entry
836    $workername alias registry_exists registry::entry_exists
837    $workername alias registry_exists_for_name registry::entry_exists_for_name
838    $workername alias registry_activate portimage::activate
839    $workername alias registry_deactivate portimage::deactivate
840    $workername alias registry_register_deps registry::register_dependencies
841    $workername alias registry_fileinfo_for_index registry::fileinfo_for_index
842    $workername alias registry_bulk_register_files registry::register_bulk_files
843    $workername alias registry_installed registry::installed
844    $workername alias registry_active registry::active
845
846    # deferred options processing.
847    $workername alias getoption macports::getoption
848
849    foreach opt $portinterp_options {
850        if {![info exists $opt]} {
851            global macports::$opt
852        }
853        if {[info exists $opt]} {
854            $workername eval set system_options($opt) \{[set $opt]\}
855            $workername eval set $opt \{[set $opt]\}
856        }
857    }
858
859    foreach opt $portinterp_deferred_options {
860        global macports::$opt
861        # define the trace hook.
862        $workername eval \
863            "proc trace_$opt {name1 name2 op} { \n\
864                trace remove variable ::$opt read ::trace_$opt \n\
865                global $opt \n\
866                set $opt \[getoption $opt\] \n\
867            }"
868        # next access will actually define the variable.
869        $workername eval "trace add variable ::$opt read ::trace_$opt"
870        # define some value now
871        $workername eval set $opt "?"
872    }
873
874    foreach {opt val} $options {
875        $workername eval set user_options($opt) $val
876        $workername eval set $opt $val
877    }
878
879    foreach {var val} $variations {
880        $workername eval set variations($var) $val
881    }
882
883    if { [info exists registry.installtype] } {
884        $workername eval set installtype ${registry.installtype}
885    }
886}
887
888# Create a thread with most configuration options set.
889# The newly created thread is sent portinterp_options vars and knows where to
890# find all packages we know.
891proc macports::create_thread {} {
892    package require Thread
893
894    global macports::portinterp_options
895
896    # Create the thread.
897    set result [thread::create -preserved {thread::wait}]
898
899    # Tell the thread about all the Tcl packages we already
900    # know about so it won't glob for packages.
901    foreach pkgName [package names] {
902        foreach pkgVers [package versions $pkgName] {
903            set pkgLoadScript [package ifneeded $pkgName $pkgVers]
904            thread::send -async $result "package ifneeded $pkgName $pkgVers {$pkgLoadScript}"
905        }
906    }
907
908    # inherit configuration variables.
909    thread::send -async $result "namespace eval macports {}"
910    foreach opt $portinterp_options {
911        if {![info exists $opt]} {
912            global macports::$opt
913        }
914        if {[info exists $opt]} {
915            thread::send -async $result "global macports::$opt"
916            set val [set macports::$opt]
917            thread::send -async $result "set macports::$opt \"$val\""
918        }
919    }
920
921    return $result
922}
923
924proc macports::fetch_port {url} {
925    global macports::portdbpath tcl_platform
926    set fetchdir [file join $portdbpath portdirs]
927    set fetchfile [file tail $url]
928    file mkdir $fetchdir
929    if {![file writable $fetchdir]} {
930        return -code error "Port remote fetch failed: You do not have permission to write to $fetchdir"
931    }
932    if {[catch {curl fetch $url [file join $fetchdir $fetchfile]} result]} {
933        return -code error "Port remote fetch failed: $result"
934    }
935    cd $fetchdir
936    if {[catch {exec [findBinary tar $macports::autoconf::tar_path] -zxf $fetchfile} result]} {
937        return -code error "Port extract failed: $result"
938    }
939    if {[regexp {(.+).tgz} $fetchfile match portdir] != 1} {
940        return -code error "Can't decipher portdir from $fetchfile"
941    }
942    return [file join $fetchdir $portdir]
943}
944
945proc macports::getprotocol {url} {
946    if {[regexp {(?x)([^:]+)://.+} $url match protocol] == 1} {
947        return ${protocol}
948    } else {
949        return -code error "Can't parse url $url"
950    }
951}
952
953# XXX: this really needs to be rethought in light of the remote index
954# I've added the destdir parameter.  This is the location a remotely
955# fetched port will be downloaded to (currently only applies to
956# mports:// sources).
957proc macports::getportdir {url {destdir "."}} {
958    if {[regexp {(?x)([^:]+)://(.+)} $url match protocol string] == 1} {
959        switch -regexp -- ${protocol} {
960            {^file$} {
961                return [file normalize $string]
962            }
963            {^mports$} {
964                return [macports::index::fetch_port $url $destdir]
965            }
966            {^https?$|^ftp$} {
967                return [macports::fetch_port $url]
968            }
969            default {
970                return -code error "Unsupported protocol $protocol"
971            }
972        }
973    } else {
974        return -code error "Can't parse url $url"
975    }
976}
977
978##
979# Get the path to the _resources directory of the source
980#
981# If the file is not available in the current source, it will fall back to the
982# default source. This behavior is controlled by the fallback parameter.
983#
984# @param url port url
985# @param path path in _resources we are interested in
986# @param fallback fall back to the default source tree
987# @return path to the _resources directory or the path to the fallback
988proc macports::getportresourcepath {url {path ""} {fallback yes}} {
989    global macports::sources_default
990
991    set protocol [getprotocol $url]
992
993    switch -- ${protocol} {
994        file {
995            set proposedpath [file normalize [file join [getportdir $url] .. ..]]
996        }
997    }
998
999    # append requested path
1000    set proposedpath [file join $proposedpath _resources $path]
1001
1002    if {$fallback == "yes" && ![file exists $proposedpath]} {
1003        return [getdefaultportresourcepath $path]
1004    }
1005
1006    return $proposedpath
1007}
1008
1009##
1010# Get the path to the _resources directory of the default source
1011#
1012# @param path path in _resources we are interested in
1013# @return path to the _resources directory of the default source
1014proc macports::getdefaultportresourcepath {{path ""}} {
1015    global macports::sources_default
1016
1017    set default_source_url [lindex ${sources_default} 0]
1018    if {[getprotocol $default_source_url] == "file"} {
1019        set proposedpath [getportdir $default_source_url]
1020    } else {
1021        set proposedpath [getsourcepath $default_source_url]
1022    }
1023
1024    # append requested path
1025    set proposedpath [file join $proposedpath _resources $path]
1026
1027    return $proposedpath
1028}
1029
1030# mportopen
1031# Opens a MacPorts portfile specified by a URL.  The Portfile is
1032# opened with the given list of options and variations.  The result
1033# of this function should be treated as an opaque handle to a
1034# MacPorts Portfile.
1035
1036proc mportopen {porturl {options ""} {variations ""} {nocache ""}} {
1037    global macports::portdbpath macports::portconf macports::open_mports auto_path
1038
1039    # Look for an already-open MPort with the same URL.
1040    # XXX: should compare options and variations here too.
1041    # if found, return the existing reference and bump the refcount.
1042    if {$nocache != ""} {
1043        set mport {}
1044    } else {
1045        set mport [dlist_search $macports::open_mports porturl $porturl]
1046    }
1047    if {$mport != {}} {
1048        set refcnt [ditem_key $mport refcnt]
1049        incr refcnt
1050        ditem_key $mport refcnt $refcnt
1051        return $mport
1052    }
1053
1054    array set options_array $options
1055    if {[info exists options_array(portdir)]} {
1056        set portdir $options_array(portdir)
1057    } else {
1058        set portdir ""
1059    }
1060
1061    set portpath [macports::getportdir $porturl $portdir]
1062    ui_debug "Changing to port directory: $portpath"
1063    cd $portpath
1064    if {![file isfile Portfile]} {
1065        return -code error "Could not find Portfile in $portpath"
1066    }
1067
1068    # Iterate through the explicitly set/unset variants, filtering out
1069    # implicit variants. At the moment, the only implicit variants are
1070    # platform variants.
1071    set filteredvariations {}
1072
1073    foreach {variation value} $variations {
1074        switch -regexp $variation {
1075            ^(pure)?darwin         -
1076            ^(free|net|open){1}bsd -
1077            ^i386                  -
1078            ^linux                 -
1079            ^macosx                -
1080            ^powerpc               -
1081            ^solaris               -
1082            ^sunos {
1083                ui_debug "Implicit variants should not be explicitly set or unset. $variation will be ignored."
1084            }
1085            default {
1086                lappend filteredvariations $variation $value
1087            }
1088        }
1089    }
1090
1091    set workername [interp create]
1092
1093    set mport [ditem_create]
1094    lappend macports::open_mports $mport
1095    ditem_key $mport porturl $porturl
1096    ditem_key $mport portpath $portpath
1097    ditem_key $mport workername $workername
1098    ditem_key $mport options $options
1099    ditem_key $mport variations $filteredvariations
1100    ditem_key $mport refcnt 1
1101
1102    macports::worker_init $workername $portpath $porturl [macports::getportbuildpath $portpath] $options $filteredvariations
1103
1104    $workername eval source Portfile
1105
1106    # add the default universal variant, but only if
1107    # it will work and another one isn't already present
1108    if {[$workername eval default_universal_variant_allowed]} {
1109        $workername eval add_default_universal_variant
1110    }
1111
1112    # evaluate the variants
1113    if {[$workername eval eval_variants variations] != 0} {
1114        mportclose $mport
1115        error "Error evaluating variants"
1116    }
1117
1118    ditem_key $mport provides [$workername eval return \$name]
1119
1120    return $mport
1121}
1122
1123# Traverse a directory with ports, calling a function on the path of ports
1124# (at the second depth).
1125# I.e. the structure of dir shall be:
1126# category/port/
1127# with a Portfile file in category/port/
1128#
1129# func:     function to call on every port directory (it is passed
1130#           category/port/ as its parameter)
1131# root:     the directory with all the categories directories.
1132proc mporttraverse {func {root .}} {
1133    # Save the current directory
1134    set pwd [pwd]
1135
1136    # Join the root.
1137    set pathToRoot [file join $pwd $root]
1138
1139    # Go to root because some callers expects us to be there.
1140    cd $pathToRoot
1141
1142    foreach category [lsort -increasing -unique [readdir $root]] {
1143        set pathToCategory [file join $root $category]
1144        # process the category dirs but not _resources
1145        if {[file isdirectory $pathToCategory] && [string index [file tail $pathToCategory] 0] != "_"} {
1146            # Iterate on port directories.
1147            foreach port [lsort -increasing -unique [readdir $pathToCategory]] {
1148                set pathToPort [file join $pathToCategory $port]
1149                if {[file isdirectory $pathToPort] &&
1150                  [file exists [file join $pathToPort "Portfile"]]} {
1151                    # Call the function.
1152                    $func [file join $category $port]
1153
1154                    # Restore the current directory because some
1155                    # functions changes it.
1156                    cd $pathToRoot
1157                }
1158            }
1159        }
1160    }
1161
1162    # Restore the current directory.
1163    cd $pwd
1164}
1165
1166### _mportsearchpath is private; subject to change without notice
1167
1168# depregex -> regex on the filename to find.
1169# search_path -> directories to search
1170# executable -> whether we want to check that the file is executable by current
1171#               user or not.
1172proc _mportsearchpath {depregex search_path {executable 0}} {
1173    set found 0
1174    foreach path $search_path {
1175        if {![file isdirectory $path]} {
1176            continue
1177        }
1178
1179        if {[catch {set filelist [readdir $path]} result]} {
1180            return -code error "$result ($path)"
1181            set filelist ""
1182        }
1183
1184        foreach filename $filelist {
1185            if {[regexp $depregex $filename] &&
1186              (($executable == 0) || [file executable [file join $path $filename]])} {
1187                ui_debug "Found Dependency: path: $path filename: $filename regex: $depregex"
1188                set found 1
1189                break
1190            }
1191        }
1192    }
1193    return $found
1194}
1195
1196### _libtest is private; subject to change without notice
1197# XXX - Architecture specific
1198# XXX - Rely on information from internal defines in cctools/dyld:
1199# define DEFAULT_FALLBACK_FRAMEWORK_PATH
1200# /Library/Frameworks:/Library/Frameworks:/Network/Library/Frameworks:/System/Library/Frameworks
1201# define DEFAULT_FALLBACK_LIBRARY_PATH /lib:/usr/local/lib:/lib:/usr/lib
1202#   -- Since /usr/local is bad, using /lib:/usr/lib only.
1203# Environment variables DYLD_FRAMEWORK_PATH, DYLD_LIBRARY_PATH,
1204# DYLD_FALLBACK_FRAMEWORK_PATH, and DYLD_FALLBACK_LIBRARY_PATH take precedence
1205
1206proc _libtest {mport depspec} {
1207    global env tcl_platform
1208    set depline [lindex [split $depspec :] 1]
1209    set prefix [_mportkey $mport prefix]
1210    set frameworks_dir [_mportkey $mport frameworks_dir]
1211
1212    if {[info exists env(DYLD_FRAMEWORK_PATH)]} {
1213        lappend search_path $env(DYLD_FRAMEWORK_PATH)
1214    } else {
1215        lappend search_path ${frameworks_dir} /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks
1216    }
1217    if {[info exists env(DYLD_FALLBACK_FRAMEWORK_PATH)]} {
1218        lappend search_path $env(DYLD_FALLBACK_FRAMEWORK_PATH)
1219    }
1220    if {[info exists env(DYLD_LIBRARY_PATH)]} {
1221        lappend search_path $env(DYLD_LIBRARY_PATH)
1222    }
1223    lappend search_path /lib /usr/lib ${prefix}/lib
1224    if {[info exists env(DYLD_FALLBACK_LIBRARY_PATH)]} {
1225        lappend search_path $env(DYLD_FALLBACK_LIBRARY_PATH)
1226    }
1227
1228    set i [string first . $depline]
1229    if {$i < 0} {set i [string length $depline]}
1230    set depname [string range $depline 0 [expr $i - 1]]
1231    set depversion [string range $depline $i end]
1232    regsub {\.} $depversion {\.} depversion
1233    if {$tcl_platform(os) == "Darwin"} {
1234        set depregex \^${depname}${depversion}\\.dylib\$
1235    } else {
1236        set depregex \^${depname}\\.so${depversion}\$
1237    }
1238
1239    return [_mportsearchpath $depregex $search_path]
1240}
1241
1242### _bintest is private; subject to change without notice
1243
1244proc _bintest {mport depspec} {
1245    global env
1246    set depregex [lindex [split $depspec :] 1]
1247    set prefix [_mportkey $mport prefix]
1248
1249    set search_path [split $env(PATH) :]
1250
1251    set depregex \^$depregex\$
1252
1253    return [_mportsearchpath $depregex $search_path 1]
1254}
1255
1256### _pathtest is private; subject to change without notice
1257
1258proc _pathtest {mport depspec} {
1259    global env
1260    set depregex [lindex [split $depspec :] 1]
1261    set prefix [_mportkey $mport prefix]
1262
1263    # separate directory from regex
1264    set fullname $depregex
1265
1266    regexp {^(.*)/(.*?)$} "$fullname" match search_path depregex
1267
1268    if {[string index $search_path 0] != "/"} {
1269        # Prepend prefix if not an absolute path
1270        set search_path "${prefix}/${search_path}"
1271    }
1272
1273    set depregex \^$depregex\$
1274
1275    return [_mportsearchpath $depregex $search_path]
1276}
1277
1278### _porttest is private; subject to change without notice
1279
1280proc _porttest {mport depspec} {
1281    # We don't actually look for the port, but just return false
1282    # in order to let the mportdepends handle the dependency
1283    return 0
1284}
1285
1286### _mportinstalled is private; may change without notice
1287
1288# Determine if a port is already *installed*, as in "in the registry".
1289proc _mportinstalled {mport} {
1290    # Check for the presence of the port in the registry
1291    set workername [ditem_key $mport workername]
1292    return [$workername eval registry_exists_for_name \${name}]
1293}
1294
1295# Determine if a port is active (only for image mode)
1296proc _mportactive {mport} {
1297    set workername [ditem_key $mport workername]
1298    if {[catch {set reslist [$workername eval registry_active \${name}]}]} {
1299        return 0
1300    } else {
1301        return [expr [llength $reslist] > 0]
1302    }
1303}
1304
1305# Determine if the named port is active (only for image mode)
1306proc _portnameactive {portname} {
1307    if {[catch {set reslist [registry::active $portname]}]} {
1308        return 0
1309    } else {
1310        return [expr [llength $reslist] > 0]
1311    }
1312}
1313
1314### _mportispresent is private; may change without notice
1315
1316# Determine if some depspec is satisfied or if the given port is installed
1317# (and active, if we're in image mode).
1318# We actually start with the registry (faster?)
1319#
1320# mport     the port declaring the dep (context in which to evaluate $prefix etc)
1321# depspec   the dependency test specification (path, bin, lib, etc.)
1322proc _mportispresent {mport depspec} {
1323    set portname [lindex [split $depspec :] end]
1324    ui_debug "Searching for dependency: $portname"
1325    if {[string equal ${macports::registry.installtype} "image"]} {
1326        set res [_portnameactive $portname]
1327    } else {
1328        set res [registry::entry_exists_for_name $portname]
1329    }
1330    if {$res != 0} {
1331        ui_debug "Found Dependency: receipt exists for $portname"
1332        return 1
1333    } else {
1334        # The receipt test failed, use one of the depspec regex mechanisms
1335        ui_debug "Didn't find receipt, going to depspec regex for: $portname"
1336        set type [lindex [split $depspec :] 0]
1337        switch $type {
1338            lib { return [_libtest $mport $depspec] }
1339            bin { return [_bintest $mport $depspec] }
1340            path { return [_pathtest $mport $depspec] }
1341            port { return [_porttest $mport $depspec] }
1342            default {return -code error "unknown depspec type: $type"}
1343        }
1344        return 0
1345    }
1346}
1347
1348### _mportconflictsinstalled is private; may change without notice
1349
1350# Determine if the port, per the conflicts option, has any conflicts with
1351# what is installed.
1352#
1353# mport   the port to check for conflicts
1354# Returns a list of which installed ports conflict, or an empty list if none
1355proc _mportconflictsinstalled {mport conflictinfo} {
1356    set conflictlist {}
1357    if {[llength $conflictinfo] > 0} {
1358        ui_debug "Checking for conflicts against [_mportkey $mport name]"
1359        foreach conflictport ${conflictinfo} {
1360            if {[_mportispresent $mport port:${conflictport}]} {
1361                lappend conflictlist $conflictport
1362            }
1363        }
1364    } else {
1365        ui_debug "[_mportkey $mport name] has no conflicts"
1366    }
1367
1368    return $conflictlist
1369}
1370
1371
1372### _mportexec is private; may change without notice
1373
1374proc _mportexec {target mport} {
1375    # xxx: set the work path?
1376    set workername [ditem_key $mport workername]
1377    if {![catch {$workername eval check_variants variations $target} result] && $result == 0 &&
1378        ![catch {$workername eval eval_targets $target} result] && $result == 0} {
1379        # If auto-clean mode, clean-up after dependency install
1380        if {[string equal ${macports::portautoclean} "yes"]} {
1381            # Make sure we are back in the port path before clean
1382            # otherwise if the current directory had been changed to
1383            # inside the port,  the next port may fail when trying to
1384            # install because [pwd] will return a "no file or directory"
1385            # error since the directory it was in is now gone.
1386            set portpath [ditem_key $mport portpath]
1387            catch {cd $portpath}
1388            $workername eval eval_targets clean
1389        }
1390        return 0
1391    } else {
1392        # An error occurred.
1393        return 1
1394    }
1395}
1396
1397# mportexec
1398# Execute the specified target of the given mport.
1399proc mportexec {mport target} {
1400    global macports::registry.installtype
1401    set workername [ditem_key $mport workername]
1402    # check variants
1403    if {[$workername eval check_variants variations $target] != 0} {
1404        return 1
1405    }
1406    set portname [_mportkey $mport name]
1407    macports::init_logging $portname
1408    # Before we build the port, we must build its dependencies.
1409    # XXX: need a more general way of comparing against targets
1410    set dlist {}
1411    if {   $target == "fetch" || $target == "checksum"
1412        || $target == "extract" || $target == "patch"
1413        || $target == "configure" || $target == "build"
1414        || $target == "test"
1415        || $target == "destroot" || $target == "install"
1416        || $target == "archive"
1417        || $target == "dmg" || $target == "mdmg"
1418        || $target == "pkg" || $target == "mpkg"
1419        || $target == "rpm" || $target == "dpkg"
1420        || $target == "srpm"|| $target == "portpkg" } {
1421
1422        ui_msg -nonewline "--->  Computing dependencies for [_mportkey $mport name]"
1423        if {[macports::ui_isset ports_debug]} {
1424            # play nice with debug messages
1425            ui_msg ""
1426        }
1427        if {[mportdepends $mport $target] != 0} {
1428            return 1
1429        }
1430        ui_msg ""
1431
1432        # Select out the dependents along the critical path,
1433        # but exclude this mport, we might not be installing it.
1434        set dlist [dlist_append_dependents $macports::open_mports $mport {}]
1435
1436        dlist_delete dlist $mport
1437
1438        # install them
1439        # xxx: as with below, this is ugly.  and deps need to be fixed to
1440        # understand Port Images before this can get prettier
1441        if { [string equal ${macports::registry.installtype} "image"] } {
1442            set result [dlist_eval $dlist _mportactive [list _mportexec "activate"]]
1443        } else {
1444            set result [dlist_eval $dlist _mportinstalled [list _mportexec "install"]]
1445        }
1446
1447        if {$result != {}} {
1448            set errstring "The following dependencies failed to build:"
1449            foreach ditem $result {
1450                append errstring " [ditem_key $ditem provides]"
1451            }
1452            ui_error $errstring
1453            return 1
1454        }
1455
1456        # Close the dependencies, we're done installing them.
1457        foreach ditem $dlist {
1458            mportclose $ditem
1459        }
1460    }
1461
1462    # If we're doing an install, check if we should clean after
1463    set clean 0
1464    if {[string equal ${macports::portautoclean} "yes"] && [string equal $target "install"] } {
1465        set clean 1
1466    }
1467
1468    # If we're doing image installs, then we should activate after install
1469    # xxx: This isn't pretty
1470    if { [string equal ${macports::registry.installtype} "image"] && [string equal $target "install"] } {
1471        set target activate
1472    }
1473
1474    # Build this port with the specified target
1475    set result [$workername eval eval_targets $target]
1476
1477    # If auto-clean mode and successful install, clean-up after install
1478    if {$result == 0 && $clean == 1} {
1479        # Make sure we are back in the port path, just in case
1480        set portpath [ditem_key $mport portpath]
1481        catch {cd $portpath}
1482        $workername eval eval_targets clean
1483    }
1484
1485    return $result
1486}
1487
1488proc macports::getsourcepath {url} {
1489    global macports::portdbpath
1490
1491    set source_path [split $url ://]
1492
1493    if {[_source_is_snapshot $url]} {
1494        # daily snapshot tarball
1495        return [file join $portdbpath sources [join [lrange $source_path 3 end-1] /] ports]
1496    }
1497
1498    return [file join $portdbpath sources [lindex $source_path 3] [lindex $source_path 4] [lindex $source_path 5]]
1499}
1500
1501##
1502# Checks whether a supplied source URL is for a daily snapshot tarball
1503# (private)
1504#
1505# @param url source URL to check
1506# @return a list containing filename and extension or an empty list
1507proc _source_is_snapshot {url {filename ""} {extension ""}} {
1508    upvar $filename myfilename
1509    upvar $extension myextension
1510
1511    if {[regexp {^(?:https?|ftp)://.+/(.+\.(tar\.gz|tar\.bz2))$} $url -> f e]} {
1512        set myfilename $f
1513        set myextension $e
1514
1515        return 1
1516    }
1517
1518    return 0
1519}
1520
1521proc macports::getportbuildpath {id} {
1522    global macports::portdbpath
1523    regsub {://} $id {.} port_path
1524    regsub -all {/} $port_path {_} port_path
1525    return [file join $portdbpath build $port_path]
1526}
1527
1528proc macports::getportworkpath_from_buildpath {portbuildpath} {
1529    return [file join $portbuildpath work]
1530}
1531
1532proc macports::getportworkpath_from_portdir {portpath} {
1533    return [macports::getportworkpath_from_buildpath [macports::getportbuildpath $portpath]]
1534}
1535
1536proc macports::getindex {source} {
1537    # Special case file:// sources
1538    if {[macports::getprotocol $source] == "file"} {
1539        return [file join [macports::getportdir $source] PortIndex]
1540    }
1541
1542    return [file join [macports::getsourcepath $source] PortIndex]
1543}
1544
1545proc mportsync {{optionslist {}}} {
1546    global macports::sources macports::portdbpath macports::rsync_options tcl_platform
1547    global macports::portverbose
1548    global macports::autoconf::rsync_path
1549    array set options $optionslist
1550
1551    set numfailed 0
1552
1553    ui_debug "Synchronizing ports tree(s)"
1554    foreach source $sources {
1555        set flags [lrange $source 1 end]
1556        set source [lindex $source 0]
1557        if {[lsearch -exact $flags nosync] != -1} {
1558            ui_debug "Skipping $source"
1559            continue
1560        }
1561        ui_info "Synchronizing local ports tree from $source"
1562        switch -regexp -- [macports::getprotocol $source] {
1563            {^file$} {
1564                set portdir [macports::getportdir $source]
1565                if {[file exists $portdir/.svn]} {
1566                    set svn_commandline "[macports::findBinary svn] update --non-interactive ${portdir}"
1567                    ui_debug $svn_commandline
1568                    if {
1569                        [catch {
1570                            set euid [geteuid]
1571                            set egid [getegid]
1572                            ui_debug "changing euid/egid - current euid: $euid - current egid: $egid"
1573                            setegid [name_to_gid [file attributes $portdir -group]]
1574                            seteuid [name_to_uid [file attributes $portdir -owner]]
1575                            system $svn_commandline
1576                            seteuid $euid
1577                            setegid $egid
1578                        }]
1579                    } {
1580                        ui_debug "$::errorInfo"
1581                        ui_error "Synchronization of the local ports tree failed doing an svn update"
1582                        incr numfailed
1583                        continue
1584                    }
1585                }
1586            }
1587            {^mports$} {
1588                macports::index::sync $macports::portdbpath $source
1589            }
1590            {^rsync$} {
1591                # Where to, boss?
1592                set destdir [file dirname [macports::getindex $source]]
1593                file mkdir $destdir
1594                # Keep rsync happy with a trailing slash
1595                if {[string index $source end] != "/"} {
1596                    set source "${source}/"
1597                }
1598                # Do rsync fetch
1599                set rsync_commandline "${macports::autoconf::rsync_path} ${rsync_options} ${source} ${destdir}"
1600                ui_debug $rsync_commandline
1601                if {[catch {system $rsync_commandline}]} {
1602                    ui_error "Synchronization of the local ports tree failed doing rsync"
1603                    incr numfailed
1604                    continue
1605                }
1606                if {[catch {system "chmod -R a+r \"$destdir\""}]} {
1607                    ui_warn "Setting world read permissions on parts of the ports tree failed, need root?"
1608                }
1609            }
1610            {^https?$|^ftp$} {
1611                if {[_source_is_snapshot $source filename extension]} {
1612                    # sync a daily port snapshot tarball
1613                    set indexfile [macports::getindex $source]
1614                    set destdir [file dirname $indexfile]
1615                    set tarpath [file join [file normalize [file join $destdir ..]] $filename]
1616
1617                    set updated 1
1618                    if {[file isdirectory $destdir]} {
1619                        set moddate [file mtime $destdir]
1620                        if {[catch {set updated [curl isnewer $source $moddate]} error]} {
1621                            ui_warn "Cannot check if $source was updated, ($error)"
1622                        }
1623                    }
1624
1625                    if {(![info exists options(ports_force)] || $options(ports_force) != "yes") && $updated <= 0} {
1626                        ui_info "No updates for $source"
1627                        continue
1628                    }
1629
1630                    file mkdir [file dirname $indexfile]
1631
1632                    set verboseflag {}
1633                    if {$macports::portverbose == "yes"} {
1634                        set verboseflag "-v"
1635                    }
1636
1637                    if {[catch {eval curl fetch $verboseflag {$source} {$tarpath}} error]} {
1638                        ui_error "Fetching $source failed ($error)"
1639                        incr numfailed
1640                        continue
1641                    }
1642
1643                    set extflag {}
1644                    switch $extension {
1645                        {tar.gz} {
1646                            set extflag "-z"
1647                        }
1648                        {tar.bz2} {
1649                            set extflag "-j"
1650                        }
1651                    }
1652
1653                    if { [catch { system "cd $destdir/.. && tar ${verboseflag} ${extflag} -xf $filename" } error] } {
1654                        ui_error "Extracting $source failed ($error)"
1655                        incr numfailed
1656                        continue
1657                    }
1658
1659                    if {[catch {system "chmod -R a+r \"$destdir\""}]} {
1660                        ui_warn "Setting world read permissions on parts of the ports tree failed, need root?"
1661                    }
1662
1663                    file delete $tarpath
1664                } else {
1665                    # sync just a PortIndex file
1666                    set indexfile [macports::getindex $source]
1667                    file mkdir [file dirname $indexfile]
1668                    curl $source/PortIndex $indexfile
1669                }
1670            }
1671            default {
1672                ui_warn "Unknown synchronization protocol for $source"
1673            }
1674        }
1675    }
1676
1677    if {$numfailed > 0} {
1678        return -code error "Synchronization of $numfailed source(s) failed"
1679    }
1680}
1681
1682proc mportsearch {pattern {case_sensitive yes} {matchstyle regexp} {field name}} {
1683    global macports::portdbpath macports::sources
1684    set matches [list]
1685    set easy [expr { $field == "name" }]
1686
1687    set found 0
1688    foreach source $sources {
1689        set flags [lrange $source 1 end]
1690        set source [lindex $source 0]
1691        if {[macports::getprotocol $source] == "mports"} {
1692            array set attrs [list name $pattern]
1693            set res [macports::index::search $macports::portdbpath $source [array get attrs]]
1694            eval lappend matches $res
1695        } else {
1696            if {[catch {set fd [open [macports::getindex $source] r]} result]} {
1697                ui_warn "Can't open index file for source: $source"
1698            } else {
1699                try {
1700                    incr found 1
1701                    while {[gets $fd line] >= 0} {
1702                        array unset portinfo
1703                        set name [lindex $line 0]
1704                        set len [lindex $line 1]
1705                        set line [read $fd $len]
1706
1707                        if {$easy} {
1708                            set target $name
1709                        } else {
1710                            array set portinfo $line
1711                            if {![info exists portinfo($field)]} continue
1712                            set target $portinfo($field)
1713                        }
1714
1715                        switch $matchstyle {
1716                            exact {
1717                                set matchres [expr 0 == ( {$case_sensitive == "yes"} ? [string compare $pattern $target] : [string compare -nocase $pattern $target] )]
1718                            }
1719                            glob {
1720                                set matchres [expr {$case_sensitive == "yes"} ? [string match $pattern $target] : [string match -nocase $pattern $target]]
1721                            }
1722                            regexp -
1723                            default {
1724                                set matchres [expr {$case_sensitive == "yes"} ? [regexp -- $pattern $target] : [regexp -nocase -- $pattern $target]]
1725                            }
1726                        }
1727
1728                        if {$matchres == 1} {
1729                            if {$easy} {
1730                                array set portinfo $line
1731                            }
1732                            switch -regexp -- [macports::getprotocol ${source}] {
1733                                {^rsync$} {
1734                                    # Rsync files are local
1735                                    set source_url "file://[macports::getsourcepath $source]"
1736                                }
1737                                {^https?$|^ftp$} {
1738                                    if {[_source_is_snapshot $source filename extension]} {
1739                                        # daily snapshot tarball
1740                                        set source_url "file://[macports::getsourcepath $source]"
1741                                    } else {
1742                                        # default action
1743                                        set source_url $source
1744                                    }
1745                                }
1746                                default {
1747                                    set source_url $source
1748                                }
1749                            }
1750                            if {[info exists portinfo(portarchive)]} {
1751                                set porturl ${source_url}/$portinfo(portarchive)
1752                            } elseif {[info exists portinfo(portdir)]} {
1753                                set porturl ${source_url}/$portinfo(portdir)
1754                            }
1755                            if {[info exists porturl]} {
1756                                lappend line porturl $porturl
1757                                ui_debug "Found port in $porturl"
1758                            } else {
1759                                ui_debug "Found port info: $line"
1760                            }
1761                            lappend matches $name
1762                            lappend matches $line
1763                        }
1764                    }
1765                } catch {*} {
1766                    ui_warn "It looks like your PortIndex file may be corrupt."
1767                    throw
1768                } finally {
1769                    close $fd
1770                }
1771            }
1772        }
1773    }
1774    if {!$found} {
1775        return -code error "No index(es) found! Have you synced your source indexes?"
1776    }
1777
1778    return $matches
1779}
1780
1781# Returns the PortInfo for a single named port. The info comes from the
1782# PortIndex, and name matching is case-insensitive. Unlike mportsearch, only
1783# the first match is returned, but the return format is otherwise identical.
1784# The advantage is that mportlookup is much faster than mportsearch, due to
1785# the use of the quick index.
1786proc mportlookup {name} {
1787    global macports::portdbpath macports::sources
1788
1789    set sourceno 0
1790    set matches [list]
1791    foreach source $sources {
1792        set source [lindex $source 0]
1793        if {[macports::getprotocol $source] != "mports"} {
1794            global macports::quick_index
1795            if {![info exists quick_index($sourceno,[string tolower $name])]} {
1796                incr sourceno 1
1797                continue
1798            }
1799            # The quick index is keyed on the port name, and provides the
1800            # offset in the main PortIndex where the given port's PortInfo
1801            # line can be found.
1802            set offset $quick_index($sourceno,[string tolower $name])
1803            incr sourceno 1
1804            if {[catch {set fd [open [macports::getindex $source] r]} result]} {
1805                ui_warn "Can't open index file for source: $source"
1806            } else {
1807                try {
1808                    seek $fd $offset
1809                    gets $fd line
1810                    set name [lindex $line 0]
1811                    set len [lindex $line 1]
1812                    set line [read $fd $len]
1813
1814                    array set portinfo $line
1815
1816                    switch -regexp -- [macports::getprotocol ${source}] {
1817                        {^rsync$} {
1818                            # Rsync files are local
1819                            set source_url "file://[macports::getsourcepath $source]"
1820                        }
1821                        {^https?$|^ftp$} {
1822                            if {[_source_is_snapshot $source filename extension]} {
1823                                # daily snapshot tarball
1824                                set source_url "file://[macports::getsourcepath $source]"
1825                             } else {
1826                                # default action
1827                                set source_url $source
1828                             }
1829                        }
1830                        default {
1831                            set source_url $source
1832                        }
1833                    }
1834                    if {[info exists portinfo(portarchive)]} {
1835                        set porturl ${source_url}/$portinfo(portarchive)
1836                    } elseif {[info exists portinfo(portdir)]} {
1837                        set porturl ${source_url}/$portinfo(portdir)
1838                    }
1839                    if {[info exists porturl]} {
1840                        lappend line porturl $porturl
1841                        ui_debug "Found port in $porturl"
1842                    } else {
1843                        ui_debug "Found port info: $line"
1844                    }
1845                    lappend matches $name
1846                    lappend matches $line
1847                    close $fd
1848                    break
1849                } catch {*} {
1850                    ui_warn "It looks like your PortIndex file may be corrupt."
1851                    throw
1852                } finally {
1853                    catch {close $fd}
1854                }
1855            }
1856        } else {
1857            array set attrs [list name $name]
1858            set res [macports::index::search $macports::portdbpath $source [array get attrs]]
1859            if {[llength $res] > 0} {
1860                eval lappend matches $res
1861                break
1862            }
1863        }
1864    }
1865
1866    return $matches
1867}
1868
1869# Loads PortIndex.quick from each source into the quick_index, generating
1870# it first if necessary.
1871proc _mports_load_quickindex {args} {
1872    global macports::sources macports::quick_index
1873
1874    set sourceno 0
1875    foreach source $sources {
1876        unset -nocomplain quicklist
1877        # chop off any tags
1878        set source [lindex $source 0]
1879        set index [macports::getindex $source]
1880        if {![file exists ${index}]} {
1881            continue
1882        }
1883        if {![file exists ${index}.quick] || [file mtime ${index}] > [file mtime ${index}.quick]} {
1884            # stale or nonexistent quick index file, so generate a new one
1885            if {[catch {set quicklist [mports_generate_quickindex ${index}]}]} {
1886                continue
1887            }
1888        }
1889        # only need to read the quick index file if we didn't just update it
1890        if {![info exists quicklist]} {
1891            if {[catch {set fd [open ${index}.quick r]} result]} {
1892                ui_warn "Can't open quick index file for source: $source"
1893                continue
1894            } else {
1895                set quicklist [read $fd]
1896                close $fd
1897            }
1898        }
1899        foreach entry [split $quicklist "\n"] {
1900            set quick_index($sourceno,[lindex $entry 0]) [lindex $entry 1]
1901        }
1902        incr sourceno 1
1903    }
1904    if {!$sourceno} {
1905        ui_warn "No index(es) found! Have you synced your source indexes?"
1906    }
1907}
1908
1909proc mports_generate_quickindex {index} {
1910    if {[catch {set indexfd [open ${index} r]} result] || [catch {set quickfd [open ${index}.quick w]} result]} {
1911        ui_warn "Can't open index file: $index"
1912        return -code error
1913    } else {
1914        try {
1915            set offset [tell $indexfd]
1916            set quicklist ""
1917            while {[gets $indexfd line] >= 0} {
1918                if {[llength $line] != 2} {
1919                    continue
1920                }
1921                set name [lindex $line 0]
1922                append quicklist "[string tolower $name] ${offset}\n"
1923
1924                set len [lindex $line 1]
1925                read $indexfd $len
1926                set offset [tell $indexfd]
1927            }
1928            puts -nonewline $quickfd $quicklist
1929        } catch {*} {
1930            ui_warn "It looks like your PortIndex file may be corrupt."
1931            throw
1932        } finally {
1933            close $indexfd
1934            close $quickfd
1935        }
1936    }
1937    if {[info exists quicklist]} {
1938        return $quicklist
1939    } else {
1940        ui_warn "Failed to generate quick index for: $index"
1941        return -code error
1942    }
1943}
1944
1945proc mportinfo {mport} {
1946    set workername [ditem_key $mport workername]
1947    return [$workername eval array get PortInfo]
1948}
1949
1950proc mportclose {mport} {
1951    global macports::open_mports
1952    set refcnt [ditem_key $mport refcnt]
1953    incr refcnt -1
1954    ditem_key $mport refcnt $refcnt
1955    if {$refcnt == 0} {
1956        dlist_delete macports::open_mports $mport
1957        set workername [ditem_key $mport workername]
1958        interp delete $workername
1959        ditem_delete $mport
1960    }
1961}
1962
1963##### Private Depspec API #####
1964# This API should be considered work in progress and subject to change without notice.
1965##### "
1966
1967# _mportkey
1968# - returns a variable from the port's interpreter
1969
1970proc _mportkey {mport key} {
1971    set workername [ditem_key $mport workername]
1972    return [$workername eval "return \$${key}"]
1973}
1974
1975# mportdepends builds the list of mports which the given port depends on.
1976# This list is added to $mport.
1977# This list actually depends on the target.
1978# This method can optionally recurse through the dependencies, looking for
1979#   dependencies of dependencies.
1980# This method can optionally cut the search when ports are already installed or
1981#   the dependencies are satisfied.
1982#
1983# mport -> mport item
1984# target -> target to consider the dependency for
1985# recurseDeps -> if the search should be recursive
1986# skipSatisfied -> cut the search tree when encountering installed/satisfied
1987#                  dependencies ports.
1988# accDeps -> accumulator for recursive calls
1989# return 0 if everything was ok, an non zero integer otherwise.
1990proc mportdepends {mport {target ""} {recurseDeps 1} {skipSatisfied 1}} {
1991
1992    array set portinfo [mportinfo $mport]
1993    set depends {}
1994    set deptypes {}
1995
1996    # progress indicator
1997    if {![macports::ui_isset ports_debug]} {
1998        ui_info -nonewline "."
1999        flush stdout
2000    }
2001   
2002    if {[info exists portinfo(conflicts)] && ($target == "" || $target == "install")} {
2003        set conflictports [_mportconflictsinstalled $mport $portinfo(conflicts)]
2004        if {[llength ${conflictports}] != 0} {
2005            if {[macports::global_option_isset ports_force]} {
2006                ui_warn "Force option set; installing $portinfo(name) despite conflicts with: ${conflictports}"
2007            } else {
2008                return -code error "Can't install $portinfo(name) because conflicting ports are installed: ${conflictports}"
2009            }
2010        }
2011    }
2012
2013    # Determine deptypes to look for based on target
2014    switch $target {
2015        fetch       -
2016        checksum    { set deptypes "depends_fetch" }
2017        extract     -
2018        patch       { set deptypes "depends_fetch depends_extract" }
2019        configure   -
2020        build       { set deptypes "depends_fetch depends_extract depends_lib depends_build" }
2021
2022        test        -
2023        destroot    -
2024        install     -
2025        archive     -
2026        dmg         -
2027        pkg         -
2028        portpkg     -
2029        mdmg        -
2030        mpkg        -
2031        rpm         -
2032        srpm        -
2033        dpkg        -
2034        ""          { set deptypes "depends_fetch depends_extract depends_lib depends_build depends_run" }
2035    }
2036
2037    # Gather the dependencies for deptypes
2038    foreach deptype $deptypes {
2039        # Add to the list of dependencies if the option exists and isn't empty.
2040        if {[info exists portinfo($deptype)] && $portinfo($deptype) != ""} {
2041            set depends [concat $depends $portinfo($deptype)]
2042        }
2043    }
2044
2045    set subPorts {}
2046    set options [ditem_key $mport options]
2047    set variations [ditem_key $mport variations]
2048
2049    foreach depspec $depends {
2050        # Is that dependency satisfied or this port installed?
2051        # If we don't skip or if it is not, add it to the list.
2052        if {!$skipSatisfied || ![_mportispresent $mport $depspec]} {
2053            # grab the portname portion of the depspec
2054            set dep_portname [lindex [split $depspec :] end]
2055
2056            # Find the porturl
2057            if {[catch {set res [mportlookup $dep_portname]} error]} {
2058                global errorInfo
2059                ui_debug "$errorInfo"
2060                ui_error "Internal error: port lookup failed: $error"
2061                return 1
2062            }
2063
2064            array unset portinfo
2065            array set portinfo [lindex $res 1]
2066            if {![info exists portinfo(porturl)]} {
2067                ui_error "Dependency '$dep_portname' not found."
2068                return 1
2069            }
2070
2071            # Figure out the subport. Check the open_mports list first, since
2072            # we potentially leak mport references if we mportopen each time,
2073            # because mportexec only closes each open mport once.
2074            set subport [dlist_search $macports::open_mports porturl $portinfo(porturl)]
2075            if {$subport == {}} {
2076                # We haven't opened this one yet.
2077                set subport [mportopen $portinfo(porturl) $options $variations]
2078                if {$recurseDeps} {
2079                    # Add to the list we need to recurse on.
2080                    lappend subPorts $subport
2081                }
2082            }
2083
2084            # Append the sub-port's provides to the port's requirements list.
2085            ditem_append_unique $mport requires "[ditem_key $subport provides]"
2086        }
2087    }
2088
2089    # Loop on the subports.
2090    if {$recurseDeps} {
2091        foreach subport $subPorts {
2092            # Sub ports should be installed (all dependencies must be satisfied).
2093            set res [mportdepends $subport "" $recurseDeps $skipSatisfied]
2094            if {$res != 0} {
2095                return $res
2096            }
2097        }
2098    }
2099
2100    return 0
2101}
2102
2103# selfupdate procedure
2104proc macports::selfupdate {{optionslist {}}} {
2105    global macports::prefix macports::portdbpath macports::libpath macports::rsync_server macports::rsync_dir macports::rsync_options
2106    global macports::autoconf::macports_version macports::autoconf::rsync_path
2107    array set options $optionslist
2108
2109    # syncing ports tree.
2110    if {![info exists options(ports_selfupdate_nosync)] || $options(ports_selfupdate_nosync) != "yes"} {
2111        ui_msg "--->  Updating the ports tree"
2112        if {[catch {mportsync $optionslist} result]} {
2113            return -code error "Couldn't sync the ports tree: $result"
2114        }
2115    }
2116
2117    # create the path to the to be downloaded sources if it doesn't exist
2118    set mp_source_path [file join $portdbpath sources ${rsync_server} ${rsync_dir}/]
2119    if {![file exists $mp_source_path]} {
2120        file mkdir $mp_source_path
2121    }
2122    ui_debug "MacPorts sources location: $mp_source_path"
2123
2124    # sync the MacPorts sources
2125    ui_msg "--->  Updating MacPorts base sources using rsync"
2126    if { [catch { system "$rsync_path $rsync_options rsync://${rsync_server}/${rsync_dir} $mp_source_path" } result ] } {
2127       return -code error "Error synchronizing MacPorts sources: $result"
2128    }
2129
2130    # echo current MacPorts version
2131    ui_msg "MacPorts base version $macports::autoconf::macports_version installed,"
2132
2133    if { [info exists options(ports_force)] && $options(ports_force) == "yes" } {
2134        set use_the_force_luke yes
2135        ui_debug "Forcing a rebuild and reinstallation of MacPorts"
2136    } else {
2137        set use_the_force_luke no
2138        ui_debug "Rebuilding and reinstalling MacPorts if needed"
2139    }
2140
2141    # Choose what version file to use: old, floating point format or new, real version number format
2142    set version_file [file join $mp_source_path config macports_version]
2143    if {[file exists $version_file]} {
2144        set fd [open $version_file r]
2145        gets $fd macports_version_new
2146        close $fd
2147        # echo downloaded MacPorts version
2148        ui_msg "MacPorts base version $macports_version_new downloaded."
2149    } else {
2150        ui_warn "No version file found, please rerun selfupdate."
2151        set macports_version_new 0
2152    }
2153
2154    # check if we we need to rebuild base
2155    set comp [rpm-vercomp $macports_version_new $macports::autoconf::macports_version]
2156    if {$use_the_force_luke == "yes" || $comp > 0} {
2157        if {[info exists options(ports_dryrun)] && $options(ports_dryrun) == "yes"} {
2158            ui_msg "--->  MacPorts base is outdated, selfupdate would install $macports_version_new (dry run)"
2159        } else {
2160            ui_msg "--->  MacPorts base is outdated, installing new version $macports_version_new"
2161
2162            # get installation user/group and permissions
2163            set owner [file attributes ${prefix} -owner]
2164            set group [file attributes ${prefix} -group]
2165            set perms [string range [file attributes ${prefix} -permissions] end-3 end]
2166            if {![string equal $tcl_platform(user) $owner]} {
2167                return -code error "User $tcl_platform(user) does not own ${prefix} - try using sudo"
2168            }
2169            ui_debug "Permissions OK"
2170
2171            # where to install our macports1.0 tcl package
2172            set mp_tclpackage_path [file join $portdbpath .tclpackage]
2173            if { [file exists $mp_tclpackage_path]} {
2174                set fd [open $mp_tclpackage_path r]
2175                gets $fd tclpackage
2176                close $fd
2177            } else {
2178                set tclpackage $libpath
2179            }
2180
2181            set configure_args "--prefix=$prefix --with-tclpackage=$tclpackage --with-install-user=$owner --with-install-group=$group --with-directory-mode=$perms"
2182            # too many users have an incompatible readline in /usr/local, see ticket #10651
2183            if {$tcl_platform(os) != "Darwin" || $prefix == "/usr/local"
2184                || ([glob -nocomplain "/usr/local/lib/lib{readline,history}*"] == "" && [glob -nocomplain "/usr/local/include/readline/*.h"] == "")} {
2185                append configure_args " --enable-readline"
2186            } else {
2187                ui_warn "Disabling readline support due to readline in /usr/local"
2188            }
2189
2190            # do the actual configure, build and installation of new base
2191            ui_msg "Installing new MacPorts release in $prefix as $owner:$group; permissions $perms; Tcl-Package in $tclpackage\n"
2192            if { [catch { system "cd $mp_source_path && ./configure $configure_args && make && make install" } result] } {
2193                return -code error "Error installing new MacPorts base: $result"
2194            }
2195        }
2196    } elseif {$comp < 0} {
2197        ui_msg "--->  MacPorts base is probably trunk or a release candidate"
2198    } else {
2199        ui_msg "--->  MacPorts base is already the latest version"
2200    }
2201
2202    # set the MacPorts sources to the right owner
2203    set sources_owner [file attributes [file join $portdbpath sources/] -owner]
2204    ui_debug "Setting MacPorts sources ownership to $sources_owner"
2205    if { [catch { exec [findBinary chown $macports::autoconf::chown_path] -R $sources_owner [file join $portdbpath sources/] } result] } {
2206        return -code error "Couldn't change permissions of the MacPorts sources at $mp_source_path to $sources_owner: $result"
2207    }
2208
2209    if {![info exists options(ports_selfupdate_nosync)] || $options(ports_selfupdate_nosync) != "yes"} {
2210        ui_msg "\nThe ports tree has been updated. To upgrade your installed ports, you should run"
2211        ui_msg "  port upgrade outdated"
2212    }
2213
2214    return 0
2215}
2216
2217# upgrade procedure
2218proc macports::upgrade {portname dspec globalvarlist variationslist optionslist {depscachename ""}} {
2219    global macports::registry.installtype
2220    global macports::portarchivemode
2221    array set options $optionslist
2222
2223    # Note $variationslist is left alone and so retains the original
2224    # requested variations, which should be passed to recursive calls to
2225    # upgrade; while variations gets existing variants and global variations
2226    # merged in later on, so it applies only to this port's upgrade
2227    array set variations $variationslist
2228
2229    if {![string match "" $depscachename]} {
2230        upvar $depscachename depscache
2231    }
2232
2233    # Is this a dry run?
2234    set is_dryrun no
2235    if {[info exists options(ports_dryrun)] && $options(ports_dryrun) eq "yes"} {
2236        set is_dryrun yes
2237    }
2238
2239    # check if the port is in tree
2240    if {[catch {mportlookup $portname} result]} {
2241        global errorInfo
2242        ui_debug "$errorInfo"
2243        ui_error "port lookup failed: $result"
2244        return 1
2245    }
2246    # argh! port doesnt exist!
2247    if {$result == ""} {
2248        ui_error "No port $portname found."
2249        return 1
2250    }
2251    # fill array with information
2252    array set portinfo [lindex $result 1]
2253    # set portname again since the one we were passed may not have had the correct case
2254    set portname $portinfo(name)
2255
2256    # set version_in_tree and revision_in_tree
2257    if {![info exists portinfo(version)]} {
2258        ui_error "Invalid port entry for $portname, missing version"
2259        return 1
2260    }
2261    set version_in_tree "$portinfo(version)"
2262    set revision_in_tree "$portinfo(revision)"
2263    set epoch_in_tree "$portinfo(epoch)"
2264
2265    set ilist {}
2266    if { [catch {set ilist [registry::installed $portname ""]} result] } {
2267        if {$result == "Registry error: $portname not registered as installed." } {
2268            ui_debug "$portname is *not* installed by MacPorts"
2269
2270            # We need to pass _mportispresent a reference to the mport that is
2271            # actually declaring the dependency on the one we're checking for.
2272            # We got here via _upgrade_dependencies, so we grab it from 2 levels up.
2273            upvar 2 workername parentworker
2274            if {![_mportispresent $parentworker $dspec ] } {
2275                # open porthandle
2276                set porturl $portinfo(porturl)
2277                if {![info exists porturl]} {
2278                    set porturl file://./
2279                }
2280                # Merge the global variations into the specified
2281                foreach { variation value } $globalvarlist {
2282                    if { ![info exists variations($variation)] } {
2283                        set variations($variation) $value
2284                    }
2285                }
2286
2287                if {[catch {set workername [mportopen $porturl [array get options] [array get variations]]} result]} {
2288                    global errorInfo
2289                    ui_debug "$errorInfo"
2290                    ui_error "Unable to open port: $result"
2291                    return 1
2292                }
2293                # While we're at it, update the portinfo
2294                array unset portinfo
2295                array set portinfo [mportinfo $workername]
2296               
2297                # upgrade its dependencies first
2298                _upgrade_dependencies portinfo depscache globalvarlist variationslist options
2299                # now install it
2300                if {[catch {set result [mportexec $workername install]} result]} {
2301                    global errorInfo
2302                    ui_debug "$errorInfo"
2303                    ui_error "Unable to exec port: $result"
2304                    catch {mportclose $workername}
2305                    return 1
2306                }
2307                if {$result > 0} {
2308                    ui_error "Problem while installing $portname"
2309                    catch {mportclose $workername}
2310                    return $result
2311                }
2312                # we just installed it, so mark it done in the cache
2313                set depscache(port:${portname}) 1
2314                mportclose $workername
2315            } else {
2316                # dependency is satisfied by something other than the named port
2317                ui_debug "$portname not installed, soft dependency satisfied"
2318                # mark this depspec as satisfied in the cache
2319                set depscache($dspec) 1
2320            }
2321            # the rest of the proc doesn't matter for a port that is freshly
2322            # installed or not installed
2323            return 0
2324        } else {
2325            ui_error "Checking installed version failed: $result"
2326            exit 1
2327        }
2328    } else {
2329        # we'll now take care of upgrading it, so we can add it to the cache
2330        set depscache(port:${portname}) 1
2331    }
2332    set anyactive no
2333    set version_installed {}
2334    set revision_installed {}
2335    set epoch_installed 0
2336    set variant_installed ""
2337
2338    # find latest version installed and active version (if any)
2339    foreach i $ilist {
2340        set variant [lindex $i 3]
2341        set version [lindex $i 1]
2342        set revision [lindex $i 2]
2343        set epoch [lindex $i 5]
2344        if { $version_installed == {} || $epoch > $epoch_installed ||
2345                ($epoch == $epoch_installed && [rpm-vercomp $version $version_installed] > 0)
2346                || ($epoch == $epoch_installed
2347                    && [rpm-vercomp $version $version_installed] == 0
2348                    && [rpm-vercomp $revision $revision_installed] > 0)} {
2349            set version_installed $version
2350            set revision_installed $revision
2351            set variant_installed $variant
2352            set epoch_installed $epoch
2353        }
2354
2355        set isactive [lindex $i 4]
2356        if {$isactive == 1} {
2357            set anyactive yes
2358            set version_active $version
2359            set revision_active $revision
2360            set variant_active $variant
2361        }
2362    }
2363
2364    # output version numbers
2365    ui_debug "epoch: in tree: $epoch_in_tree installed: $epoch_installed"
2366    ui_debug "$portname ${version_in_tree}_${revision_in_tree} exists in the ports tree"
2367    ui_debug "$portname ${version_installed}_${revision_installed} $variant_installed is the latest installed"
2368    if {$anyactive} {
2369        ui_debug "$portname ${version_active}_${revision_active} $variant_active is active"
2370    } else {
2371        ui_debug "no version of $portname is active"
2372    }
2373
2374    # save existing variant for later use
2375    if {$anyactive} {
2376        set oldvariant $variant_active
2377    } else {
2378        set oldvariant $variant_installed
2379    }
2380
2381    # Before we do
2382    # dependencies, we need to figure out the final variants,
2383    # open the port, and update the portinfo.
2384
2385    set porturl $portinfo(porturl)
2386    if {![info exists porturl]} {
2387        set porturl file://./
2388    }
2389
2390    # check if the variants is present in $version_in_tree
2391    set variant [split $oldvariant +]
2392    ui_debug "Merging existing variants $variant into variants"
2393    if {[info exists portinfo(variants)]} {
2394        set avariants $portinfo(variants)
2395    } else {
2396        set avariants {}
2397    }
2398    ui_debug "available variants are : $avariants"
2399    foreach v $variant {
2400        if {[lsearch $avariants $v] == -1} {
2401        } else {
2402            ui_debug "variant $v is present in $portname $version_in_tree"
2403            if { ![info exists variations($v)]} {
2404                set variations($v) "+"
2405            }
2406        }
2407    }
2408
2409    # Now merge in the global (i.e. variants.conf) variations.
2410    # We wait until now so that existing variants for this port
2411    # override global variations
2412    foreach { variation value } $globalvarlist {
2413        if { ![info exists variations($variation)] } {
2414            set variations($variation) $value
2415        }
2416    }
2417
2418    ui_debug "new fully merged portvariants: [array get variations]"
2419
2420    if {[catch {set workername [mportopen $porturl [array get options] [array get variations]]} result]} {
2421        global errorInfo
2422        ui_debug "$errorInfo"
2423        ui_error "Unable to open port: $result"
2424        return 1
2425    }
2426
2427    array unset portinfo
2428    array set portinfo [mportinfo $workername]
2429    set portwasopened 1
2430    set version_in_tree "$portinfo(version)"
2431    set revision_in_tree "$portinfo(revision)"
2432    set epoch_in_tree "$portinfo(epoch)"
2433
2434
2435    # first upgrade dependencies
2436    if {![info exists options(ports_nodeps)]} {
2437        _upgrade_dependencies portinfo depscache globalvarlist variationslist options
2438    } else {
2439        ui_debug "Not following dependencies"
2440    }
2441
2442    set epoch_override 0
2443    # check installed version against version in ports
2444    if { ( [rpm-vercomp $version_installed $version_in_tree] > 0
2445            || ([rpm-vercomp $version_installed $version_in_tree] == 0
2446                && [rpm-vercomp $revision_installed $revision_in_tree] >= 0 ))
2447        && ![info exists options(ports_force)] } {
2448        ui_debug "No need to upgrade! $portname ${version_installed}_${revision_installed} >= $portname ${version_in_tree}_${revision_in_tree}"
2449        if {[info exists portinfo(canonical_active_variants)]
2450            && $portinfo(canonical_active_variants) != $oldvariant} {
2451            ui_warn "Skipping upgrade since $portname ${version_installed}_${revision_installed} >= $portname ${version_in_tree}_${revision_in_tree}, even though installed variant $oldvariant does not match $portinfo(canonical_active_variants). Specify -f to force upgrade."
2452        }
2453        if { $epoch_installed >= $epoch_in_tree } {
2454            # Check if we have to do dependents
2455            if {[info exists options(ports_do_dependents)]} {
2456                # We do dependents ..
2457                set options(ports_nodeps) 1
2458
2459                registry::open_dep_map
2460                set deplist [registry::list_dependents $portname]
2461
2462                if { [llength deplist] > 0 } {
2463                    foreach dep $deplist {
2464                        set mpname [lindex $dep 2]
2465                        if {![llength [array get depscache port:${mpname}]]} {
2466                            macports::upgrade $mpname port:${mpname} $globalvarlist $variationslist [array get options] depscache
2467                        }
2468                    }
2469                }
2470            }
2471            mportclose $workername
2472            return 0
2473        } else {
2474            set epoch_override 1
2475            ui_debug "epoch override ... upgrading!"
2476        }
2477    }
2478
2479
2480    # build or unarchive version_in_tree
2481    if {0 == [string compare "yes" ${macports::portarchivemode}]} {
2482        set upgrade_action "archive"
2483    } else {
2484        set upgrade_action "destroot"
2485    }
2486
2487    # avoid building again unnecessarily
2488    if {[info exists options(ports_force)] || $epoch_override == 1
2489        || ![registry::entry_exists $portname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)]} {
2490        if {[catch {set result [mportexec $workername $upgrade_action]} result] || $result != 0} {
2491            global errorInfo
2492            ui_debug "$errorInfo"
2493            ui_error "Unable to upgrade port: $result"
2494            catch {mportclose $workername}
2495            return 1
2496        }
2497    }
2498
2499    # always uninstall old port in direct mode
2500    if { 0 != [string compare "image" ${macports::registry.installtype}] } {
2501        # uninstall old
2502        ui_debug "Uninstalling $portname ${version_installed}_${revision_installed}${variant_installed}"
2503        # we have to force the uninstall in case of dependents
2504        set force_cur [info exists options(ports_force)]
2505        set options(ports_force) yes
2506        if {$is_dryrun eq "yes"} {
2507            ui_msg "Skipping uninstall $portname @${version_installed}_${revision_installed}${variant_installed} (dry run)"
2508        } elseif {[catch {portuninstall::uninstall $portname ${version_installed}_${revision_installed}${variant_installed} [array get options]} result]} {
2509            global errorInfo
2510            ui_debug "$errorInfo"
2511            ui_error "Uninstall $portname ${version_installed}_${revision_installed}${variant_installed} failed: $result"
2512            catch {mportclose $workername}
2513            return 1
2514        }
2515        if {!$force_cur} {
2516            unset options(ports_force)
2517        }
2518    } else {
2519        # are we installing an existing version due to force or epoch override?
2520        if {[registry::entry_exists $portname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)]} {
2521             ui_debug "Uninstalling $portname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants)"
2522            # we have to force the uninstall in case of dependents
2523            set force_cur [info exists options(ports_force)]
2524            set options(ports_force) yes
2525            if {$is_dryrun eq "yes"} {
2526                ui_msg "Skipping uninstall $portname @${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants) (dry run)"
2527            } elseif {[catch {portuninstall::uninstall $portname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants) [array get options]} result]} {
2528                global errorInfo
2529                ui_debug "$errorInfo"
2530                ui_error "Uninstall $portname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants) failed: $result"
2531                catch {mportclose $workername}
2532                return 1
2533            }
2534            if {!$force_cur} {
2535                unset options(ports_force)
2536            }
2537            if {$anyactive && $version_in_tree == $version_active && $revision_in_tree == $revision_active
2538                && $portinfo(canonical_active_variants) == $variant_active} {
2539                set anyactive no
2540            }
2541        }
2542        if {$anyactive} {
2543            # deactivate version_active
2544            if {$is_dryrun eq "yes"} {
2545                ui_msg "Skipping deactivate $portname @${version_active}_${revision_active} (dry run)"
2546            } elseif {[catch {portimage::deactivate $portname ${version_active}_${revision_active}${variant_active} $optionslist} result]} {
2547                global errorInfo
2548                ui_debug "$errorInfo"
2549                ui_error "Deactivating $portname ${version_active}_${revision_active} failed: $result"
2550                catch {mportclose $workername}
2551                return 1
2552            }
2553        }
2554        if {[info exists options(port_uninstall_old)]} {
2555            # uninstalling now could fail due to dependents when not forced,
2556            # because the new version is not installed
2557            set uninstall_later yes
2558        }
2559    }
2560
2561    if {$is_dryrun eq "yes"} {
2562        ui_msg "Skipping activate $portname @${version_in_tree}_${revision_in_tree} (dry run)"
2563    } elseif {[catch {set result [mportexec $workername install]} result]} {
2564        global errorInfo
2565        ui_debug "$errorInfo"
2566        ui_error "Couldn't activate $portname ${version_in_tree}_${revision_in_tree}: $result"
2567        catch {mportclose $workername}
2568        return 1
2569    }
2570
2571    if {[info exists uninstall_later] && $uninstall_later == yes} {
2572        foreach i $ilist {
2573            set version [lindex $i 1]
2574            set revision [lindex $i 2]
2575            set variant [lindex $i 3]
2576            if {$version == $version_in_tree && $revision == $revision_in_tree && $variant == $portinfo(canonical_active_variants)} {
2577                continue
2578            }
2579            ui_debug "Uninstalling $portname ${version}_${revision}${variant}"
2580            if {$is_dryrun eq "yes"} {
2581                ui_msg "Skipping uninstall $portname @${version}_${revision}${variant} (dry run)"
2582            } elseif {[catch {portuninstall::uninstall $portname ${version}_${revision}${variant} $optionslist} result]} {
2583                global errorInfo
2584                ui_debug "$errorInfo"
2585                ui_error "Uninstall $portname @${version}_${revision}${variant} failed: $result"
2586                catch {mportclose $workername}
2587                return 1
2588            }
2589        }
2590    }
2591
2592    # Check if we have to do dependents
2593    if {[info exists options(ports_do_dependents)]} {
2594        # We do dependents ..
2595        set options(ports_nodeps) 1
2596
2597        registry::open_dep_map
2598        set deplist [registry::list_dependents $portname]
2599
2600        if { [llength deplist] > 0 } {
2601            foreach dep $deplist {
2602                set mpname [lindex $dep 2]
2603                if {![llength [array get depscache port:${mpname}]]} {
2604                    macports::upgrade $mpname port:${mpname} $globalvarlist $variationslist [array get options] depscache
2605                }
2606            }
2607        }
2608    }
2609
2610
2611    # close the port handle
2612    mportclose $workername
2613}
2614
2615# upgrade_dependencies: helper proc for upgrade
2616# Calls upgrade on each dependency listed in the PortInfo.
2617# Uses upvar to access the variables.
2618proc macports::_upgrade_dependencies {portinfoname depscachename globalvarlistname variationslistname optionsname} {
2619    upvar $portinfoname portinfo $depscachename depscache \
2620          $globalvarlistname globalvarlist $variationslistname variationslist \
2621          $optionsname options
2622
2623    # If we're following dependents, we only want to follow this port's
2624    # dependents, not those of all its dependencies. Otherwise, we would
2625    # end up processing this port's dependents n+1 times (recursively!),
2626    # where n is the number of dependencies this port has, since this port
2627    # is of course a dependent of each of its dependencies. Plus the
2628    # dependencies could have any number of unrelated dependents.
2629
2630    # So we save whether we're following dependents, unset the option
2631    # while doing the dependencies, and restore it afterwards.
2632    set saved_do_dependents [info exists options(ports_do_dependents)]
2633    unset -nocomplain options(ports_do_dependents)
2634
2635    # each dep type is upgraded
2636    foreach dtype {depends_fetch depends_extract depends_build depends_lib depends_run} {
2637        if {[info exists portinfo($dtype)]} {
2638            foreach i $portinfo($dtype) {
2639                set d [lindex [split $i :] end]
2640                if {![llength [array get depscache port:${d}]] && ![llength [array get depscache $i]]} {
2641                    upgrade $d $i $globalvarlist $variationslist [array get options] depscache
2642                }
2643            }
2644        }
2645    }
2646    # restore dependent-following to its former value
2647    if {$saved_do_dependents} {
2648        set options(ports_do_dependents) yes
2649    }
2650}
2651
2652# mportselect
2653#   * command: The only valid commands are list, set and show
2654#   * group: This argument should correspond to a directory under
2655#            $macports::prefix/etc/select.
2656#   * version: This argument is only used by the 'set' command.
2657# On error mportselect returns with the code 'error'.
2658proc mportselect {command group {version ""}} {
2659    ui_debug "mportselect \[$command] \[$group] \[$version]"
2660
2661    set conf_path "$macports::prefix/etc/select/$group"
2662    if {![file isdirectory $conf_path]} {
2663        return -code error "The specified group '$group' does not exist."
2664    }
2665
2666    switch -- $command {
2667        list {
2668            if {[catch {set versions [glob -directory $conf_path *]}]} {
2669                return -code error [concat "No configurations associated " \
2670                                           "with '$group' were found."]
2671            }
2672
2673            # Return the sorted list of versions (excluding base and current).
2674            set lversions {}
2675            foreach v $versions {
2676                # Only the file name corresponds to the version name.
2677                set v [file tail $v]
2678                if {$v eq "base" || $v eq "current"} {
2679                    continue
2680                }
2681                lappend lversions [file tail $v]
2682            }
2683            return [lsort $lversions]
2684        }
2685        set {
2686            # Use $conf_path/$version to read in sources.
2687            if {[catch {set src_file [open "$conf_path/$version"]}]} {
2688                return -code error [concat "Verify that the specified " \
2689                                           "version '$version' is valid " \
2690                                           "(i.e., Is it listed when you " \
2691                                           "specify the --list command?)."]
2692            }
2693            set srcs [split [read -nonewline $src_file] "\n"]
2694            close $src_file
2695
2696            # Use $conf_path/base to read in targets.
2697            if {[catch {set tgt_file [open "$conf_path/base"]}]} {
2698                return -code error [concat "The configuration file " \
2699                                           "'$conf_path/base' could not be " \
2700                                           "opened."]
2701            }
2702            set tgts [split [read -nonewline $tgt_file] "\n"]
2703            close $tgt_file
2704
2705            # Iterate through the configuration files executing the specified
2706            # actions.
2707            set i 0
2708            foreach tgt $tgts {
2709                set src [lindex $srcs $i]
2710
2711                switch -glob -- $src {
2712                    - {
2713                        # The source is unavailable for this file.
2714                        set tgt [file join $macports::prefix $tgt]
2715                        file delete $tgt
2716                        ui_debug "rm -f $tgt"
2717                    }
2718                    /* {
2719                        # The source is an absolute path.
2720                        set tgt [file join $macports::prefix $tgt]
2721                        file delete $tgt
2722                        file link -symbolic $tgt $src
2723                        ui_debug "ln -sf $src $tgt"
2724                    }
2725                    default {
2726                        # The source is a relative path.
2727                        set src [file join $macports::prefix $src]
2728                        set tgt [file join $macports::prefix $tgt]
2729                        file delete $tgt
2730                        file link -symbolic $tgt $src
2731                        ui_debug "ln -sf $src $tgt"
2732                    }
2733                }
2734                set i [expr $i+1]
2735            }
2736
2737            # Update the selected version.
2738            set selected_version "$conf_path/current"
2739            if {[file exists $selected_version]} {
2740                file delete $selected_version
2741            }
2742            symlink $version $selected_version
2743            return
2744        }
2745        show {
2746            set selected_version "$conf_path/current"
2747
2748            if {![file exists $selected_version]} {
2749                return "none"
2750            } else {
2751                return [file readlink $selected_version]
2752            }
2753        }
2754    }
2755    return
2756}
Note: See TracBrowser for help on using the repository browser.