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

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

Simplified dir creation

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 100.2 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 51440 2009-05-25 06:58:47Z 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 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 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 can not 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 mp universal options
663    if {![info exists macports::universal_target]} {
664        if {[file exists /Developer/SDKs/MacOSX10.5.sdk]} {
665            set macports::universal_target "10.5"
666        } else {
667            set macports::universal_target "10.4"
668        }
669    }
670    if {![info exists macports::universal_sysroot]} {
671        if {[file exists /Developer/SDKs/MacOSX10.5.sdk]} {
672            set macports::universal_sysroot "/Developer/SDKs/MacOSX10.5.sdk"
673        } else {
674            set macports::universal_sysroot "/Developer/SDKs/MacOSX10.4u.sdk"
675        }
676    }
677    if {![info exists macports::universal_archs]} {
678        set macports::universal_archs {ppc i386}
679    }
680
681    # ENV cleanup.
682    set keepenvkeys {
683        DISPLAY DYLD_FALLBACK_FRAMEWORK_PATH
684        DYLD_FALLBACK_LIBRARY_PATH DYLD_FRAMEWORK_PATH
685        DYLD_LIBRARY_PATH DYLD_INSERT_LIBRARIES
686        HOME JAVA_HOME MASTER_SITE_LOCAL
687        PATCH_SITE_LOCAL PATH PORTSRC RSYNC_PROXY TMP TMPDIR
688        USER GROUP
689        http_proxy HTTPS_PROXY FTP_PROXY ALL_PROXY NO_PROXY
690        COLUMNS LINES
691    }
692    if {[info exists extra_env]} {
693        set keepenvkeys [concat ${keepenvkeys} ${extra_env}]
694    }
695
696    foreach envkey [array names env] {
697        if {[lsearch $keepenvkeys $envkey] == -1} {
698            array unset env $envkey
699        }
700    }
701
702    if {![info exists xcodeversion] || ![info exists xcodebuildcmd]} {
703        # We'll resolve these later (if needed)
704        trace add variable macports::xcodeversion read macports::setxcodeinfo
705        trace add variable macports::xcodebuildcmd read macports::setxcodeinfo
706    }
707
708    # Set the default umask
709    if {![info exists destroot_umask]} {
710        set destroot_umask 022
711    }
712
713    if {[info exists master_site_local] && ![info exists env(MASTER_SITE_LOCAL)]} {
714        set env(MASTER_SITE_LOCAL) "$master_site_local"
715    }
716
717    if {[file isdirectory $libpath]} {
718        lappend auto_path $libpath
719        set macports::auto_path $auto_path
720
721        # XXX: not sure if this the best place, but it needs to happen
722        # early, and after auto_path has been set.  Or maybe Pextlib
723        # should ship with macports1.0 API?
724        package require Pextlib 1.0
725        package require registry 1.0
726    } else {
727        return -code error "Library directory '$libpath' must exist"
728    }
729
730    # unset environment an extra time, to work around bugs in Leopard Tcl
731    foreach envkey [array names env] {
732        if {[lsearch $keepenvkeys $envkey] == -1} {
733            unsetenv $envkey
734        }
735    }
736
737    # Proxy handling (done this late since Pextlib is needed)
738    if {![info exists proxy_override_env] } {
739        set proxy_override_env "no"
740    }
741    array set sysConfProxies [get_systemconfiguration_proxies]
742    if {![info exists env(http_proxy)] || $proxy_override_env == "yes" } {
743        if {[info exists proxy_http]} {
744            set env(http_proxy) $proxy_http
745        } elseif {[info exists sysConfProxies(proxy_http)]} {
746            set env(http_proxy) $sysConfProxies(proxy_http)
747        }
748    }
749    if {![info exists env(HTTPS_PROXY)] || $proxy_override_env == "yes" } {
750        if {[info exists proxy_https]} {
751            set env(HTTPS_PROXY) $proxy_https
752        } elseif {[info exists sysConfProxies(proxy_https)]} {
753            set env(HTTPS_PROXY) $sysConfProxies(proxy_https)
754        }
755    }
756    if {![info exists env(FTP_PROXY)] || $proxy_override_env == "yes" } {
757        if {[info exists proxy_ftp]} {
758            set env(FTP_PROXY) $proxy_ftp
759        } elseif {[info exists sysConfProxies(proxy_ftp)]} {
760            set env(FTP_PROXY) $sysConfProxies(proxy_ftp)
761        }
762    }
763    if {![info exists env(RSYNC_PROXY)] || $proxy_override_env == "yes" } {
764        if {[info exists proxy_rsync]} {
765            set env(RSYNC_PROXY) $proxy_rsync
766        }
767    }
768    if {![info exists env(NO_PROXY)] || $proxy_override_env == "yes" } {
769        if {[info exists proxy_skip]} {
770            set env(NO_PROXY) $proxy_skip
771        } elseif {[info exists sysConfProxies(proxy_skip)]} {
772            set env(NO_PROXY) $sysConfProxies(proxy_skip)
773        }
774    }
775
776    # load the quick index
777    _mports_load_quickindex
778}
779
780proc macports::worker_init {workername portpath porturl portbuildpath options variations} {
781    global macports::portinterp_options macports::portinterp_deferred_options registry.installtype
782
783    # Hide any Tcl commands that should be inaccessible to port1.0 and Portfiles
784    # exit: It should not be possible to exit the interpreter
785    interp hide $workername exit
786
787    # cd: This is necessary for some code in port1.0, but should be hidden
788    interp eval $workername "rename cd _cd"
789
790    # Tell the sub interpreter about all the Tcl packages we already
791    # know about so it won't glob for packages.
792    foreach pkgName [package names] {
793        foreach pkgVers [package versions $pkgName] {
794            set pkgLoadScript [package ifneeded $pkgName $pkgVers]
795            $workername eval "package ifneeded $pkgName $pkgVers {$pkgLoadScript}"
796        }
797    }
798
799    # Create package require abstraction procedure
800    $workername eval "proc PortSystem \{version\} \{ \n\
801            package require port \$version \}"
802
803    # Clearly separate slave interpreters and the master interpreter.
804    $workername alias mport_exec mportexec
805    $workername alias mport_open mportopen
806    $workername alias mport_close mportclose
807    $workername alias mport_lookup mportlookup
808
809    # instantiate the UI call-backs
810    foreach priority ${macports::ui_priorities} {
811        $workername alias ui_$priority ui_$priority
812    }
813    $workername alias ui_prefix ui_prefix
814    $workername alias ui_channels ui_channels
815
816    # Export some utility functions defined here.
817    $workername alias macports_create_thread macports::create_thread
818    $workername alias getportworkpath_from_buildpath macports::getportworkpath_from_buildpath
819    $workername alias getportresourcepath macports::getportresourcepath
820    $workername alias getdefaultportresourcepath macports::getdefaultportresourcepath
821    $workername alias getprotocol macports::getprotocol
822    $workername alias getportdir macports::getportdir
823
824    # New Registry/Receipts stuff
825    $workername alias registry_new registry::new_entry
826    $workername alias registry_open registry::open_entry
827    $workername alias registry_write registry::write_entry
828    $workername alias registry_prop_store registry::property_store
829    $workername alias registry_prop_retr registry::property_retrieve
830    $workername alias registry_delete registry::delete_entry
831    $workername alias registry_exists registry::entry_exists
832    $workername alias registry_exists_for_name registry::entry_exists_for_name
833    $workername alias registry_activate portimage::activate
834    $workername alias registry_deactivate portimage::deactivate
835    $workername alias registry_register_deps registry::register_dependencies
836    $workername alias registry_fileinfo_for_index registry::fileinfo_for_index
837    $workername alias registry_bulk_register_files registry::register_bulk_files
838    $workername alias registry_installed registry::installed
839    $workername alias registry_active registry::active
840
841    # deferred options processing.
842    $workername alias getoption macports::getoption
843
844    foreach opt $portinterp_options {
845        if {![info exists $opt]} {
846            global macports::$opt
847        }
848        if {[info exists $opt]} {
849            $workername eval set system_options($opt) \{[set $opt]\}
850            $workername eval set $opt \{[set $opt]\}
851        }
852    }
853
854    foreach opt $portinterp_deferred_options {
855        global macports::$opt
856        # define the trace hook.
857        $workername eval \
858            "proc trace_$opt {name1 name2 op} { \n\
859                trace remove variable ::$opt read ::trace_$opt \n\
860                global $opt \n\
861                set $opt \[getoption $opt\] \n\
862            }"
863        # next access will actually define the variable.
864        $workername eval "trace add variable ::$opt read ::trace_$opt"
865        # define some value now
866        $workername eval set $opt "?"
867    }
868
869    foreach {opt val} $options {
870        $workername eval set user_options($opt) $val
871        $workername eval set $opt $val
872    }
873
874    foreach {var val} $variations {
875        $workername eval set variations($var) $val
876    }
877
878    if { [info exists registry.installtype] } {
879        $workername eval set installtype ${registry.installtype}
880    }
881}
882
883# Create a thread with most configuration options set.
884# The newly created thread is sent portinterp_options vars and knows where to
885# find all packages we know.
886proc macports::create_thread {} {
887    package require Thread
888
889    global macports::portinterp_options
890
891    # Create the thread.
892    set result [thread::create -preserved {thread::wait}]
893
894    # Tell the thread about all the Tcl packages we already
895    # know about so it won't glob for packages.
896    foreach pkgName [package names] {
897        foreach pkgVers [package versions $pkgName] {
898            set pkgLoadScript [package ifneeded $pkgName $pkgVers]
899            thread::send -async $result "package ifneeded $pkgName $pkgVers {$pkgLoadScript}"
900        }
901    }
902
903    # inherit configuration variables.
904    thread::send -async $result "namespace eval macports {}"
905    foreach opt $portinterp_options {
906        if {![info exists $opt]} {
907            global macports::$opt
908        }
909        if {[info exists $opt]} {
910            thread::send -async $result "global macports::$opt"
911            set val [set macports::$opt]
912            thread::send -async $result "set macports::$opt \"$val\""
913        }
914    }
915
916    return $result
917}
918
919proc macports::fetch_port {url} {
920    global macports::portdbpath tcl_platform
921    set fetchdir [file join $portdbpath portdirs]
922    set fetchfile [file tail $url]
923    file mkdir $fetchdir
924    if {![file writable $fetchdir]} {
925        return -code error "Port remote fetch failed: You do not have permission to write to $fetchdir"
926    }
927    if {[catch {exec curl -L -s -S -o [file join $fetchdir $fetchfile] $url} result]} {
928        return -code error "Port remote fetch failed: $result"
929    }
930    cd $fetchdir
931    if {[catch {exec tar -zxf $fetchfile} result]} {
932        return -code error "Port extract failed: $result"
933    }
934    if {[regexp {(.+).tgz} $fetchfile match portdir] != 1} {
935        return -code error "Can't decipher portdir from $fetchfile"
936    }
937    return [file join $fetchdir $portdir]
938}
939
940proc macports::getprotocol {url} {
941    if {[regexp {(?x)([^:]+)://.+} $url match protocol] == 1} {
942        return ${protocol}
943    } else {
944        return -code error "Can't parse url $url"
945    }
946}
947
948# XXX: this really needs to be rethought in light of the remote index
949# I've added the destdir parameter.  This is the location a remotely
950# fetched port will be downloaded to (currently only applies to
951# mports:// sources).
952proc macports::getportdir {url {destdir "."}} {
953    if {[regexp {(?x)([^:]+)://(.+)} $url match protocol string] == 1} {
954        switch -regexp -- ${protocol} {
955            {^file$} {
956                return [file normalize $string]
957            }
958            {^mports$} {
959                return [macports::index::fetch_port $url $destdir]
960            }
961            {^https?$|^ftp$} {
962                return [macports::fetch_port $url]
963            }
964            default {
965                return -code error "Unsupported protocol $protocol"
966            }
967        }
968    } else {
969        return -code error "Can't parse url $url"
970    }
971}
972
973##
974# Get the path to the _resources directory of the source
975#
976# If the file is not available in the current source, it will fall back to the
977# default source. This behavior is controlled by the fallback parameter.
978#
979# @param url port url
980# @param path path in _resources we are interested in
981# @param fallback fall back to the default source tree
982# @return path to the _resources directory or the path to the fallback
983proc macports::getportresourcepath {url {path ""} {fallback yes}} {
984    global macports::sources_default
985
986    set protocol [getprotocol $url]
987
988    switch -- ${protocol} {
989        file {
990            set proposedpath [file normalize [file join [getportdir $url] .. ..]]
991        }
992    }
993
994    # append requested path
995    set proposedpath [file join $proposedpath _resources $path]
996
997    if {$fallback == "yes" && ![file exists $proposedpath]} {
998        return [getdefaultportresourcepath $path]
999    }
1000
1001    return $proposedpath
1002}
1003
1004##
1005# Get the path to the _resources directory of the default source
1006#
1007# @param path path in _resources we are interested in
1008# @return path to the _resources directory of the default source
1009proc macports::getdefaultportresourcepath {{path ""}} {
1010    global macports::sources_default
1011
1012    set default_source_url [lindex ${sources_default} 0]
1013    if {[getprotocol $default_source_url] == "file"} {
1014        set proposedpath [getportdir $default_source_url]
1015    } else {
1016        set proposedpath [getsourcepath $default_source_url]
1017    }
1018
1019    # append requested path
1020    set proposedpath [file join $proposedpath _resources $path]
1021
1022    return $proposedpath
1023}
1024
1025# mportopen
1026# Opens a MacPorts portfile specified by a URL.  The Portfile is
1027# opened with the given list of options and variations.  The result
1028# of this function should be treated as an opaque handle to a
1029# MacPorts Portfile.
1030
1031proc mportopen {porturl {options ""} {variations ""} {nocache ""}} {
1032    global macports::portdbpath macports::portconf macports::open_mports auto_path
1033
1034    # Look for an already-open MPort with the same URL.
1035    # XXX: should compare options and variations here too.
1036    # if found, return the existing reference and bump the refcount.
1037    if {$nocache != ""} {
1038        set mport {}
1039    } else {
1040        set mport [dlist_search $macports::open_mports porturl $porturl]
1041    }
1042    if {$mport != {}} {
1043        set refcnt [ditem_key $mport refcnt]
1044        incr refcnt
1045        ditem_key $mport refcnt $refcnt
1046        return $mport
1047    }
1048
1049    array set options_array $options
1050    if {[info exists options_array(portdir)]} {
1051        set portdir $options_array(portdir)
1052    } else {
1053        set portdir ""
1054    }
1055
1056    set portpath [macports::getportdir $porturl $portdir]
1057    ui_debug "Changing to port directory: $portpath"
1058    cd $portpath
1059    if {![file isfile Portfile]} {
1060        return -code error "Could not find Portfile in $portpath"
1061    }
1062
1063    # Iterate through the explicitly set/unset variants, filtering out
1064    # implicit variants. At the moment, the only implicit variants are
1065    # platform variants.
1066    set filteredvariations {}
1067
1068    foreach {variation value} $variations {
1069        switch -regexp $variation {
1070            ^(pure)?darwin         -
1071            ^(free|net|open){1}bsd -
1072            ^i386                  -
1073            ^linux                 -
1074            ^macosx                -
1075            ^powerpc               -
1076            ^solaris               -
1077            ^sunos {
1078                ui_debug "Implicit variants should not be explicitly set or unset. $variation will be ignored."
1079            }
1080            default {
1081                lappend filteredvariations $variation $value
1082            }
1083        }
1084    }
1085
1086    set workername [interp create]
1087
1088    set mport [ditem_create]
1089    lappend macports::open_mports $mport
1090    ditem_key $mport porturl $porturl
1091    ditem_key $mport portpath $portpath
1092    ditem_key $mport workername $workername
1093    ditem_key $mport options $options
1094    ditem_key $mport variations $filteredvariations
1095    ditem_key $mport refcnt 1
1096
1097    macports::worker_init $workername $portpath $porturl [macports::getportbuildpath $portpath] $options $filteredvariations
1098
1099    $workername eval source Portfile
1100
1101    # add the default universal variant, but only if
1102    # it will work and another one isn't already present
1103    if {[$workername eval default_universal_variant_allowed]} {
1104        $workername eval add_default_universal_variant
1105    }
1106
1107    # evaluate the variants
1108    if {[$workername eval eval_variants variations] != 0} {
1109        mportclose $mport
1110        error "Error evaluating variants"
1111    }
1112
1113    ditem_key $mport provides [$workername eval return \$portname]
1114
1115    return $mport
1116}
1117
1118# Traverse a directory with ports, calling a function on the path of ports
1119# (at the second depth).
1120# I.e. the structure of dir shall be:
1121# category/port/
1122# with a Portfile file in category/port/
1123#
1124# func:     function to call on every port directory (it is passed
1125#           category/port/ as its parameter)
1126# root:     the directory with all the categories directories.
1127proc mporttraverse {func {root .}} {
1128    # Save the current directory
1129    set pwd [pwd]
1130
1131    # Join the root.
1132    set pathToRoot [file join $pwd $root]
1133
1134    # Go to root because some callers expects us to be there.
1135    cd $pathToRoot
1136
1137    foreach category [lsort -increasing -unique [readdir $root]] {
1138        set pathToCategory [file join $root $category]
1139        # process the category dirs but not _resources
1140        if {[file isdirectory $pathToCategory] && [string index [file tail $pathToCategory] 0] != "_"} {
1141            # Iterate on port directories.
1142            foreach port [lsort -increasing -unique [readdir $pathToCategory]] {
1143                set pathToPort [file join $pathToCategory $port]
1144                if {[file isdirectory $pathToPort] &&
1145                  [file exists [file join $pathToPort "Portfile"]]} {
1146                    # Call the function.
1147                    $func [file join $category $port]
1148
1149                    # Restore the current directory because some
1150                    # functions changes it.
1151                    cd $pathToRoot
1152                }
1153            }
1154        }
1155    }
1156
1157    # Restore the current directory.
1158    cd $pwd
1159}
1160
1161### _mportsearchpath is private; subject to change without notice
1162
1163# depregex -> regex on the filename to find.
1164# search_path -> directories to search
1165# executable -> whether we want to check that the file is executable by current
1166#               user or not.
1167proc _mportsearchpath {depregex search_path {executable 0}} {
1168    set found 0
1169    foreach path $search_path {
1170        if {![file isdirectory $path]} {
1171            continue
1172        }
1173
1174        if {[catch {set filelist [readdir $path]} result]} {
1175            return -code error "$result ($path)"
1176            set filelist ""
1177        }
1178
1179        foreach filename $filelist {
1180            if {[regexp $depregex $filename] &&
1181              (($executable == 0) || [file executable [file join $path $filename]])} {
1182                ui_debug "Found Dependency: path: $path filename: $filename regex: $depregex"
1183                set found 1
1184                break
1185            }
1186        }
1187    }
1188    return $found
1189}
1190
1191### _libtest is private; subject to change without notice
1192# XXX - Architecture specific
1193# XXX - Rely on information from internal defines in cctools/dyld:
1194# define DEFAULT_FALLBACK_FRAMEWORK_PATH
1195# /Library/Frameworks:/Library/Frameworks:/Network/Library/Frameworks:/System/Library/Frameworks
1196# define DEFAULT_FALLBACK_LIBRARY_PATH /lib:/usr/local/lib:/lib:/usr/lib
1197#   -- Since /usr/local is bad, using /lib:/usr/lib only.
1198# Environment variables DYLD_FRAMEWORK_PATH, DYLD_LIBRARY_PATH,
1199# DYLD_FALLBACK_FRAMEWORK_PATH, and DYLD_FALLBACK_LIBRARY_PATH take precedence
1200
1201proc _libtest {mport depspec} {
1202    global env tcl_platform
1203    set depline [lindex [split $depspec :] 1]
1204    set prefix [_mportkey $mport prefix]
1205    set frameworks_dir [_mportkey $mport frameworks_dir]
1206
1207    if {[info exists env(DYLD_FRAMEWORK_PATH)]} {
1208        lappend search_path $env(DYLD_FRAMEWORK_PATH)
1209    } else {
1210        lappend search_path ${frameworks_dir} /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks
1211    }
1212    if {[info exists env(DYLD_FALLBACK_FRAMEWORK_PATH)]} {
1213        lappend search_path $env(DYLD_FALLBACK_FRAMEWORK_PATH)
1214    }
1215    if {[info exists env(DYLD_LIBRARY_PATH)]} {
1216        lappend search_path $env(DYLD_LIBRARY_PATH)
1217    }
1218    lappend search_path /lib /usr/lib ${prefix}/lib
1219    if {[info exists env(DYLD_FALLBACK_LIBRARY_PATH)]} {
1220        lappend search_path $env(DYLD_FALLBACK_LIBRARY_PATH)
1221    }
1222
1223    set i [string first . $depline]
1224    if {$i < 0} {set i [string length $depline]}
1225    set depname [string range $depline 0 [expr $i - 1]]
1226    set depversion [string range $depline $i end]
1227    regsub {\.} $depversion {\.} depversion
1228    if {$tcl_platform(os) == "Darwin"} {
1229        set depregex \^${depname}${depversion}\\.dylib\$
1230    } else {
1231        set depregex \^${depname}\\.so${depversion}\$
1232    }
1233
1234    return [_mportsearchpath $depregex $search_path]
1235}
1236
1237### _bintest is private; subject to change without notice
1238
1239proc _bintest {mport depspec} {
1240    global env
1241    set depregex [lindex [split $depspec :] 1]
1242    set prefix [_mportkey $mport prefix]
1243
1244    set search_path [split $env(PATH) :]
1245
1246    set depregex \^$depregex\$
1247
1248    return [_mportsearchpath $depregex $search_path 1]
1249}
1250
1251### _pathtest is private; subject to change without notice
1252
1253proc _pathtest {mport depspec} {
1254    global env
1255    set depregex [lindex [split $depspec :] 1]
1256    set prefix [_mportkey $mport prefix]
1257
1258    # separate directory from regex
1259    set fullname $depregex
1260
1261    regexp {^(.*)/(.*?)$} "$fullname" match search_path depregex
1262
1263    if {[string index $search_path 0] != "/"} {
1264        # Prepend prefix if not an absolute path
1265        set search_path "${prefix}/${search_path}"
1266    }
1267
1268    set depregex \^$depregex\$
1269
1270    return [_mportsearchpath $depregex $search_path]
1271}
1272
1273### _porttest is private; subject to change without notice
1274
1275proc _porttest {mport depspec} {
1276    # We don't actually look for the port, but just return false
1277    # in order to let the mportdepends handle the dependency
1278    return 0
1279}
1280
1281### _mportinstalled is private; may change without notice
1282
1283# Determine if a port is already *installed*, as in "in the registry".
1284proc _mportinstalled {mport} {
1285    # Check for the presence of the port in the registry
1286    set workername [ditem_key $mport workername]
1287    return [$workername eval registry_exists_for_name \${portname}]
1288}
1289
1290# Determine if a port is active (only for image mode)
1291proc _mportactive {mport} {
1292    set workername [ditem_key $mport workername]
1293    if {[catch {set reslist [$workername eval registry_active \${portname}]}]} {
1294        return 0
1295    } else {
1296        return [expr [llength $reslist] > 0]
1297    }
1298}
1299
1300### _mportispresent is private; may change without notice
1301
1302# Determine if some depspec is satisfied or if the given port is installed
1303# (and active, if we're in image mode).
1304# We actually start with the registry (faster?)
1305#
1306# mport     the port to test (to figure out if it's present)
1307# depspec   the dependency test specification (path, bin, lib, etc.)
1308proc _mportispresent {mport depspec} {
1309    ui_debug "Searching for dependency: [ditem_key $mport provides]"
1310    if {[string equal ${macports::registry.installtype} "image"]} {
1311        set res [_mportactive $mport]
1312    } else {
1313        set res [_mportinstalled $mport]
1314    }
1315    if {$res != 0} {
1316        ui_debug "Found Dependency: receipt exists for [ditem_key $mport provides]"
1317        return 1
1318    } else {
1319        # The receipt test failed, use one of the depspec regex mechanisms
1320        ui_debug "Didn't find receipt, going to depspec regex for: [ditem_key $mport provides]"
1321        set type [lindex [split $depspec :] 0]
1322        switch $type {
1323            lib { return [_libtest $mport $depspec] }
1324            bin { return [_bintest $mport $depspec] }
1325            path { return [_pathtest $mport $depspec] }
1326            port { return [_porttest $mport $depspec] }
1327            default {return -code error "unknown depspec type: $type"}
1328        }
1329        return 0
1330    }
1331}
1332
1333### _mportexec is private; may change without notice
1334
1335proc _mportexec {target mport} {
1336    # xxx: set the work path?
1337    set workername [ditem_key $mport workername]
1338    if {![catch {$workername eval check_variants variations $target} result] && $result == 0 &&
1339        ![catch {$workername eval eval_targets $target} result] && $result == 0} {
1340        # If auto-clean mode, clean-up after dependency install
1341        if {[string equal ${macports::portautoclean} "yes"]} {
1342            # Make sure we are back in the port path before clean
1343            # otherwise if the current directory had been changed to
1344            # inside the port,  the next port may fail when trying to
1345            # install because [pwd] will return a "no file or directory"
1346            # error since the directory it was in is now gone.
1347            set portpath [ditem_key $mport portpath]
1348            catch {cd $portpath}
1349            $workername eval eval_targets clean
1350        }
1351        return 0
1352    } else {
1353        # An error occurred.
1354        return 1
1355    }
1356}
1357
1358# mportexec
1359# Execute the specified target of the given mport.
1360proc mportexec {mport target} {
1361    global macports::registry.installtype
1362    set workername [ditem_key $mport workername]
1363    # check variants
1364    if {[$workername eval check_variants variations $target] != 0} {
1365        return 1
1366    }
1367    set portname [_mportkey $mport name]
1368    macports::init_logging $portname
1369    # Before we build the port, we must build its dependencies.
1370    # XXX: need a more general way of comparing against targets
1371    set dlist {}
1372    if {$target == "configure" || $target == "build"
1373        || $target == "test"
1374        || $target == "destroot" || $target == "install"
1375        || $target == "archive"
1376        || $target == "dmg" || $target == "mdmg"
1377        || $target == "pkg" || $target == "mpkg"
1378        || $target == "rpm" || $target == "dpkg"
1379        || $target == "srpm"|| $target == "portpkg" } {
1380
1381        ui_msg -nonewline "--->  Computing dependencies for [_mportkey $mport name]"
1382        if {[macports::ui_isset ports_debug]} {
1383            # play nice with debug messages
1384            ui_msg ""
1385        }
1386        if {[mportdepends $mport $target] != 0} {
1387            return 1
1388        }
1389        ui_msg ""
1390
1391        # Select out the dependents along the critical path,
1392        # but exclude this mport, we might not be installing it.
1393        set dlist [dlist_append_dependents $macports::open_mports $mport {}]
1394
1395        dlist_delete dlist $mport
1396
1397        # install them
1398        # xxx: as with below, this is ugly.  and deps need to be fixed to
1399        # understand Port Images before this can get prettier
1400        if { [string equal ${macports::registry.installtype} "image"] } {
1401            set result [dlist_eval $dlist _mportactive [list _mportexec "activate"]]
1402        } else {
1403            set result [dlist_eval $dlist _mportinstalled [list _mportexec "install"]]
1404        }
1405
1406        if {$result != {}} {
1407            set errstring "The following dependencies failed to build:"
1408            foreach ditem $result {
1409                append errstring " [ditem_key $ditem provides]"
1410            }
1411            ui_error $errstring
1412            return 1
1413        }
1414
1415        # Close the dependencies, we're done installing them.
1416        foreach ditem $dlist {
1417            mportclose $ditem
1418        }
1419    }
1420
1421    # If we're doing an install, check if we should clean after
1422    set clean 0
1423    if {[string equal ${macports::portautoclean} "yes"] && [string equal $target "install"] } {
1424        set clean 1
1425    }
1426
1427    # If we're doing image installs, then we should activate after install
1428    # xxx: This isn't pretty
1429    if { [string equal ${macports::registry.installtype} "image"] && [string equal $target "install"] } {
1430        set target activate
1431    }
1432
1433    # Build this port with the specified target
1434    set result [$workername eval eval_targets $target]
1435
1436    # If auto-clean mode and successful install, clean-up after install
1437    if {$result == 0 && $clean == 1} {
1438        # Make sure we are back in the port path, just in case
1439        set portpath [ditem_key $mport portpath]
1440        catch {cd $portpath}
1441        $workername eval eval_targets clean
1442    }
1443
1444    return $result
1445}
1446
1447proc macports::getsourcepath {url} {
1448    global macports::portdbpath
1449
1450    set source_path [split $url ://]
1451
1452    if {[_source_is_snapshot $url]} {
1453        # daily snapshot tarball
1454        return [file join $portdbpath sources [join [lrange $source_path 3 end-1] /] ports]
1455    }
1456
1457    return [file join $portdbpath sources [lindex $source_path 3] [lindex $source_path 4] [lindex $source_path 5]]
1458}
1459
1460##
1461# Checks whether a supplied source URL is for a daily snapshot tarball
1462# (private)
1463#
1464# @param url source URL to check
1465# @return a list containing filename and extension or an empty list
1466proc _source_is_snapshot {url {filename ""} {extension ""}} {
1467    upvar $filename myfilename
1468    upvar $extension myextension
1469
1470    if {[regexp {^(?:https?|ftp)://.+/(.+\.(tar\.gz|tar\.bz2))$} $url -> f e]} {
1471        set myfilename $f
1472        set myextension $e
1473
1474        return 1
1475    }
1476
1477    return 0
1478}
1479
1480proc macports::getportbuildpath {id} {
1481    global macports::portdbpath
1482    regsub {://} $id {.} port_path
1483    regsub -all {/} $port_path {_} port_path
1484    return [file join $portdbpath build $port_path]
1485}
1486
1487proc macports::getportworkpath_from_buildpath {portbuildpath} {
1488    return [file join $portbuildpath work]
1489}
1490
1491proc macports::getportworkpath_from_portdir {portpath} {
1492    return [macports::getportworkpath_from_buildpath [macports::getportbuildpath $portpath]]
1493}
1494
1495proc macports::getindex {source} {
1496    # Special case file:// sources
1497    if {[macports::getprotocol $source] == "file"} {
1498        return [file join [macports::getportdir $source] PortIndex]
1499    }
1500
1501    return [file join [macports::getsourcepath $source] PortIndex]
1502}
1503
1504proc mportsync {{optionslist {}}} {
1505    global macports::sources macports::portdbpath macports::rsync_options tcl_platform
1506    global macports::portverbose
1507    global macports::autoconf::rsync_path
1508    array set options $optionslist
1509
1510    set numfailed 0
1511
1512    ui_debug "Synchronizing ports tree(s)"
1513    foreach source $sources {
1514        set flags [lrange $source 1 end]
1515        set source [lindex $source 0]
1516        if {[lsearch -exact $flags nosync] != -1} {
1517            ui_debug "Skipping $source"
1518            continue
1519        }
1520        ui_info "Synchronizing local ports tree from $source"
1521        switch -regexp -- [macports::getprotocol $source] {
1522            {^file$} {
1523                set portdir [macports::getportdir $source]
1524                if {[file exists $portdir/.svn]} {
1525                    set svn_commandline "[macports::findBinary svn] update --non-interactive ${portdir}"
1526                    ui_debug $svn_commandline
1527                    if {
1528                        [catch {
1529                            set euid [geteuid]
1530                            set egid [getegid]
1531                            ui_debug "changing euid/egid - current euid: $euid - current egid: $egid"
1532                            setegid [name_to_gid [file attributes $portdir -group]]
1533                            seteuid [name_to_uid [file attributes $portdir -owner]]
1534                            system $svn_commandline
1535                            seteuid $euid
1536                            setegid $egid
1537                        }]
1538                    } {
1539                        ui_debug "$::errorInfo"
1540                        ui_error "Synchronization of the local ports tree failed doing an svn update"
1541                        incr numfailed
1542                        continue
1543                    }
1544                }
1545            }
1546            {^mports$} {
1547                macports::index::sync $macports::portdbpath $source
1548            }
1549            {^rsync$} {
1550                # Where to, boss?
1551                set destdir [file dirname [macports::getindex $source]]
1552                file mkdir $destdir
1553                # Keep rsync happy with a trailing slash
1554                if {[string index $source end] != "/"} {
1555                    set source "${source}/"
1556                }
1557                # Do rsync fetch
1558                set rsync_commandline "${macports::autoconf::rsync_path} ${rsync_options} ${source} ${destdir}"
1559                ui_debug $rsync_commandline
1560                if {[catch {system $rsync_commandline}]} {
1561                    ui_error "Synchronization of the local ports tree failed doing rsync"
1562                    incr numfailed
1563                    continue
1564                }
1565                if {[catch {system "chmod -R a+r \"$destdir\""}]} {
1566                    ui_warn "Setting world read permissions on parts of the ports tree failed, need root?"
1567                }
1568            }
1569            {^https?$|^ftp$} {
1570                if {[_source_is_snapshot $source filename extension]} {
1571                    # sync a daily port snapshot tarball
1572                    set indexfile [macports::getindex $source]
1573                    set destdir [file dirname $indexfile]
1574                    set tarpath [file join [file normalize [file join $destdir ..]] $filename]
1575
1576                    set updated 1
1577                    if {[file isdirectory $destdir]} {
1578                        set moddate [file mtime $destdir]
1579                        if {[catch {set updated [curl isnewer $source $moddate]} error]} {
1580                            ui_warn "Cannot check if $source was updated, ($error)"
1581                        }
1582                    }
1583
1584                    if {(![info exists options(ports_force)] || $options(ports_force) != "yes") && $updated <= 0} {
1585                        ui_info "No updates for $source"
1586                        continue
1587                    }
1588
1589                    file mkdir [file dirname $indexfile]
1590
1591                    set verboseflag {}
1592                    if {$macports::portverbose == "yes"} {
1593                        set verboseflag "-v"
1594                    }
1595
1596                    if {[catch {eval curl fetch $verboseflag {$source} {$tarpath}} error]} {
1597                        ui_error "Fetching $source failed ($error)"
1598                        incr numfailed
1599                        continue
1600                    }
1601
1602                    set extflag {}
1603                    switch $extension {
1604                        {tar.gz} {
1605                            set extflag "-z"
1606                        }
1607                        {tar.bz2} {
1608                            set extflag "-j"
1609                        }
1610                    }
1611
1612                    if { [catch { system "cd $destdir/.. && tar ${verboseflag} ${extflag} -xf $filename" } error] } {
1613                        ui_error "Extracting $source failed ($error)"
1614                        incr numfailed
1615                        continue
1616                    }
1617
1618                    if {[catch {system "chmod -R a+r \"$destdir\""}]} {
1619                        ui_warn "Setting world read permissions on parts of the ports tree failed, need root?"
1620                    }
1621
1622                    file delete $tarpath
1623                } else {
1624                    # sync just a PortIndex file
1625                    set indexfile [macports::getindex $source]
1626                    file mkdir [file dirname $indexfile]
1627                    exec curl -L -s -S -o $indexfile $source/PortIndex
1628                }
1629            }
1630            default {
1631                ui_warn "Unknown synchronization protocol for $source"
1632            }
1633        }
1634    }
1635
1636    if {$numfailed > 0} {
1637        return -code error "Synchronization of $numfailed source(s) failed"
1638    }
1639}
1640
1641proc mportsearch {pattern {case_sensitive yes} {matchstyle regexp} {field name}} {
1642    global macports::portdbpath macports::sources
1643    set matches [list]
1644    set easy [expr { $field == "name" }]
1645
1646    set found 0
1647    foreach source $sources {
1648        set flags [lrange $source 1 end]
1649        set source [lindex $source 0]
1650        if {[macports::getprotocol $source] == "mports"} {
1651            array set attrs [list name $pattern]
1652            set res [macports::index::search $macports::portdbpath $source [array get attrs]]
1653            eval lappend matches $res
1654        } else {
1655            if {[catch {set fd [open [macports::getindex $source] r]} result]} {
1656                ui_warn "Can't open index file for source: $source"
1657            } else {
1658                try {
1659                    incr found 1
1660                    while {[gets $fd line] >= 0} {
1661                        array unset portinfo
1662                        set name [lindex $line 0]
1663                        set len [lindex $line 1]
1664                        set line [read $fd $len]
1665
1666                        if {$easy} {
1667                            set target $name
1668                        } else {
1669                            array set portinfo $line
1670                            if {![info exists portinfo($field)]} continue
1671                            set target $portinfo($field)
1672                        }
1673
1674                        switch $matchstyle {
1675                            exact {
1676                                set matchres [expr 0 == ( {$case_sensitive == "yes"} ? [string compare $pattern $target] : [string compare -nocase $pattern $target] )]
1677                            }
1678                            glob {
1679                                set matchres [expr {$case_sensitive == "yes"} ? [string match $pattern $target] : [string match -nocase $pattern $target]]
1680                            }
1681                            regexp -
1682                            default {
1683                                set matchres [expr {$case_sensitive == "yes"} ? [regexp -- $pattern $target] : [regexp -nocase -- $pattern $target]]
1684                            }
1685                        }
1686
1687                        if {$matchres == 1} {
1688                            if {$easy} {
1689                                array set portinfo $line
1690                            }
1691                            switch -regexp -- [macports::getprotocol ${source}] {
1692                                {^rsync$} {
1693                                    # Rsync files are local
1694                                    set source_url "file://[macports::getsourcepath $source]"
1695                                }
1696                                {^https?$|^ftp$} {
1697                                    if {[_source_is_snapshot $source filename extension]} {
1698                                        # daily snapshot tarball
1699                                        set source_url "file://[macports::getsourcepath $source]"
1700                                    } else {
1701                                        # default action
1702                                        set source_url $source
1703                                    }
1704                                }
1705                                default {
1706                                    set source_url $source
1707                                }
1708                            }
1709                            if {[info exists portinfo(portarchive)]} {
1710                                set porturl ${source_url}/$portinfo(portarchive)
1711                            } elseif {[info exists portinfo(portdir)]} {
1712                                set porturl ${source_url}/$portinfo(portdir)
1713                            }
1714                            if {[info exists porturl]} {
1715                                lappend line porturl $porturl
1716                                ui_debug "Found port in $porturl"
1717                            } else {
1718                                ui_debug "Found port info: $line"
1719                            }
1720                            lappend matches $name
1721                            lappend matches $line
1722                        }
1723                    }
1724                } catch {*} {
1725                    ui_warn "It looks like your PortIndex file may be corrupt."
1726                    throw
1727                } finally {
1728                    close $fd
1729                }
1730            }
1731        }
1732    }
1733    if {!$found} {
1734        return -code error "No index(es) found! Have you synced your source indexes?"
1735    }
1736
1737    return $matches
1738}
1739
1740# Returns the PortInfo for a single named port. The info comes from the
1741# PortIndex, and name matching is case-insensitive. Unlike mportsearch, only
1742# the first match is returned, but the return format is otherwise identical.
1743# The advantage is that mportlookup is much faster than mportsearch, due to
1744# the use of the quick index.
1745proc mportlookup {name} {
1746    global macports::portdbpath macports::sources
1747
1748    set sourceno 0
1749    set matches [list]
1750    foreach source $sources {
1751        set source [lindex $source 0]
1752        if {[macports::getprotocol $source] != "mports"} {
1753            global macports::quick_index
1754            if {![info exists quick_index($sourceno,[string tolower $name])]} {
1755                incr sourceno 1
1756                continue
1757            }
1758            # The quick index is keyed on the port name, and provides the
1759            # offset in the main PortIndex where the given port's PortInfo
1760            # line can be found.
1761            set offset $quick_index($sourceno,[string tolower $name])
1762            incr sourceno 1
1763            if {[catch {set fd [open [macports::getindex $source] r]} result]} {
1764                ui_warn "Can't open index file for source: $source"
1765            } else {
1766                try {
1767                    seek $fd $offset
1768                    gets $fd line
1769                    set name [lindex $line 0]
1770                    set len [lindex $line 1]
1771                    set line [read $fd $len]
1772
1773                    array set portinfo $line
1774
1775                    switch -regexp -- [macports::getprotocol ${source}] {
1776                        {^rsync$} {
1777                            # Rsync files are local
1778                            set source_url "file://[macports::getsourcepath $source]"
1779                        }
1780                        {^https?$|^ftp$} {
1781                            if {[_source_is_snapshot $source filename extension]} {
1782                                # daily snapshot tarball
1783                                set source_url "file://[macports::getsourcepath $source]"
1784                             } else {
1785                                # default action
1786                                set source_url $source
1787                             }
1788                        }
1789                        default {
1790                            set source_url $source
1791                        }
1792                    }
1793                    if {[info exists portinfo(portarchive)]} {
1794                        set porturl ${source_url}/$portinfo(portarchive)
1795                    } elseif {[info exists portinfo(portdir)]} {
1796                        set porturl ${source_url}/$portinfo(portdir)
1797                    }
1798                    if {[info exists porturl]} {
1799                        lappend line porturl $porturl
1800                        ui_debug "Found port in $porturl"
1801                    } else {
1802                        ui_debug "Found port info: $line"
1803                    }
1804                    lappend matches $name
1805                    lappend matches $line
1806                    close $fd
1807                    break
1808                } catch {*} {
1809                    ui_warn "It looks like your PortIndex file may be corrupt."
1810                    throw
1811                } finally {
1812                    catch {close $fd}
1813                }
1814            }
1815        } else {
1816            array set attrs [list name $name]
1817            set res [macports::index::search $macports::portdbpath $source [array get attrs]]
1818            if {[llength $res] > 0} {
1819                eval lappend matches $res
1820                break
1821            }
1822        }
1823    }
1824
1825    return $matches
1826}
1827
1828# Loads PortIndex.quick from each source into the quick_index, generating
1829# it first if necessary.
1830proc _mports_load_quickindex {args} {
1831    global macports::sources macports::quick_index
1832
1833    set sourceno 0
1834    foreach source $sources {
1835        unset -nocomplain quicklist
1836        # chop off any tags
1837        set source [lindex $source 0]
1838        set index [macports::getindex $source]
1839        if {![file exists ${index}]} {
1840            continue
1841        }
1842        if {![file exists ${index}.quick] || [file mtime ${index}] > [file mtime ${index}.quick]} {
1843            # stale or nonexistent quick index file, so generate a new one
1844            if {[catch {set quicklist [mports_generate_quickindex ${index}]}]} {
1845                continue
1846            }
1847        }
1848        # only need to read the quick index file if we didn't just update it
1849        if {![info exists quicklist]} {
1850            if {[catch {set fd [open ${index}.quick r]} result]} {
1851                ui_warn "Can't open quick index file for source: $source"
1852                continue
1853            } else {
1854                set quicklist [read $fd]
1855                close $fd
1856            }
1857        }
1858        foreach entry [split $quicklist "\n"] {
1859            set quick_index($sourceno,[lindex $entry 0]) [lindex $entry 1]
1860        }
1861        incr sourceno 1
1862    }
1863    if {!$sourceno} {
1864        ui_warn "No index(es) found! Have you synced your source indexes?"
1865    }
1866}
1867
1868proc mports_generate_quickindex {index} {
1869    if {[catch {set indexfd [open ${index} r]} result] || [catch {set quickfd [open ${index}.quick w]} result]} {
1870        ui_warn "Can't open index file: $index"
1871        return -code error
1872    } else {
1873        try {
1874            set offset [tell $indexfd]
1875            set quicklist ""
1876            while {[gets $indexfd line] >= 0} {
1877                if {[llength $line] != 2} {
1878                    continue
1879                }
1880                set name [lindex $line 0]
1881                append quicklist "[string tolower $name] ${offset}\n"
1882
1883                set len [lindex $line 1]
1884                read $indexfd $len
1885                set offset [tell $indexfd]
1886            }
1887            puts -nonewline $quickfd $quicklist
1888        } catch {*} {
1889            ui_warn "It looks like your PortIndex file may be corrupt."
1890            throw
1891        } finally {
1892            close $indexfd
1893            close $quickfd
1894        }
1895    }
1896    if {[info exists quicklist]} {
1897        return $quicklist
1898    } else {
1899        ui_warn "Failed to generate quick index for: $index"
1900        return -code error
1901    }
1902}
1903
1904proc mportinfo {mport} {
1905    set workername [ditem_key $mport workername]
1906    return [$workername eval array get PortInfo]
1907}
1908
1909proc mportclose {mport} {
1910    global macports::open_mports
1911    set refcnt [ditem_key $mport refcnt]
1912    incr refcnt -1
1913    ditem_key $mport refcnt $refcnt
1914    if {$refcnt == 0} {
1915        dlist_delete macports::open_mports $mport
1916        set workername [ditem_key $mport workername]
1917        interp delete $workername
1918        ditem_delete $mport
1919    }
1920}
1921
1922##### Private Depspec API #####
1923# This API should be considered work in progress and subject to change without notice.
1924##### "
1925
1926# _mportkey
1927# - returns a variable from the port's interpreter
1928
1929proc _mportkey {mport key} {
1930    set workername [ditem_key $mport workername]
1931    return [$workername eval "return \$${key}"]
1932}
1933
1934# mportdepends builds the list of mports which the given port depends on.
1935# This list is added to $mport.
1936# This list actually depends on the target.
1937# This method can optionally recurse through the dependencies, looking for
1938#   dependencies of dependencies.
1939# This method can optionally cut the search when ports are already installed or
1940#   the dependencies are satisfied.
1941#
1942# mport -> mport item
1943# target -> target to consider the dependency for
1944# recurseDeps -> if the search should be recursive
1945# skipSatisfied -> cut the search tree when encountering installed/satisfied
1946#                  dependencies ports.
1947# accDeps -> accumulator for recursive calls
1948# return 0 if everything was ok, an non zero integer otherwise.
1949proc mportdepends {mport {target ""} {recurseDeps 1} {skipSatisfied 1} {accDepsFlag 0}} {
1950
1951    array set portinfo [mportinfo $mport]
1952    set depends {}
1953    set deptypes {}
1954    if {$accDepsFlag == 0} {
1955        array set accDeps {}
1956    } else {
1957        upvar accDeps accDeps
1958    }
1959
1960    # progress indicator
1961    if {![macports::ui_isset ports_debug]} {
1962        ui_info -nonewline "."
1963        flush stdout
1964    }
1965
1966    # Determine deptypes to look for based on target
1967    switch $target {
1968        configure   -
1969        build       { set deptypes "depends_lib depends_build" }
1970
1971        test        -
1972        destroot    -
1973        install     -
1974        archive     -
1975        dmg         -
1976        pkg         -
1977        portpkg     -
1978        mdmg        -
1979        mpkg        -
1980        rpm         -
1981        srpm        -
1982        dpkg        -
1983        ""          { set deptypes "depends_lib depends_build depends_run" }
1984    }
1985
1986    # Gather the dependencies for deptypes
1987    foreach deptype $deptypes {
1988        # Add to the list of dependencies if the option exists and isn't empty.
1989        if {[info exists portinfo($deptype)] && $portinfo($deptype) != ""} {
1990            set depends [concat $depends $portinfo($deptype)]
1991        }
1992    }
1993
1994    set subPorts {}
1995
1996    foreach depspec $depends {
1997        # grab the portname portion of the depspec
1998        set dep_portname [lindex [split $depspec :] end]
1999
2000        # Find the porturl
2001        if {[catch {set res [mportlookup $dep_portname]} error]} {
2002            global errorInfo
2003            ui_debug "$errorInfo"
2004            ui_error "Internal error: port lookup failed: $error"
2005            return 1
2006        }
2007
2008        array unset portinfo
2009        array set portinfo [lindex $res 1]
2010        if {[info exists portinfo(porturl)]} {
2011            set porturl $portinfo(porturl)
2012        } else {
2013            ui_error "Dependency '$dep_portname' not found."
2014            return 1
2015        }
2016
2017        set options [ditem_key $mport options]
2018        set variations [ditem_key $mport variations]
2019
2020        # Figure out the subport.
2021        set subport [mportopen $porturl $options $variations]
2022
2023        # Is that dependency satisfied or this port installed?
2024        # If we don't skip or if it is not, add it to the list.
2025        if {!$skipSatisfied || ![_mportispresent $subport $depspec]} {
2026            # Append the sub-port's provides to the port's requirements list.
2027            ditem_append_unique $mport requires "[ditem_key $subport provides]"
2028
2029            if {$recurseDeps} {
2030                # Skip the port if it's already in the accumulated list.
2031                if {![info exists accDeps($dep_portname)]} {
2032                    # Add it to the list
2033                    set accDeps($dep_portname) 1
2034
2035                    # We'll recursively iterate on it.
2036                    lappend subPorts $subport
2037                }
2038            }
2039        }
2040    }
2041
2042    # Loop on the subports.
2043    if {$recurseDeps} {
2044        foreach subport $subPorts {
2045            # Sub ports should be installed (all dependencies must be satisfied).
2046            set res [mportdepends $subport "" $recurseDeps $skipSatisfied 1]
2047            if {$res != 0} {
2048                return $res
2049            }
2050        }
2051    }
2052
2053    return 0
2054}
2055
2056# selfupdate procedure
2057proc macports::selfupdate {{optionslist {}}} {
2058    global macports::prefix macports::portdbpath macports::libpath macports::rsync_server macports::rsync_dir macports::rsync_options
2059    global macports::autoconf::macports_version macports::autoconf::rsync_path
2060    array set options $optionslist
2061
2062    # syncing ports tree.
2063    if {![info exists options(ports_selfupdate_nosync)] || $options(ports_selfupdate_nosync) != "yes"} {
2064        ui_msg "--->  Updating the ports tree"
2065        if {[catch {mportsync $optionslist} result]} {
2066            return -code error "Couldn't sync the ports tree: $result"
2067        }
2068    }
2069
2070    # create the path to the to be downloaded sources if it doesn't exist
2071    set mp_source_path [file join $portdbpath sources ${rsync_server} ${rsync_dir}/]
2072    if {![file exists $mp_source_path]} {
2073        file mkdir $mp_source_path
2074    }
2075    ui_debug "MacPorts sources location: $mp_source_path"
2076
2077    # sync the MacPorts sources
2078    ui_msg "--->  Updating MacPorts base sources using rsync"
2079    if { [catch { system "$rsync_path $rsync_options rsync://${rsync_server}/${rsync_dir} $mp_source_path" } result ] } {
2080       return -code error "Error synchronizing MacPorts sources: $result"
2081    }
2082
2083    # echo current MacPorts version
2084    ui_msg "MacPorts base version $macports::autoconf::macports_version installed,"
2085
2086    if { [info exists options(ports_force)] && $options(ports_force) == "yes" } {
2087        set use_the_force_luke yes
2088        ui_debug "Forcing a rebuild and reinstallation of MacPorts"
2089    } else {
2090        set use_the_force_luke no
2091        ui_debug "Rebuilding and reinstalling MacPorts if needed"
2092    }
2093
2094    # Choose what version file to use: old, floating point format or new, real version number format
2095    set version_file [file join $mp_source_path config macports_version]
2096    if {[file exists $version_file]} {
2097        set fd [open $version_file r]
2098        gets $fd macports_version_new
2099        close $fd
2100        # echo downloaded MacPorts version
2101        ui_msg "MacPorts base version $macports_version_new downloaded."
2102    } else {
2103        ui_warn "No version file found, please rerun selfupdate."
2104        set macports_version_new 0
2105    }
2106
2107    # check if we we need to rebuild base
2108    set comp [rpm-vercomp $macports_version_new $macports::autoconf::macports_version]
2109    if {$use_the_force_luke == "yes" || $comp > 0} {
2110        if {[info exists options(ports_dryrun)] && $options(ports_dryrun) == "yes"} {
2111            ui_msg "--->  MacPorts base is outdated, selfupdate would install $macports_version_new (dry run)"
2112        } else {
2113            ui_msg "--->  MacPorts base is outdated, installing new version $macports_version_new"
2114
2115            # get installation user/group and permissions
2116            set owner [file attributes ${prefix} -owner]
2117            set group [file attributes ${prefix} -group]
2118            set perms [string range [file attributes ${prefix} -permissions] end-3 end]
2119            set installing_user [exec /usr/bin/id -un]
2120            if {![string equal $installing_user $owner]} {
2121                return -code error "User $installing_user does not own ${prefix} - try using sudo"
2122            }
2123            ui_debug "Permissions OK"
2124
2125            # where to install our macports1.0 tcl package
2126            set mp_tclpackage_path [file join $portdbpath .tclpackage]
2127            if { [file exists $mp_tclpackage_path]} {
2128                set fd [open $mp_tclpackage_path r]
2129                gets $fd tclpackage
2130                close $fd
2131            } else {
2132                set tclpackage $libpath
2133            }
2134
2135            set configure_args "--prefix=$prefix --with-tclpackage=$tclpackage --with-install-user=$owner --with-install-group=$group --with-directory-mode=$perms"
2136            # too many users have an incompatible readline in /usr/local, see ticket #10651
2137            if {$tcl_platform(os) != "Darwin" || $prefix == "/usr/local"
2138                || ([glob -nocomplain "/usr/local/lib/lib{readline,history}*"] == "" && [glob -nocomplain "/usr/local/include/readline/*.h"] == "")} {
2139                append configure_args " --enable-readline"
2140            } else {
2141                ui_warn "Disabling readline support due to readline in /usr/local"
2142            }
2143
2144            # do the actual configure, build and installation of new base
2145            ui_msg "Installing new MacPorts release in $prefix as $owner:$group; permissions $perms; Tcl-Package in $tclpackage\n"
2146            if { [catch { system "cd $mp_source_path && ./configure $configure_args && make && make install" } result] } {
2147                return -code error "Error installing new MacPorts base: $result"
2148            }
2149        }
2150    } elseif {$comp < 0} {
2151        ui_msg "--->  MacPorts base is probably trunk or a release candidate"
2152    } else {
2153        ui_msg "--->  MacPorts base is already the latest version"
2154    }
2155
2156    # set the MacPorts sources to the right owner
2157    set sources_owner [file attributes [file join $portdbpath sources/] -owner]
2158    ui_debug "Setting MacPorts sources ownership to $sources_owner"
2159    if { [catch { exec chown -R $sources_owner [file join $portdbpath sources/] } result] } {
2160        return -code error "Couldn't change permissions of the MacPorts sources at $mp_source_path to $sources_owner: $result"
2161    }
2162
2163    if {![info exists options(ports_selfupdate_nosync)] || $options(ports_selfupdate_nosync) != "yes"} {
2164        ui_msg "\nThe ports tree has been updated. To upgrade your installed ports, you should run"
2165        ui_msg "  port upgrade outdated"
2166    }
2167
2168    return 0
2169}
2170
2171# upgrade procedure
2172proc macports::upgrade {portname dspec globalvarlist variationslist optionslist {depscachename ""}} {
2173    global macports::registry.installtype
2174    global macports::portarchivemode
2175    array set options $optionslist
2176
2177    # Note $variationslist is left alone and so retains the original
2178    # requested variations, which should be passed to recursive calls to
2179    # upgrade; while variations gets existing variants and global variations
2180    # merged in later on, so it applies only to this port's upgrade
2181    array set variations $variationslist
2182
2183    if {![string match "" $depscachename]} {
2184        upvar $depscachename depscache
2185    }
2186
2187    # Is this a dry run?
2188    set is_dryrun no
2189    if {[info exists options(ports_dryrun)] && $options(ports_dryrun) eq "yes"} {
2190        set is_dryrun yes
2191    }
2192
2193    # check if the port is in tree
2194    if {[catch {mportlookup $portname} result]} {
2195        global errorInfo
2196        ui_debug "$errorInfo"
2197        ui_error "port lookup failed: $result"
2198        return 1
2199    }
2200    # argh! port doesnt exist!
2201    if {$result == ""} {
2202        ui_error "No port $portname found."
2203        return 1
2204    }
2205    # fill array with information
2206    array set portinfo [lindex $result 1]
2207    # set portname again since the one we were passed may not have had the correct case
2208    set portname $portinfo(name)
2209
2210    # set version_in_tree and revision_in_tree
2211    if {![info exists portinfo(version)]} {
2212        ui_error "Invalid port entry for $portname, missing version"
2213        return 1
2214    }
2215    set version_in_tree "$portinfo(version)"
2216    set revision_in_tree "$portinfo(revision)"
2217    set epoch_in_tree "$portinfo(epoch)"
2218
2219    set ilist {}
2220    if { [catch {set ilist [registry::installed $portname ""]} result] } {
2221        if {$result == "Registry error: $portname not registered as installed." } {
2222            ui_debug "$portname is *not* installed by MacPorts"
2223            # open porthandle
2224            set porturl $portinfo(porturl)
2225            if {![info exists porturl]} {
2226                set porturl file://./
2227            }
2228            # Merge the global variations into the specified
2229            foreach { variation value } $globalvarlist {
2230                if { ![info exists variations($variation)] } {
2231                    set variations($variation) $value
2232                }
2233            }
2234
2235            if {[catch {set workername [mportopen $porturl [array get options] [array get variations]]} result]} {
2236                    global errorInfo
2237                    ui_debug "$errorInfo"
2238                    ui_error "Unable to open port: $result"
2239                    return 1
2240            }
2241            # While we're at it, update the portinfo
2242            array unset portinfo
2243            array set portinfo [mportinfo $workername]
2244
2245            if {![_mportispresent $workername $dspec ] } {
2246                # upgrade its dependencies first
2247                _upgrade_dependencies portinfo depscache globalvarlist variationslist options
2248                # now install it
2249                if {[catch {set result [mportexec $workername install]} result]} {
2250                    global errorInfo
2251                    ui_debug "$errorInfo"
2252                    ui_error "Unable to exec port: $result"
2253                    catch {mportclose $workername}
2254                    return 1
2255                }
2256                if {$result > 0} {
2257                    ui_error "Problem while installing $portname"
2258                    catch {mportclose $workername}
2259                    return $result
2260                }
2261                # we just installed it, so mark it done in the cache
2262                # and update ilist
2263                set depscache(port:${portname}) 1
2264            } else {
2265                # dependency is satisfied by something other than the named port
2266                ui_debug "$portname not installed, soft dependency satisfied"
2267                # mark this depspec as satisfied in the cache
2268                set depscache($dspec) 1
2269            }
2270            # the rest of the proc doesn't matter for a port that is freshly
2271            # installed or not installed
2272            mportclose $workername
2273            return 0
2274        } else {
2275            ui_error "Checking installed version failed: $result"
2276            exit 1
2277        }
2278    } else {
2279        # we'll now take care of upgrading it, so we can add it to the cache
2280        set depscache(port:${portname}) 1
2281    }
2282    set anyactive no
2283    set version_installed {}
2284    set revision_installed {}
2285    set epoch_installed 0
2286    set variant_installed ""
2287
2288    # find latest version installed and active version (if any)
2289    foreach i $ilist {
2290        set variant [lindex $i 3]
2291        set version [lindex $i 1]
2292        set revision [lindex $i 2]
2293        set epoch [lindex $i 5]
2294        if { $version_installed == {} || $epoch > $epoch_installed ||
2295                ($epoch == $epoch_installed && [rpm-vercomp $version $version_installed] > 0)
2296                || ($epoch == $epoch_installed
2297                    && [rpm-vercomp $version $version_installed] == 0
2298                    && [rpm-vercomp $revision $revision_installed] > 0)} {
2299            set version_installed $version
2300            set revision_installed $revision
2301            set variant_installed $variant
2302            set epoch_installed $epoch
2303        }
2304
2305        set isactive [lindex $i 4]
2306        if {$isactive == 1} {
2307            set anyactive yes
2308            set version_active $version
2309            set revision_active $revision
2310            set variant_active $variant
2311        }
2312    }
2313
2314    # output version numbers
2315    ui_debug "epoch: in tree: $epoch_in_tree installed: $epoch_installed"
2316    ui_debug "$portname ${version_in_tree}_${revision_in_tree} exists in the ports tree"
2317    ui_debug "$portname ${version_installed}_${revision_installed} $variant_installed is the latest installed"
2318    if {$anyactive} {
2319        ui_debug "$portname ${version_active}_${revision_active} $variant_active is active"
2320    } else {
2321        ui_debug "no version of $portname is active"
2322    }
2323
2324    # save existing variant for later use
2325    if {$anyactive} {
2326        set oldvariant $variant_active
2327    } else {
2328        set oldvariant $variant_installed
2329    }
2330
2331    # Before we do
2332    # dependencies, we need to figure out the final variants,
2333    # open the port, and update the portinfo.
2334
2335    set porturl $portinfo(porturl)
2336    if {![info exists porturl]} {
2337        set porturl file://./
2338    }
2339
2340    # check if the variants is present in $version_in_tree
2341    set variant [split $oldvariant +]
2342    ui_debug "Merging existing variants $variant into variants"
2343    if {[info exists portinfo(variants)]} {
2344        set avariants $portinfo(variants)
2345    } else {
2346        set avariants {}
2347    }
2348    ui_debug "available variants are : $avariants"
2349    foreach v $variant {
2350        if {[lsearch $avariants $v] == -1} {
2351        } else {
2352            ui_debug "variant $v is present in $portname $version_in_tree"
2353            if { ![info exists variations($v)]} {
2354                set variations($v) "+"
2355            }
2356        }
2357    }
2358
2359    # Now merge in the global (i.e. variants.conf) variations.
2360    # We wait until now so that existing variants for this port
2361    # override global variations
2362    foreach { variation value } $globalvarlist {
2363        if { ![info exists variations($variation)] } {
2364            set variations($variation) $value
2365        }
2366    }
2367
2368    ui_debug "new fully merged portvariants: [array get variations]"
2369
2370    if {[catch {set workername [mportopen $porturl [array get options] [array get variations]]} result]} {
2371        global errorInfo
2372        ui_debug "$errorInfo"
2373        ui_error "Unable to open port: $result"
2374        return 1
2375    }
2376
2377    array unset portinfo
2378    array set portinfo [mportinfo $workername]
2379    set portwasopened 1
2380    set version_in_tree "$portinfo(version)"
2381    set revision_in_tree "$portinfo(revision)"
2382    set epoch_in_tree "$portinfo(epoch)"
2383
2384
2385    # first upgrade dependencies
2386    if {![info exists options(ports_nodeps)]} {
2387        _upgrade_dependencies portinfo depscache globalvarlist variationslist options
2388    } else {
2389        ui_debug "Not following dependencies"
2390    }
2391
2392    set epoch_override 0
2393    # check installed version against version in ports
2394    if { ( [rpm-vercomp $version_installed $version_in_tree] > 0
2395            || ([rpm-vercomp $version_installed $version_in_tree] == 0
2396                && [rpm-vercomp $revision_installed $revision_in_tree] >= 0 ))
2397        && ![info exists options(ports_force)] } {
2398        ui_debug "No need to upgrade! $portname ${version_installed}_${revision_installed} >= $portname ${version_in_tree}_${revision_in_tree}"
2399        if {[info exists portinfo(canonical_active_variants)]
2400            && $portinfo(canonical_active_variants) != $oldvariant} {
2401            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."
2402        }
2403        if { $epoch_installed >= $epoch_in_tree } {
2404            # Check if we have to do dependents
2405            if {[info exists options(ports_do_dependents)]} {
2406                # We do dependents ..
2407                set options(ports_nodeps) 1
2408
2409                registry::open_dep_map
2410                set deplist [registry::list_dependents $portname]
2411
2412                if { [llength deplist] > 0 } {
2413                    foreach dep $deplist {
2414                        set mpname [lindex $dep 2]
2415                        if {![llength [array get depscache port:${mpname}]]} {
2416                            macports::upgrade $mpname port:${mpname} $globalvarlist $variationslist [array get options] depscache
2417                        }
2418                    }
2419                }
2420            }
2421            mportclose $workername
2422            return 0
2423        } else {
2424            set epoch_override 1
2425            ui_debug "epoch override ... upgrading!"
2426        }
2427    }
2428
2429
2430    # build or unarchive version_in_tree
2431    if {0 == [string compare "yes" ${macports::portarchivemode}]} {
2432        set upgrade_action "archive"
2433    } else {
2434        set upgrade_action "destroot"
2435    }
2436
2437    # avoid building again unnecessarily
2438    if {[info exists options(ports_force)] || $epoch_override == 1
2439        || ![registry::entry_exists $portname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)]} {
2440        if {[catch {set result [mportexec $workername $upgrade_action]} result] || $result != 0} {
2441            global errorInfo
2442            ui_debug "$errorInfo"
2443            ui_error "Unable to upgrade port: $result"
2444            catch {mportclose $workername}
2445            return 1
2446        }
2447    }
2448
2449    # always uninstall old port in direct mode
2450    if { 0 != [string compare "image" ${macports::registry.installtype}] } {
2451        # uninstall old
2452        ui_debug "Uninstalling $portname ${version_installed}_${revision_installed}${variant_installed}"
2453        # we have to force the uninstall in case of dependents
2454        set force_cur [info exists options(ports_force)]
2455        set options(ports_force) yes
2456        if {$is_dryrun eq "yes"} {
2457            ui_msg "Skipping uninstall $portname @${version_installed}_${revision_installed}${variant_installed} (dry run)"
2458        } elseif {[catch {portuninstall::uninstall $portname ${version_installed}_${revision_installed}${variant_installed} [array get options]} result]} {
2459            global errorInfo
2460            ui_debug "$errorInfo"
2461            ui_error "Uninstall $portname ${version_installed}_${revision_installed}${variant_installed} failed: $result"
2462            catch {mportclose $workername}
2463            return 1
2464        }
2465        if {!$force_cur} {
2466            unset options(ports_force)
2467        }
2468    } else {
2469        # are we installing an existing version due to force or epoch override?
2470        if {[registry::entry_exists $portname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)]} {
2471             ui_debug "Uninstalling $portname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants)"
2472            # we have to force the uninstall in case of dependents
2473            set force_cur [info exists options(ports_force)]
2474            set options(ports_force) yes
2475            if {$is_dryrun eq "yes"} {
2476                ui_msg "Skipping uninstall $portname @${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants) (dry run)"
2477            } elseif {[catch {portuninstall::uninstall $portname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants) [array get options]} result]} {
2478                global errorInfo
2479                ui_debug "$errorInfo"
2480                ui_error "Uninstall $portname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants) failed: $result"
2481                catch {mportclose $workername}
2482                return 1
2483            }
2484            if {!$force_cur} {
2485                unset options(ports_force)
2486            }
2487            if {$anyactive && $version_in_tree == $version_active && $revision_in_tree == $revision_active
2488                && $portinfo(canonical_active_variants) == $variant_active} {
2489                set anyactive no
2490            }
2491        }
2492        if {$anyactive} {
2493            # deactivate version_active
2494            if {$is_dryrun eq "yes"} {
2495                ui_msg "Skipping deactivate $portname @${version_active}_${revision_active} (dry run)"
2496            } elseif {[catch {portimage::deactivate $portname ${version_active}_${revision_active}${variant_active} $optionslist} result]} {
2497                global errorInfo
2498                ui_debug "$errorInfo"
2499                ui_error "Deactivating $portname ${version_active}_${revision_active} failed: $result"
2500                catch {mportclose $workername}
2501                return 1
2502            }
2503        }
2504        if {[info exists options(port_uninstall_old)]} {
2505            # uninstalling now could fail due to dependents when not forced,
2506            # because the new version is not installed
2507            set uninstall_later yes
2508        }
2509    }
2510
2511    if {$is_dryrun eq "yes"} {
2512        ui_msg "Skipping activate $portname @${version_in_tree}_${revision_in_tree} (dry run)"
2513    } elseif {[catch {set result [mportexec $workername install]} result]} {
2514        global errorInfo
2515        ui_debug "$errorInfo"
2516        ui_error "Couldn't activate $portname ${version_in_tree}_${revision_in_tree}: $result"
2517        catch {mportclose $workername}
2518        return 1
2519    }
2520
2521    if {[info exists uninstall_later] && $uninstall_later == yes} {
2522        foreach i $ilist {
2523            set version [lindex $i 1]
2524            set revision [lindex $i 2]
2525            set variant [lindex $i 3]
2526            if {$version == $version_in_tree && $revision == $revision_in_tree && $variant == $portinfo(canonical_active_variants)} {
2527                continue
2528            }
2529            ui_debug "Uninstalling $portname ${version}_${revision}${variant}"
2530            if {$is_dryrun eq "yes"} {
2531                ui_msg "Skipping uninstall $portname @${version}_${revision}${variant} (dry run)"
2532            } elseif {[catch {portuninstall::uninstall $portname ${version}_${revision}${variant} $optionslist} result]} {
2533                global errorInfo
2534                ui_debug "$errorInfo"
2535                ui_error "Uninstall $portname @${version}_${revision}${variant} failed: $result"
2536                catch {mportclose $workername}
2537                return 1
2538            }
2539        }
2540    }
2541
2542    # Check if we have to do dependents
2543    if {[info exists options(ports_do_dependents)]} {
2544        # We do dependents ..
2545        set options(ports_nodeps) 1
2546
2547        registry::open_dep_map
2548        set deplist [registry::list_dependents $portname]
2549
2550        if { [llength deplist] > 0 } {
2551            foreach dep $deplist {
2552                set mpname [lindex $dep 2]
2553                if {![llength [array get depscache port:${mpname}]]} {
2554                    macports::upgrade $mpname port:${mpname} $globalvarlist $variationslist [array get options] depscache
2555                }
2556            }
2557        }
2558    }
2559
2560
2561    # close the port handle
2562    mportclose $workername
2563}
2564
2565# upgrade_dependencies: helper proc for upgrade
2566# Calls upgrade on each dependency listed in the PortInfo.
2567# Uses upvar to access the variables.
2568proc macports::_upgrade_dependencies {portinfoname depscachename globalvarlistname variationslistname optionsname} {
2569    upvar $portinfoname portinfo $depscachename depscache \
2570          $globalvarlistname globalvarlist $variationslistname variationslist \
2571          $optionsname options
2572
2573    # If we're following dependents, we only want to follow this port's
2574    # dependents, not those of all its dependencies. Otherwise, we would
2575    # end up processing this port's dependents n+1 times (recursively!),
2576    # where n is the number of dependencies this port has, since this port
2577    # is of course a dependent of each of its dependencies. Plus the
2578    # dependencies could have any number of unrelated dependents.
2579
2580    # So we save whether we're following dependents, unset the option
2581    # while doing the dependencies, and restore it afterwards.
2582    set saved_do_dependents [info exists options(ports_do_dependents)]
2583    unset -nocomplain options(ports_do_dependents)
2584
2585    # each dep type is upgraded
2586    foreach dtype {depends_build depends_lib depends_run} {
2587        if {[info exists portinfo($dtype)]} {
2588            foreach i $portinfo($dtype) {
2589                set d [lindex [split $i :] end]
2590                if {![llength [array get depscache port:${d}]] && ![llength [array get depscache $i]]} {
2591                    upgrade $d $i $globalvarlist $variationslist [array get options] depscache
2592                }
2593            }
2594        }
2595    }
2596    # restore dependent-following to its former value
2597    if {$saved_do_dependents} {
2598        set options(ports_do_dependents) yes
2599    }
2600}
2601
2602# mportselect
2603#   * command: The only valid commands are list, set and show
2604#   * group: This argument should correspond to a directory under
2605#            $macports::prefix/etc/select.
2606#   * version: This argument is only used by the 'set' command.
2607# On error mportselect returns with the code 'error'.
2608proc mportselect {command group {version ""}} {
2609    ui_debug "mportselect \[$command] \[$group] \[$version]"
2610
2611    set conf_path "$macports::prefix/etc/select/$group"
2612    if {![file isdirectory $conf_path]} {
2613        return -code error "The specified group '$group' does not exist."
2614    }
2615
2616    switch -- $command {
2617        list {
2618            if {[catch {set versions [glob -directory $conf_path *]}]} {
2619                return -code error [concat "No configurations associated " \
2620                                           "with '$group' were found."]
2621            }
2622
2623            # Return the sorted list of versions (excluding base and current).
2624            set lversions {}
2625            foreach v $versions {
2626                # Only the file name corresponds to the version name.
2627                set v [file tail $v]
2628                if {$v eq "base" || $v eq "current"} {
2629                    continue
2630                }
2631                lappend lversions [file tail $v]
2632            }
2633            return [lsort $lversions]
2634        }
2635        set {
2636            # Use $conf_path/$version to read in sources.
2637            if {[catch {set src_file [open "$conf_path/$version"]}]} {
2638                return -code error [concat "Verify that the specified " \
2639                                           "version '$version' is valid " \
2640                                           "(i.e., Is it listed when you " \
2641                                           "specify the --list command?)."]
2642            }
2643            set srcs [split [read -nonewline $src_file] "\n"]
2644            close $src_file
2645
2646            # Use $conf_path/base to read in targets.
2647            if {[catch {set tgt_file [open "$conf_path/base"]}]} {
2648                return -code error [concat "The configuration file " \
2649                                           "'$conf_path/base' could not be " \
2650                                           "opened."]
2651            }
2652            set tgts [split [read -nonewline $tgt_file] "\n"]
2653            close $tgt_file
2654
2655            # Iterate through the configuration files executing the specified
2656            # actions.
2657            set i 0
2658            foreach tgt $tgts {
2659                set src [lindex $srcs $i]
2660
2661                switch -glob -- $src {
2662                    - {
2663                        # The source is unavailable for this file.
2664                        set tgt [file join $macports::prefix $tgt]
2665                        file delete $tgt
2666                        ui_debug "rm -f $tgt"
2667                    }
2668                    /* {
2669                        # The source is an absolute path.
2670                        set tgt [file join $macports::prefix $tgt]
2671                        file delete $tgt
2672                        file link -symbolic $tgt $src
2673                        ui_debug "ln -sf $src $tgt"
2674                    }
2675                    default {
2676                        # The source is a relative path.
2677                        set src [file join $macports::prefix $src]
2678                        set tgt [file join $macports::prefix $tgt]
2679                        file delete $tgt
2680                        file link -symbolic $tgt $src
2681                        ui_debug "ln -sf $src $tgt"
2682                    }
2683                }
2684                set i [expr $i+1]
2685            }
2686
2687            # Update the selected version.
2688            set selected_version "$conf_path/current"
2689            if {[file exists $selected_version]} {
2690                file delete $selected_version
2691            }
2692            symlink $version $selected_version
2693            return
2694        }
2695        show {
2696            set selected_version "$conf_path/current"
2697
2698            if {![file exists $selected_version]} {
2699                return "none"
2700            } else {
2701                return [file readlink $selected_version]
2702            }
2703        }
2704    }
2705    return
2706}
Note: See TracBrowser for help on using the repository browser.