source: branches/variant-descs-14482/base/src/macports1.0/macports.tcl @ 36955

Last change on this file since 36955 was 36955, checked in by raimue@…, 12 years ago

macports1.0/macports.tcl:
Give worker access to getprotocol and getportdir as they are needed for getsourceconfigdir

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 76.0 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 36955 2008-05-21 03:01:11Z raimue@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 x11prefix 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        universal_target universal_sysroot universal_archs"
49    variable user_options "submitter_name submitter_email submitter_key"
50    variable portinterp_options "\
51        portdbpath porturl portpath portbuildpath auto_path prefix prefix_frozen x11prefix portsharepath \
52        registry.path registry.format registry.installtype portarchivemode portarchivepath \
53        portarchivetype portautoclean porttrace portverbose destroot_umask rsync_server \
54        rsync_options rsync_dir startupitem_type place_worksymlink \
55        mp_remote_url mp_remote_submit_url configureccache configuredistcc configurepipe buildnicevalue buildmakejobs \
56        universal_target universal_sysroot universal_archs $user_options"
57   
58    # deferred options are only computed when needed.
59    # they are not exported to the trace thread.
60    # they are not exported to the interpreter in system_options array.
61    variable portinterp_deferred_options "xcodeversion xcodebuildcmd"
62   
63    variable open_mports {}
64   
65    variable ui_priorities "debug info msg error warn"
66}
67
68# Provided UI instantiations
69# For standard messages, the following priorities are defined
70#     debug, info, msg, warn, error
71# Clients of the library are expected to provide ui_prefix and ui_channels with
72# the following prototypes.
73#     proc ui_prefix {priority}
74#     proc ui_channels {priority}
75# ui_prefix returns the prefix for the messages, if any.
76# ui_channels returns a list of channels to output the message to, empty for
77#     no message.
78# if these functions are not provided, defaults are used.
79
80# ui_options accessor
81proc macports::ui_isset {val} {
82    if {[info exists macports::ui_options($val)]} {
83        if {$macports::ui_options($val) == "yes"} {
84            return 1
85        }
86    }
87    return 0
88}
89
90
91# global_options accessor
92proc macports::global_option_isset {val} {
93    if {[info exists macports::global_options($val)]} {
94        if {$macports::global_options($val) == "yes"} {
95            return 1
96        }
97    }
98    return 0
99}
100
101
102proc macports::ui_init {priority message} {
103    # Get the list of channels.
104    try {
105        set channels [ui_channels $priority]
106    } catch * {
107        set channels [ui_channels_default $priority]
108    }
109
110    # Simplify ui_$priority.
111    set nbchans [llength $channels]
112    if {$nbchans == 0} {
113        proc ::ui_$priority {str} {}
114    } else {
115        try {
116            set prefix [ui_prefix $priority]
117        } catch * {
118            set prefix [ui_prefix_default $priority]
119        }
120
121        if {$nbchans == 1} {
122            set chan [lindex $channels 0]
123            proc ::ui_$priority {str} [subst { puts $chan "$prefix\$str" }]
124        } else {
125            proc ::ui_$priority {str} [subst {
126                foreach chan \$channels {
127                    puts $chan "$prefix\$str"
128                }
129            }]
130        }
131
132        # Call ui_$priority
133        ::ui_$priority $message
134    }
135}
136
137# Default implementation of ui_prefix
138proc macports::ui_prefix_default {priority} {
139    switch $priority {
140        debug {
141            return "DEBUG: "
142        }
143        error {
144            return "Error: "
145        }
146        warn {
147            return "Warning: "
148        }
149        default {
150            return ""
151        } 
152    }
153}
154
155# Default implementation of ui_channels:
156# ui_options(ports_debug) - If set, output debugging messages
157# ui_options(ports_verbose) - If set, output info messages (ui_info)
158# ui_options(ports_quiet) - If set, don't output "standard messages"
159proc macports::ui_channels_default {priority} {
160    switch $priority {
161        debug {
162            if {[ui_isset ports_debug]} {
163                return {stderr}
164            } else {
165                return {}
166            }
167        }
168        info {
169            if {[ui_isset ports_verbose]} {
170                return {stdout}
171            } else {
172                return {}
173            }
174        }
175        msg {
176            if {[ui_isset ports_quiet]} {
177                return {}
178            } else {   
179                return {stdout}
180            }
181        }
182        error {
183            return {stderr}
184        }
185        default {
186            return {stdout}
187        }
188    }
189}
190
191foreach priority ${macports::ui_priorities} {
192    proc ui_$priority {str} [subst { macports::ui_init $priority \$str }]
193}
194
195# Replace puts to catch errors (typically broken pipes when being piped to head)
196rename puts tcl::puts
197proc puts {args} {
198    catch "tcl::puts $args"
199}
200
201# find a binary either in a path defined at MacPorts' configuration time
202# or in the PATH environment variable through macports::binaryInPath (fallback)
203proc macports::findBinary {prog {autoconf_hint ""}} {
204    if {${autoconf_hint} != "" && [file executable ${autoconf_hint}]} {
205        return ${autoconf_hint}
206    } else {
207        if {[catch {set cmd_path [macports::binaryInPath ${prog}]} result] == 0} {
208            return ${cmd_path}
209        } else {
210            return -code error "${result} or at its MacPorts configuration time location, did you move it?"
211        }
212    }
213}
214
215# check for a binary in the path
216# returns an error code if it can not be found
217proc macports::binaryInPath {prog} {
218    global env
219    foreach dir [split $env(PATH) :] {
220        if {[file executable [file join $dir $prog]]} {
221            return [file join $dir $prog]
222        }
223    }
224    return -code error [format [msgcat::mc "Failed to locate '%s' in path: '%s'"] $prog $env(PATH)];
225}
226
227# deferred option processing
228proc macports::getoption {name} {
229    global macports::$name
230    return [expr $$name]
231}
232
233# deferred and on-need extraction of xcodeversion and xcodebuildcmd.
234proc macports::setxcodeinfo {name1 name2 op} {
235    global macports::xcodeversion
236    global macports::xcodebuildcmd
237   
238    trace remove variable macports::xcodeversion read macports::setxcodeinfo
239    trace remove variable macports::xcodebuildcmd read macports::setxcodeinfo
240
241    if {[catch {set xcodebuild [binaryInPath "xcodebuild"]}] == 0} {
242        if {![info exists xcodeversion]} {
243            # Determine xcode version (<= 2.0 or 2.1)
244            if {[catch {set xcodebuildversion [exec xcodebuild -version]}] == 0} {
245                if {[regexp "DevToolsCore-(.*); DevToolsSupport-(.*)" $xcodebuildversion devtoolscore_v devtoolssupport_v] == 1} {
246                    if {$devtoolscore_v >= 620.0 && $devtoolssupport_v >= 610.0} {
247                        # for now, we don't need to distinguish 2.1 from 2.1 or higher.
248                        set macports::xcodeversion "2.1"
249                    } else {
250                        set macports::xcodeversion "2.0orlower"
251                    }
252                } else {
253                    set macports::xcodeversion "2.0orlower"
254                }
255            } else {
256                set macports::xcodeversion "2.0orlower"
257            }
258        }
259       
260        if {![info exists xcodebuildcmd]} {
261            set macports::xcodebuildcmd "xcodebuild"
262        }
263    } elseif {[catch {set pbxbuild [binaryInPath "pbxbuild"]}] == 0} {
264        if {![info exists xcodeversion]} {
265            set macports::xcodeversion "pb"
266        }
267        if {![info exists xcodebuildcmd]} {
268            set macports::xcodebuildcmd "pbxbuild"
269        }
270    } else {
271        if {![info exists xcodeversion]} {
272            set macports::xcodeversion "none"
273        }
274        if {![info exists xcodebuildcmd]} {
275            set macports::xcodebuildcmd "none"
276        }
277    }
278}
279
280# dportinit
281# Deprecated version of the new mportinit proc, listed here as backwards
282# compatibility glue for API clients that haven't updated to the new naming
283proc dportinit {{up_ui_options {}} {up_options {}} {up_variations {}}} {
284    ui_warn "The dportinit proc is deprecated and will be going away soon, please use mportinit in the future!"
285    mportinit $up_ui_options $up_options $up_variations
286}
287
288proc mportinit {{up_ui_options {}} {up_options {}} {up_variations {}}} {
289    if {$up_ui_options eq ""} {
290        array set macports::ui_options {}
291    } else {
292        upvar $up_ui_options temp_ui_options
293        array set macports::ui_options [array get temp_ui_options]
294    }
295    if {$up_options eq ""} {
296        array set macports::global_options {}
297    } else {
298        upvar $up_options temp_options
299        array set macports::global_options [array get temp_options]
300    }
301    if {$up_variations eq ""} {
302        array set variations {}
303    } else {
304        upvar $up_variations variations
305    }
306   
307    global auto_path env
308    global macports::autoconf::macports_conf_path
309    global macports::macports_user_dir
310    global macports::bootstrap_options
311    global macports::user_options
312    global macports::extra_env
313    global macports::portconf
314    global macports::portdbpath
315    global macports::portsharepath
316    global macports::registry.format
317    global macports::registry.path
318    global macports::sources
319    global macports::sources_conf
320    global macports::destroot_umask
321    global macports::libpath
322    global macports::prefix
323    global macports::prefix_frozen
324    global macports::x11prefix
325    global macports::registry.installtype
326    global macports::rsync_dir
327    global macports::rsync_options
328    global macports::rsync_server
329    global macports::variants_conf
330    global macports::xcodebuildcmd
331    global macports::xcodeversion
332    global macports::configureccache
333    global macports::configuredistcc
334    global macports::configurepipe
335    global macports::buildnicevalue
336    global macports::buildmakejobs
337    global macports::universal_target
338    global macports::universal_sysroot
339    global macports::universal_archs
340
341    # Set the system encoding to utf-8
342    encoding system utf-8
343
344    # Ensure that the macports user directory exists if HOME is defined
345    if {[info exists env(HOME)]} {
346        set macports::macports_user_dir [file normalize $macports::autoconf::macports_user_dir]
347        if { ![file exists $macports_user_dir] } {
348        # If not, create it with ownership of the enclosing directory, rwx by the user only
349        file mkdir $macports_user_dir
350        file attributes $macports_user_dir -permissions u=rwx,go= \
351            -owner [file attributes $macports_user_dir/.. -owner] \
352            -group [file attributes $macports_user_dir/.. -group]
353        }
354    } else {
355        # Otherwise define the user directory as a direcotory that will never exist
356        set macports::macports_user_dir "/dev/null/NO_HOME_DIR"
357    }
358   
359    # Configure the search path for configuration files
360    set conf_files ""
361    if {[info exists env(PORTSRC)]} {
362        set PORTSRC $env(PORTSRC)
363        lappend conf_files ${PORTSRC}
364    }
365    if { [file isdirectory $macports_user_dir] } {
366        lappend conf_files "${macports_user_dir}/macports.conf"
367    }
368    lappend conf_files "${macports_conf_path}/macports.conf"
369   
370    # Process the first configuration file we find on conf_files list
371    foreach file $conf_files {
372        if [file exists $file] {
373            set portconf $file
374            set fd [open $file r]
375            while {[gets $fd line] >= 0} {
376                if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
377                    if {[lsearch $bootstrap_options $option] >= 0} {
378                        set macports::$option $val
379                        global macports::$option
380                    }
381                }
382            }           
383            break
384        }
385    }
386   
387    # Process per-user only settings
388    set per_user "${macports_user_dir}/user.conf"
389    if [file exists $per_user] {
390        set fd [open $per_user r]
391        while {[gets $fd line] >= 0} {
392            if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
393                if {[lsearch $user_options $option] >= 0} {
394                    set macports::$option $val
395                    global macports::$option
396                }
397            }
398        }
399    }
400   
401    if {![info exists sources_conf]} {
402        return -code error "sources_conf must be set in ${macports_conf_path}/macports.conf or in your ${macports_user_dir}/macports.conf file"
403    }
404    set fd [open $sources_conf r]
405    while {[gets $fd line] >= 0} {
406        set line [string trimright $line]
407        if {![regexp {^\s*#|^$} $line]} {
408            if {[regexp {^([\w-]+://\S+)(?:\s+\[(\w+(?:,\w+)*)\])?$} $line _ url flags]} {
409                set flags [split $flags ,]
410                foreach flag $flags {
411                    if {[lsearch -exact [list nosync] $flag] == -1} {
412                        ui_warn "$sources_conf source '$line' specifies invalid flag '$flag'"
413                    }
414                }
415                lappend sources [concat [list $url] $flags]
416            } else {
417                ui_warn "$sources_conf specifies invalid source '$line', ignored."
418            }
419        }
420    }
421    if {![info exists sources]} {
422        if {[file isdirectory ports]} {
423            set sources "file://[pwd]/ports"
424        } else {
425            return -code error "No sources defined in $sources_conf"
426        }
427    }
428
429    if {[info exists variants_conf]} {
430        if {[file exist $variants_conf]} {
431            set fd [open $variants_conf r]
432            while {[gets $fd line] >= 0} {
433                set line [string trimright $line]
434                if {![regexp {^[\ \t]*#.*$|^$} $line]} {
435                    foreach arg [split $line " \t"] {
436                        if {[regexp {^([-+])([-A-Za-z0-9_+\.]+)$} $arg match sign opt] == 1} {
437                            if {![info exists variations($opt)]} {
438                                set variations($opt) $sign
439                            }
440                        } else {
441                            ui_warn "$variants_conf specifies invalid variant syntax '$arg', ignored."
442                        }
443                    }
444                }
445            }
446        } else {
447            ui_debug "$variants_conf does not exist, variants_conf setting ignored."
448        }
449    }
450
451    if {![info exists portdbpath]} {
452        return -code error "portdbpath must be set in ${macports_conf_path}/macports.conf or in your ${macports_user_dir}/macports.conf"
453    }
454    if {![file isdirectory $portdbpath]} {
455        if {![file exists $portdbpath]} {
456            if {[catch {file mkdir $portdbpath} result]} {
457                return -code error "portdbpath $portdbpath does not exist and could not be created: $result"
458            }
459        }
460    }
461    if {![file isdirectory $portdbpath]} {
462        return -code error "$portdbpath is not a directory. Please create the directory $portdbpath and try again"
463    }
464
465    set registry.path $portdbpath
466    if {![file isdirectory ${registry.path}]} {
467        if {![file exists ${registry.path}]} {
468            if {[catch {file mkdir ${registry.path}} result]} {
469                return -code error "portdbpath ${registry.path} does not exist and could not be created: $result"
470            }
471        }
472    }
473    if {![file isdirectory ${macports::registry.path}]} {
474        return -code error "${macports::registry.path} is not a directory. Please create the directory $portdbpath and try again"
475    }
476
477    # Format for receipts, can currently be either "flat" or "sqlite"
478    if {[info exists portdbformat]} {
479        if { $portdbformat == "sqlite" } {
480            return -code error "SQLite is not yet supported for registry storage."
481        } 
482        set registry.format receipt_${portdbformat}
483    } else {
484        set registry.format receipt_flat
485    }
486
487    # Installation type, whether to use port "images" or install "direct"
488    if {[info exists portinstalltype]} {
489        set registry.installtype $portinstalltype
490    } else {
491        set registry.installtype image
492    }
493   
494    # Autoclean mode, whether to automatically call clean after "install"
495    if {![info exists portautoclean]} {
496        set macports::portautoclean "yes"
497        global macports::portautoclean
498    }
499    # Check command line override for autoclean
500    if {[info exists macports::global_options(ports_autoclean)]} {
501        if {![string equal $macports::global_options(ports_autoclean) $portautoclean]} {
502            set macports::portautoclean $macports::global_options(ports_autoclean)
503        }
504    }
505    # Trace mode, whether to use darwintrace to debug ports.
506    if {![info exists porttrace]} {
507        set macports::porttrace "no"
508        global macports::porttrace
509    }
510    # Check command line override for trace
511    if {[info exists macports::global_options(ports_trace)]} {
512        if {![string equal $macports::global_options(ports_trace) $porttrace]} {
513            set macports::porttrace $macports::global_options(ports_trace)
514        }
515    }
516
517    # Duplicate prefix into prefix_frozen, so that port actions
518    # can always get to the original prefix, even if a portfile overrides prefix
519    set macports::prefix_frozen $prefix
520
521    # Export verbosity.
522    if {![info exists portverbose]} {
523        set macports::portverbose "no"
524        global macports::portverbose
525    }
526    if {[info exists macports::ui_options(ports_verbose)]} {
527        if {![string equal $macports::ui_options(ports_verbose) $portverbose]} {
528            set macports::portverbose $macports::ui_options(ports_verbose)
529        }
530    }
531
532    # Archive mode, whether to create/use binary archive packages
533    if {![info exists portarchivemode]} {
534        set macports::portarchivemode "yes"
535        global macports::portarchivemode
536    }
537
538    # Archive path, where to store/retrieve binary archive packages
539    if {![info exists portarchivepath]} {
540        set macports::portarchivepath [file join $portdbpath packages]
541        global macports::portarchivepath
542    }
543    if {$portarchivemode == "yes"} {
544        if {![file isdirectory $portarchivepath]} {
545            if {![file exists $portarchivepath]} {
546                if {[catch {file mkdir $portarchivepath} result]} {
547                    return -code error "portarchivepath $portarchivepath does not exist and could not be created: $result"
548                }
549            }
550        }
551        if {![file isdirectory $portarchivepath]} {
552            return -code error "$portarchivepath is not a directory. Please create the directory $portarchivepath and try again"
553        }
554    }
555
556    # Archive type, what type of binary archive to use (CPIO, gzipped
557    # CPIO, XAR, etc.)
558    if {![info exists portarchivetype]} {
559        set macports::portarchivetype "cpgz"
560        global macports::portarchivetype
561    }
562    # Convert archive type to a list for multi-archive support, colon or
563    # comma separators indicates to use multiple archive formats
564    # (reading and writing)
565    set macports::portarchivetype [split $portarchivetype {:,}]
566
567    # Set rync options
568    if {![info exists rsync_server]} {
569        set macports::rsync_server rsync.macports.org
570        global macports::rsync_server
571    }
572    if {![info exists rsync_dir]} {
573        set macports::rsync_dir release/base/
574        global macports::rsync_dir
575    }
576    if {![info exists rsync_options]} {
577        set rsync_options "-rtzv --delete-after"
578        global macports::rsync_options
579    }
580
581    set portsharepath ${prefix}/share/macports
582    if {![file isdirectory $portsharepath]} {
583        return -code error "Data files directory '$portsharepath' must exist"
584    }
585   
586    if {![info exists libpath]} {
587        set libpath "${prefix}/share/macports/Tcl"
588    }
589
590    if {![info exists binpath]} {
591        set env(PATH) "${prefix}/bin:${prefix}/sbin:/bin:/sbin:/usr/bin:/usr/sbin:${x11prefix}/bin"
592    } else {
593        set env(PATH) "$binpath"
594    }
595   
596    # Set startupitem default type (can be overridden by portfile)
597    if {![info exists macports::startupitem_type]} {
598        set macports::startupitem_type "default"
599    }
600
601    # Default place_worksymlink
602    if {![info exists macports::place_worksymlink]} {
603        set macports::place_worksymlink yes
604    }
605
606    # Default mp remote options
607    if {![info exists macports::mp_remote_url]} {
608        set macports::mp_remote_url "http://db.macports.org"
609    }
610    if {![info exists macports::mp_remote_submit_url]} {
611        set macports::mp_remote_submit_url "${macports::mp_remote_url}/submit"
612    }
613   
614    # Default mp configure options
615    if {![info exists macports::configureccache]} {
616        set macports::configureccache no
617    }
618    if {![info exists macports::configuredistcc]} {
619        set macports::configuredistcc no
620    }
621    if {![info exists macports::configurepipe]} {
622        set macports::configurepipe no
623    }
624
625    # Default mp build options
626    if {![info exists macports::buildnicevalue]} {
627        set macports::buildnicevalue 0
628    }
629    if {![info exists macports::buildmakejobs]} {
630        set macports::buildmakejobs 1
631    }
632
633    # Default mp universal options
634    if {![info exists macports::universal_target]} {
635        if {[file exists /Developer/SDKs/MacOSX10.5.sdk]} {
636            set macports::universal_target "10.5"
637        } else {
638            set macports::universal_target "10.4"
639        }
640    }
641    if {![info exists macports::universal_sysroot]} {
642        if {[file exists /Developer/SDKs/MacOSX10.5.sdk]} {
643            set macports::universal_sysroot "/Developer/SDKs/MacOSX10.5.sdk"
644        } else {
645            set macports::universal_sysroot "/Developer/SDKs/MacOSX10.4u.sdk"
646        }
647    }
648    if {![info exists macports::universal_archs]} {
649        set macports::universal_archs {ppc i386}
650    }
651   
652    # ENV cleanup.
653    set keepenvkeys {
654        DISPLAY DYLD_FALLBACK_FRAMEWORK_PATH
655        DYLD_FALLBACK_LIBRARY_PATH DYLD_FRAMEWORK_PATH
656        DYLD_LIBRARY_PATH DYLD_INSERT_LIBRARIES
657        HOME JAVA_HOME MASTER_SITE_LOCAL
658        PATCH_SITE_LOCAL PATH PORTSRC RSYNC_PROXY TMP TMPDIR
659        USER GROUP
660        http_proxy HTTPS_PROXY FTP_PROXY ALL_PROXY NO_PROXY
661    }
662    if {[info exists extra_env]} {
663        set keepenvkeys [concat ${keepenvkeys} ${extra_env}]
664    }
665   
666    foreach envkey [array names env] {
667        if {[lsearch $keepenvkeys $envkey] == -1} {
668            array unset env $envkey
669        }
670    }
671
672    if {![info exists xcodeversion] || ![info exists xcodebuildcmd]} {
673        # We'll resolve these later (if needed)
674        trace add variable macports::xcodeversion read macports::setxcodeinfo
675        trace add variable macports::xcodebuildcmd read macports::setxcodeinfo
676    }
677
678    # Set the default umask
679    if {![info exists destroot_umask]} {
680        set destroot_umask 022
681    }
682
683    if {[info exists master_site_local] && ![info exists env(MASTER_SITE_LOCAL)]} {
684        set env(MASTER_SITE_LOCAL) "$master_site_local"
685    }
686
687    if {[file isdirectory $libpath]} {
688        lappend auto_path $libpath
689        set macports::auto_path $auto_path
690
691        # XXX: not sure if this the best place, but it needs to happen
692        # early, and after auto_path has been set.  Or maybe Pextlib
693        # should ship with macports1.0 API?
694        package require Pextlib 1.0
695        package require registry 1.0
696    } else {
697        return -code error "Library directory '$libpath' must exist"
698    }
699}
700
701proc macports::worker_init {workername portpath porturl portbuildpath options variations} {
702    global macports::portinterp_options macports::portinterp_deferred_options registry.installtype
703
704    # Hide any Tcl commands that should be inaccessible to port1.0 and Portfiles
705    # exit: It should not be possible to exit the interpreter
706    interp hide $workername exit
707
708    # cd: This is necessary for some code in port1.0, but should be hidden
709    interp eval $workername "rename cd _cd"
710
711    # Tell the sub interpreter about all the Tcl packages we already
712    # know about so it won't glob for packages.
713    foreach pkgName [package names] {
714        foreach pkgVers [package versions $pkgName] {
715            set pkgLoadScript [package ifneeded $pkgName $pkgVers]
716            $workername eval "package ifneeded $pkgName $pkgVers {$pkgLoadScript}"
717        }
718    }
719
720    # Create package require abstraction procedure
721    $workername eval "proc PortSystem \{version\} \{ \n\
722            package require port \$version \}"
723
724    # Clearly separate slave interpreters and the master interpreter.
725    $workername alias mport_exec mportexec
726    $workername alias mport_open mportopen
727    $workername alias mport_close mportclose
728    $workername alias mport_search mportsearch
729
730    # instantiate the UI call-backs
731    foreach priority ${macports::ui_priorities} {
732        $workername alias ui_$priority ui_$priority
733    }
734    $workername alias ui_prefix ui_prefix
735    $workername alias ui_channels ui_channels
736   
737    # Export some utility functions defined here.
738    $workername alias macports_create_thread macports::create_thread
739    $workername alias getportworkpath_from_buildpath macports::getportworkpath_from_buildpath
740    $workername alias getsourceconfigdir macports::getsourceconfigdir
741    $workername alias getprotocol macports::getprotocol
742    $workername alias getportdir macports::getportdir
743
744    # New Registry/Receipts stuff
745    $workername alias registry_new registry::new_entry
746    $workername alias registry_open registry::open_entry
747    $workername alias registry_write registry::write_entry
748    $workername alias registry_prop_store registry::property_store
749    $workername alias registry_prop_retr registry::property_retrieve
750    $workername alias registry_delete registry::delete_entry
751    $workername alias registry_exists registry::entry_exists
752    $workername alias registry_activate portimage::activate
753    $workername alias registry_deactivate portimage::deactivate
754    $workername alias registry_register_deps registry::register_dependencies
755    $workername alias registry_fileinfo_for_index registry::fileinfo_for_index
756    $workername alias registry_bulk_register_files registry::register_bulk_files
757    $workername alias registry_installed registry::installed
758    $workername alias registry_active registry::active
759
760    # deferred options processing.
761    $workername alias getoption macports::getoption
762
763    foreach opt $portinterp_options {
764        if {![info exists $opt]} {
765            global macports::$opt
766        }
767        if {[info exists $opt]} {
768            $workername eval set system_options($opt) \{[set $opt]\}
769            $workername eval set $opt \{[set $opt]\}
770        }
771    }
772   
773    foreach opt $portinterp_deferred_options {
774        global macports::$opt
775        # define the trace hook.
776        $workername eval \
777            "proc trace_$opt {name1 name2 op} { \n\
778                trace remove variable ::$opt read ::trace_$opt \n\
779                global $opt \n\
780                set $opt \[getoption $opt\] \n\
781            }"
782        # next access will actually define the variable.
783        $workername eval "trace add variable ::$opt read ::trace_$opt"
784        # define some value now
785        $workername eval set $opt "?"
786    }       
787
788    foreach {opt val} $options {
789        $workername eval set user_options($opt) $val
790        $workername eval set $opt $val
791    }
792
793    foreach {var val} $variations {
794        $workername eval set variations($var) $val
795    }
796
797    if { [info exists registry.installtype] } {
798        $workername eval set installtype ${registry.installtype}
799    }
800}
801
802# Create a thread with most configuration options set.
803# The newly created thread is sent portinterp_options vars and knows where to
804# find all packages we know.
805proc macports::create_thread {} {
806    package require Thread
807
808    global macports::portinterp_options
809
810    # Create the thread.
811    set result [thread::create -preserved {thread::wait}]
812
813    # Tell the thread about all the Tcl packages we already
814    # know about so it won't glob for packages.
815    foreach pkgName [package names] {
816        foreach pkgVers [package versions $pkgName] {
817            set pkgLoadScript [package ifneeded $pkgName $pkgVers]
818            thread::send -async $result "package ifneeded $pkgName $pkgVers {$pkgLoadScript}"
819        }
820    }
821
822    # inherit configuration variables.
823    thread::send -async $result "namespace eval macports {}"
824    foreach opt $portinterp_options {
825        if {![info exists $opt]} {
826            global macports::$opt
827        }
828        if {[info exists $opt]} {
829            thread::send -async $result "global macports::$opt"
830            set val [set macports::$opt]
831            thread::send -async $result "set macports::$opt \"$val\""
832        }
833    }
834   
835    return $result
836}
837
838proc macports::fetch_port {url} {
839    global macports::portdbpath tcl_platform
840    set fetchdir [file join $portdbpath portdirs]
841    set fetchfile [file tail $url]
842    file mkdir $fetchdir
843    if {![file writable $fetchdir]} {
844        return -code error "Port remote fetch failed: You do not have permission to write to $fetchdir"
845    }
846    if {[catch {exec curl -L -s -S -o [file join $fetchdir $fetchfile] $url} result]} {
847        return -code error "Port remote fetch failed: $result"
848    }
849    cd $fetchdir
850    if {[catch {exec tar -zxf $fetchfile} result]} {
851    return -code error "Port extract failed: $result"
852    }
853    if {[regexp {(.+).tgz} $fetchfile match portdir] != 1} {
854        return -code error "Can't decipher portdir from $fetchfile"
855    }
856    return [file join $fetchdir $portdir]
857}
858
859proc macports::getprotocol {url} {
860    if {[regexp {(?x)([^:]+)://.+} $url match protocol] == 1} {
861        return ${protocol}
862    } else {
863        return -code error "Can't parse url $url"
864    }
865}
866
867# XXX: this really needs to be rethought in light of the remote index
868# I've added the destdir parameter.  This is the location a remotely
869# fetched port will be downloaded to (currently only applies to
870# mports:// sources).
871proc macports::getportdir {url {destdir "."}} {
872    if {[regexp {(?x)([^:]+)://(.+)} $url match protocol string] == 1} {
873        switch -regexp -- ${protocol} {
874            {^file$} {
875                return [file normalize $string]
876            }
877            {^mports$} {
878                return [macports::index::fetch_port $url $destdir]
879            }
880            {^https?$|^ftp$} {
881                return [macports::fetch_port $url]
882            }
883            default {
884                return -code error "Unsupported protocol $protocol"
885            }
886        }
887    } else {
888        return -code error "Can't parse url $url"
889    }
890}
891
892##
893# Get the path to the .config directory of the source
894#
895# @param url port url
896# @return path to the .config directory or an empty string if the protocol does \
897#         not support .config
898proc macports::getsourceconfigdir {url} {
899    if {[catch {getprotocol $url} protocol]} {
900        return ""
901    }
902
903    switch -- ${protocol} {
904        file {
905            return [file normalize [file join [getportdir $url] .. .. .config]]
906        }
907        default {
908            return ""
909        }
910    }
911}
912
913# dportopen
914# Deprecated version of the new mportopen proc, listed here as backwards
915# compatibility glue for API clients that haven't updated to the new naming
916proc dportopen {porturl {options ""} {variations ""} {nocache ""}} {
917    ui_warn "The dportopen proc is deprecated and will be going away soon, please use mportopen in the future!"
918    mportopen $porturl $options $variations $nocache
919}
920
921# mportopen
922# Opens a MacPorts portfile specified by a URL.  The Portfile is
923# opened with the given list of options and variations.  The result
924# of this function should be treated as an opaque handle to a
925# MacPorts Portfile.
926
927proc mportopen {porturl {options ""} {variations ""} {nocache ""}} {
928    global macports::portdbpath macports::portconf macports::open_mports auto_path
929
930    # Look for an already-open MPort with the same URL.
931    # XXX: should compare options and variations here too.
932    # if found, return the existing reference and bump the refcount.
933    if {$nocache != ""} {
934        set mport {}
935    } else {
936        set mport [dlist_search $macports::open_mports porturl $porturl]
937    }
938    if {$mport != {}} {
939        set refcnt [ditem_key $mport refcnt]
940        incr refcnt
941        ditem_key $mport refcnt $refcnt
942        return $mport
943    }
944
945    array set options_array $options
946    if {[info exists options_array(portdir)]} {
947        set portdir $options_array(portdir)
948    } else {
949        set portdir ""
950    }
951
952    set portpath [macports::getportdir $porturl $portdir]
953    ui_debug "Changing to port directory: $portpath"
954    cd $portpath
955    if {![file isfile Portfile]} {
956        return -code error "Could not find Portfile in $portpath"
957    }
958
959    set workername [interp create]
960
961    set mport [ditem_create]
962    lappend macports::open_mports $mport
963    ditem_key $mport porturl $porturl
964    ditem_key $mport portpath $portpath
965    ditem_key $mport workername $workername
966    ditem_key $mport options $options
967    ditem_key $mport variations $variations
968    ditem_key $mport refcnt 1
969   
970    macports::worker_init $workername $portpath $porturl [macports::getportbuildpath $portpath] $options $variations
971
972    $workername eval source Portfile
973
974    # evaluate the variants
975    if {[$workername eval eval_variants variations] != 0} {
976    mportclose $mport
977    error "Error evaluating variants"
978    }
979
980    ditem_key $mport provides [$workername eval return \$portname]
981
982    return $mport
983}
984
985# Traverse a directory with ports, calling a function on the path of ports
986# (at the second depth).
987# I.e. the structure of dir shall be:
988# category/port/
989# with a Portfile file in category/port/
990#
991# func:     function to call on every port directory (it is passed
992#           category/port/ as its parameter)
993# root:     the directory with all the categories directories.
994proc mporttraverse {func {root .}} {
995    # Save the current directory
996    set pwd [pwd]
997   
998    # Join the root.
999    set pathToRoot [file join $pwd $root]
1000
1001    # Go to root because some callers expects us to be there.
1002    cd $pathToRoot
1003
1004    foreach category [lsort -increasing -unique [readdir $root]] {
1005        set pathToCategory [file join $root $category]
1006        if {[file isdirectory $pathToCategory]} {
1007            # Iterate on port directories.
1008            foreach port [lsort -increasing -unique [readdir $pathToCategory]] {
1009                set pathToPort [file join $pathToCategory $port]
1010                if {[file isdirectory $pathToPort] &&
1011                    [file exists [file join $pathToPort "Portfile"]]} {
1012                    # Call the function.
1013                    $func [file join $category $port]
1014                   
1015                    # Restore the current directory because some
1016                    # functions changes it.
1017                    cd $pathToRoot
1018                }
1019            }
1020        }
1021    }
1022   
1023    # Restore the current directory.
1024    cd $pwd
1025}
1026
1027### _mportsearchpath is private; subject to change without notice
1028
1029# depregex -> regex on the filename to find.
1030# search_path -> directories to search
1031# executable -> whether we want to check that the file is executable by current
1032#               user or not.
1033proc _mportsearchpath {depregex search_path {executable 0}} {
1034    set found 0
1035    foreach path $search_path {
1036        if {![file isdirectory $path]} {
1037            continue
1038        }
1039
1040        if {[catch {set filelist [readdir $path]} result]} {
1041            return -code error "$result ($path)"
1042            set filelist ""
1043        }
1044
1045        foreach filename $filelist {
1046            if {[regexp $depregex $filename] &&
1047              (($executable == 0) || [file executable [file join $path $filename]])} {
1048                ui_debug "Found Dependency: path: $path filename: $filename regex: $depregex"
1049                set found 1
1050                break
1051            }
1052        }
1053    }
1054    return $found
1055}
1056
1057### _libtest is private; subject to change without notice
1058# XXX - Architecture specific
1059# XXX - Rely on information from internal defines in cctools/dyld:
1060# define DEFAULT_FALLBACK_FRAMEWORK_PATH
1061# /Library/Frameworks:/Library/Frameworks:/Network/Library/Frameworks:/System/Library/Frameworks
1062# define DEFAULT_FALLBACK_LIBRARY_PATH /lib:/usr/local/lib:/lib:/usr/lib
1063#   -- Since /usr/local is bad, using /lib:/usr/lib only.
1064# Environment variables DYLD_FRAMEWORK_PATH, DYLD_LIBRARY_PATH,
1065# DYLD_FALLBACK_FRAMEWORK_PATH, and DYLD_FALLBACK_LIBRARY_PATH take precedence
1066
1067proc _libtest {mport depspec} {
1068    global env tcl_platform
1069    set depline [lindex [split $depspec :] 1]
1070    set prefix [_mportkey $mport prefix]
1071   
1072    if {[info exists env(DYLD_FRAMEWORK_PATH)]} {
1073        lappend search_path $env(DYLD_FRAMEWORK_PATH)
1074    } else {
1075        lappend search_path /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks
1076    }
1077    if {[info exists env(DYLD_FALLBACK_FRAMEWORK_PATH)]} {
1078        lappend search_path $env(DYLD_FALLBACK_FRAMEWORK_PATH)
1079    }
1080    if {[info exists env(DYLD_LIBRARY_PATH)]} {
1081        lappend search_path $env(DYLD_LIBRARY_PATH)
1082    }
1083    lappend search_path /lib /usr/lib /usr/X11R6/lib ${prefix}/lib
1084    if {[info exists env(DYLD_FALLBACK_LIBRARY_PATH)]} {
1085        lappend search_path $env(DYLD_FALLBACK_LIBRARY_PATH)
1086    }
1087
1088    set i [string first . $depline]
1089    if {$i < 0} {set i [string length $depline]}
1090    set depname [string range $depline 0 [expr $i - 1]]
1091    set depversion [string range $depline $i end]
1092    regsub {\.} $depversion {\.} depversion
1093    if {$tcl_platform(os) == "Darwin"} {
1094        set depregex \^${depname}${depversion}\\.dylib\$
1095    } else {
1096        set depregex \^${depname}\\.so${depversion}\$
1097    }
1098
1099    return [_mportsearchpath $depregex $search_path]
1100}
1101
1102### _bintest is private; subject to change without notice
1103
1104proc _bintest {mport depspec} {
1105    global env
1106    set depregex [lindex [split $depspec :] 1]
1107    set prefix [_mportkey $mport prefix] 
1108   
1109    set search_path [split $env(PATH) :]
1110   
1111    set depregex \^$depregex\$
1112   
1113    return [_mportsearchpath $depregex $search_path 1]
1114}
1115
1116### _pathtest is private; subject to change without notice
1117
1118proc _pathtest {mport depspec} {
1119    global env
1120    set depregex [lindex [split $depspec :] 1]
1121    set prefix [_mportkey $mport prefix] 
1122   
1123    # separate directory from regex
1124    set fullname $depregex
1125
1126    regexp {^(.*)/(.*?)$} "$fullname" match search_path depregex
1127
1128    if {[string index $search_path 0] != "/"} {
1129        # Prepend prefix if not an absolute path
1130        set search_path "${prefix}/${search_path}"
1131    }
1132
1133    set depregex \^$depregex\$
1134
1135    return [_mportsearchpath $depregex $search_path]
1136}
1137
1138### _porttest is private; subject to change without notice
1139
1140proc _porttest {mport depspec} {
1141    # We don't actually look for the port, but just return false
1142    # in order to let the mportdepends handle the dependency
1143    return 0
1144}
1145
1146### _mportinstalled is private; may change without notice
1147
1148# Determine if a port is already *installed*, as in "in the registry".
1149proc _mportinstalled {mport} {
1150    # Check for the presense of the port in the registry
1151    set workername [ditem_key $mport workername]
1152    set res [$workername eval registry_exists \${portname} \${portversion}]
1153    if {$res != 0} {
1154        ui_debug "[ditem_key $mport provides] is installed"
1155        return 1
1156    } else {
1157        return 0
1158    }
1159}
1160
1161### _mportispresent is private; may change without notice
1162
1163# Determine if some depspec is satisfied or if the given port is installed.
1164# We actually start with the registry (faster?)
1165#
1166# mport     the port to test (to figure out if it's present)
1167# depspec   the dependency test specification (path, bin, lib, etc.)
1168proc _mportispresent {mport depspec} {
1169    # Check for the presense of the port in the registry
1170    set workername [ditem_key $mport workername]
1171    ui_debug "Searching for dependency: [ditem_key $mport provides]"
1172    if {[catch {set reslist [$workername eval registry_installed \${portname}]} res]} {
1173        set res 0
1174    } else {
1175        set res [llength $reslist]
1176    }
1177    if {$res != 0} {
1178        ui_debug "Found Dependency: receipt exists for [ditem_key $mport provides]"
1179        return 1
1180    } else {
1181        # The receipt test failed, use one of the depspec regex mechanisms
1182        ui_debug "Didn't find receipt, going to depspec regex for: [ditem_key $mport provides]"
1183        set type [lindex [split $depspec :] 0]
1184        switch $type {
1185            lib { return [_libtest $mport $depspec] }
1186            bin { return [_bintest $mport $depspec] }
1187            path { return [_pathtest $mport $depspec] }
1188            port { return [_porttest $mport $depspec] }
1189            default {return -code error "unknown depspec type: $type"}
1190        }
1191        return 0
1192    }
1193}
1194
1195### _mportexec is private; may change without notice
1196
1197proc _mportexec {target mport} {
1198    # xxx: set the work path?
1199    set workername [ditem_key $mport workername]
1200    if {![catch {$workername eval check_variants variations $target} result] && $result == 0 &&
1201        ![catch {$workername eval eval_targets $target} result] && $result == 0} {
1202        # If auto-clean mode, clean-up after dependency install
1203        if {[string equal ${macports::portautoclean} "yes"]} {
1204            # Make sure we are back in the port path before clean
1205            # otherwise if the current directory had been changed to
1206            # inside the port,  the next port may fail when trying to
1207            # install because [pwd] will return a "no file or directory"
1208            # error since the directory it was in is now gone.
1209            set portpath [ditem_key $mport portpath]
1210            catch {cd $portpath}
1211            $workername eval eval_targets clean
1212        }
1213        return 0
1214    } else {
1215        # An error occurred.
1216        return 1
1217    }
1218}
1219
1220# dportexec
1221# Deprecated version of the new mportexec proc, listed here as backwards
1222# compatibility glue for API clients that haven't updated to the new naming
1223proc dportexec {mport target} {
1224    ui_warn "The dportexec proc is deprecated and will be going away soon, please use mportexec in the future!"
1225    mportexec $mport $target
1226}
1227
1228# mportexec
1229# Execute the specified target of the given mport.
1230proc mportexec {mport target} {
1231    global macports::registry.installtype
1232
1233    set workername [ditem_key $mport workername]
1234
1235    # check variants
1236    if {[$workername eval check_variants variations $target] != 0} {
1237        return 1
1238    }
1239   
1240    # Before we build the port, we must build its dependencies.
1241    # XXX: need a more general way of comparing against targets
1242    set dlist {}
1243    if {$target == "configure" || $target == "build"
1244        || $target == "test"
1245        || $target == "destroot" || $target == "install"
1246        || $target == "archive"
1247        || $target == "pkg" || $target == "mpkg"
1248        || $target == "rpm" || $target == "dpkg" } {
1249
1250        if {[mportdepends $mport $target] != 0} {
1251            return 1
1252        }
1253       
1254        # Select out the dependents along the critical path,
1255        # but exclude this mport, we might not be installing it.
1256        set dlist [dlist_append_dependents $macports::open_mports $mport {}]
1257       
1258        dlist_delete dlist $mport
1259
1260        # install them
1261        # xxx: as with below, this is ugly.  and deps need to be fixed to
1262        # understand Port Images before this can get prettier
1263        if { [string equal ${macports::registry.installtype} "image"] } {
1264            set result [dlist_eval $dlist _mportinstalled [list _mportexec "activate"]]
1265        } else {
1266            set result [dlist_eval $dlist _mportinstalled [list _mportexec "install"]]
1267        }
1268       
1269        if {$result != {}} {
1270            set errstring "The following dependencies failed to build:"
1271            foreach ditem $result {
1272                append errstring " [ditem_key $ditem provides]"
1273            }
1274            ui_error $errstring
1275            return 1
1276        }
1277       
1278        # Close the dependencies, we're done installing them.
1279        foreach ditem $dlist {
1280            mportclose $ditem
1281        }
1282    }
1283
1284    # If we're doing an install, check if we should clean after
1285    set clean 0
1286    if {[string equal ${macports::portautoclean} "yes"] && [string equal $target "install"] } {
1287        set clean 1
1288    }
1289
1290    # If we're doing image installs, then we should activate after install
1291    # xxx: This isn't pretty
1292    if { [string equal ${macports::registry.installtype} "image"] && [string equal $target "install"] } {
1293        set target activate
1294    }
1295   
1296    # Build this port with the specified target
1297    set result [$workername eval eval_targets $target]
1298
1299    # If auto-clean mode and successful install, clean-up after install
1300    if {$result == 0 && $clean == 1} {
1301        # Make sure we are back in the port path, just in case
1302        set portpath [ditem_key $mport portpath]
1303        catch {cd $portpath}
1304        $workername eval eval_targets clean
1305    }
1306
1307    return $result
1308}
1309
1310proc macports::getsourcepath {url} {
1311    global macports::portdbpath
1312    set source_path [split $url ://]
1313    return [file join $portdbpath sources [lindex $source_path 3] [lindex $source_path 4] [lindex $source_path 5]]
1314}
1315
1316proc macports::getportbuildpath {id} {
1317    global macports::portdbpath
1318    regsub {://} $id {.} port_path
1319    regsub -all {/} $port_path {_} port_path
1320    return [file join $portdbpath build $port_path]
1321}
1322
1323proc macports::getportworkpath_from_buildpath {portbuildpath} {
1324    return [file join $portbuildpath work]
1325}
1326
1327proc macports::getportworkpath_from_portdir {portpath} {
1328    return [macports::getportworkpath_from_buildpath [macports::getportbuildpath $portpath]]
1329}
1330
1331proc macports::getindex {source} {
1332    # Special case file:// sources
1333    if {[macports::getprotocol $source] == "file"} {
1334        return [file join [macports::getportdir $source] PortIndex]
1335    }
1336
1337    return [file join [macports::getsourcepath $source] PortIndex]
1338}
1339
1340# dportsync
1341# Deprecated version of the new mportsync proc, listed here as backwards
1342# compatibility glue for API clients that haven't updated to the new naming
1343proc dportsync {} {
1344    ui_warn "The dportsync proc is deprecated and will be going away soon, please use mportsync in the future!"
1345    mportsync
1346}
1347
1348proc mportsync {} {
1349    global macports::sources macports::portdbpath macports::rsync_options tcl_platform
1350    global macports::autoconf::rsync_path
1351   
1352    ui_debug "Synchronizing ports tree(s)"
1353    foreach source $sources {
1354        set flags [lrange $source 1 end]
1355        set source [lindex $source 0]
1356        if {[lsearch -exact $flags nosync] != -1} {
1357            ui_debug "Skipping $source"
1358            continue
1359        }
1360        ui_info "Synchronizing local ports tree from $source"
1361        switch -regexp -- [macports::getprotocol $source] {
1362            {^file$} {
1363                set portdir [macports::getportdir $source]
1364                if {[file exists $portdir/.svn]} {
1365                    set svn_commandline "[macports::findBinary svn ${macports::autoconf::svn_path}] update --non-interactive ${portdir}"
1366                    ui_debug $svn_commandline
1367                    if {
1368                        [catch {
1369                            set euid [geteuid]
1370                            set egid [getegid]
1371                            ui_debug "changing euid/egid - current euid: $euid - current egid: $egid"
1372                            setegid [name_to_gid [file attributes $portdir -group]]
1373                            seteuid [name_to_uid [file attributes $portdir -owner]]
1374                            system $svn_commandline
1375                            seteuid $euid
1376                            setegid $egid
1377                        }]
1378                    } {
1379                        ui_debug "$::errorInfo"
1380                        return -code error "Synchronization of the local ports tree failed doing an svn update"
1381                    }
1382                }
1383            }
1384            {^mports$} {
1385                macports::index::sync $macports::portdbpath $source
1386            }
1387            {^rsync$} {
1388                # Where to, boss?
1389                set destdir [file dirname [macports::getindex $source]]
1390                file mkdir $destdir
1391                # Keep rsync happy with a trailing slash
1392                if {[string index $source end] != "/"} {
1393                    set source "${source}/"
1394                }
1395                # Do rsync fetch
1396                set rsync_commandline "${macports::autoconf::rsync_path} ${rsync_options} ${source} ${destdir}"
1397                ui_debug $rsync_commandline
1398                if {[catch {system $rsync_commandline}]} {
1399                    return -code error "Synchronization of the local ports tree failed doing rsync"
1400                }
1401                if {[catch {system "chmod -R a+r \"$destdir\""}]} {
1402                    ui_warn "Setting world read permissions on parts of the ports tree failed, need root?"
1403                }
1404            }
1405            {^https?$|^ftp$} {
1406                set indexfile [macports::getindex $source]
1407                file mkdir [file dirname $indexfile]
1408                exec curl -L -s -S -o $indexfile $source/PortIndex
1409            }
1410            default {
1411                ui_warn "Unknown synchronization protocol for $source"
1412            }
1413        }
1414    }
1415}
1416
1417# dportsearch
1418# Deprecated version of the new mportsearch proc, listed here as backwards
1419# compatibility glue for API clients that haven't updated to the new naming
1420proc dportsearch {pattern {case_sensitive yes} {matchstyle regexp} {field name}} {
1421    ui_warn "The dportsearch proc is deprecated and will be going away soon, please use mportsearch in the future!"
1422    mportsearch $pattern $case_sensitive $matchstyle $field
1423}
1424
1425proc mportsearch {pattern {case_sensitive yes} {matchstyle regexp} {field name}} {
1426    global macports::portdbpath macports::sources
1427    set matches [list]
1428    set easy [expr { $field == "name" }]
1429   
1430    set found 0
1431    foreach source $sources {
1432        set flags [lrange $source 1 end]
1433        set source [lindex $source 0]
1434        if {[macports::getprotocol $source] == "mports"} {
1435            array set attrs [list name $pattern]
1436            set res [macports::index::search $macports::portdbpath $source [array get attrs]]
1437            eval lappend matches $res
1438        } else {
1439            if {[catch {set fd [open [macports::getindex $source] r]} result]} {
1440                ui_warn "Can't open index file for source: $source"
1441            } else {
1442                try {
1443                    incr found 1
1444                    while {[gets $fd line] >= 0} {
1445                        array unset portinfo
1446                        set name [lindex $line 0]
1447                        set len [lindex $line 1]
1448                        set line [read $fd $len]
1449                       
1450                        if {$easy} {
1451                            set target $name
1452                        } else {
1453                            array set portinfo $line
1454                            if {![info exists portinfo($field)]} continue
1455                            set target $portinfo($field)
1456                        }
1457                       
1458                        switch $matchstyle {
1459                            exact {
1460                                set matchres [expr 0 == ( {$case_sensitive == "yes"} ? [string compare $pattern $target] : [string compare -nocase $pattern $target] )]
1461                            }
1462                            glob {
1463                                set matchres [expr {$case_sensitive == "yes"} ? [string match $pattern $target] : [string match -nocase $pattern $target]]
1464                            }
1465                            regexp -
1466                            default {
1467                                set matchres [expr {$case_sensitive == "yes"} ? [regexp -- $pattern $target] : [regexp -nocase -- $pattern $target]]
1468                            }
1469                        }
1470                       
1471                        if {$matchres == 1} {
1472                            if {$easy} {
1473                                array set portinfo $line
1474                            }
1475                            switch -regexp -- [macports::getprotocol ${source}] {
1476                                {^rsync$} {
1477                                    # Rsync files are local
1478                                    set source_url "file://[macports::getsourcepath $source]"
1479                                }
1480                                default {
1481                                    set source_url $source
1482                                }
1483                            }
1484                            if {[info exists portinfo(portarchive)]} {
1485                                set porturl ${source_url}/$portinfo(portarchive)
1486                            } elseif {[info exists portinfo(portdir)]} {
1487                                set porturl ${source_url}/$portinfo(portdir)
1488                            }
1489                            if {[info exists porturl]} {
1490                                lappend line porturl $porturl
1491                                ui_debug "Found port in $porturl"
1492                            } else {
1493                                ui_debug "Found port info: $line"
1494                            }
1495                            lappend matches $name
1496                            lappend matches $line
1497                        }
1498                    }
1499                } catch {*} {
1500                    ui_warn "It looks like your PortIndex file may be corrupt."
1501                    throw
1502                } finally {
1503                    close $fd
1504                }
1505            }
1506        }
1507    }
1508    if {!$found} {
1509        return -code error "No index(es) found! Have you synced your source indexes?"
1510    }
1511
1512    return $matches
1513}
1514
1515# dportinfo
1516# Deprecated version of the new mportinfo proc, listed here as backwards
1517# compatibility glue for API clients that haven't updated to the new naming
1518proc dportinfo {mport} {
1519    ui_warn "The dportinfo proc is deprecated and will be going away soon, please use mportinfo in the future!"
1520    mport info $mport
1521}
1522
1523proc mportinfo {mport} {
1524    set workername [ditem_key $mport workername]
1525    return [$workername eval array get PortInfo]
1526}
1527
1528# dportclose
1529# Deprecated version of the new mportclose proc, listed here as backwards
1530# compatibility glue for API clients that haven't updated to the new naming
1531proc dportclose {mport} {
1532    ui_warn "The dportclose proc is deprecated and will be going away soon, please use mportclose in the future!"
1533    mportclose $mport
1534}
1535
1536proc mportclose {mport} {
1537    global macports::open_mports
1538    set refcnt [ditem_key $mport refcnt]
1539    incr refcnt -1
1540    ditem_key $mport refcnt $refcnt
1541    if {$refcnt == 0} {
1542        dlist_delete macports::open_mports $mport
1543        set workername [ditem_key $mport workername]
1544        interp delete $workername
1545    }
1546}
1547
1548##### Private Depspec API #####
1549# This API should be considered work in progress and subject to change without notice.
1550##### "
1551
1552# _mportkey
1553# - returns a variable from the port's interpreter
1554
1555proc _mportkey {mport key} {
1556    set workername [ditem_key $mport workername]
1557    return [$workername eval "return \$${key}"]
1558}
1559
1560# mportdepends builds the list of mports which the given port depends on.
1561# This list is added to $mport.
1562# This list actually depends on the target.
1563# This method can optionally recurse through the dependencies, looking for
1564#   dependencies of dependencies.
1565# This method can optionally cut the search when ports are already installed or
1566#   the dependencies are satisfied.
1567#
1568# mport -> mport item
1569# target -> target to consider the dependency for
1570# recurseDeps -> if the search should be recursive
1571# skipSatisfied -> cut the search tree when encountering installed/satisfied
1572#                  dependencies ports.
1573# accDeps -> accumulator for recursive calls
1574# return 0 if everything was ok, an non zero integer otherwise.
1575proc mportdepends {mport {target ""} {recurseDeps 1} {skipSatisfied 1} {accDeps {}}} {
1576
1577    array set portinfo [mportinfo $mport]
1578    set depends {}
1579    set deptypes {}
1580       
1581    # Determine deptypes to look for based on target
1582    switch $target {
1583        configure   { set deptypes "depends_lib" }
1584       
1585        build       { set deptypes "depends_lib depends_build" }
1586       
1587        test        -
1588        destroot    -
1589        install     -
1590        archive     -
1591        pkg         -
1592        mpkg        -
1593        rpm         -
1594        dpkg        -
1595        ""          { set deptypes "depends_lib depends_build depends_run" }
1596    }
1597   
1598    # Gather the dependencies for deptypes
1599    foreach deptype $deptypes {
1600        # Add to the list of dependencies if the option exists and isn't empty.
1601        if {[info exists portinfo($deptype)] && $portinfo($deptype) != ""} {
1602            set depends [concat $depends $portinfo($deptype)]
1603        }
1604    }
1605
1606    set subPorts {}
1607   
1608    foreach depspec $depends {
1609        # grab the portname portion of the depspec
1610        set dep_portname [lindex [split $depspec :] end]
1611       
1612        # Find the porturl
1613        if {[catch {set res [mportsearch $dep_portname false exact]} error]} {
1614            global errorInfo
1615            ui_debug "$errorInfo"
1616            ui_error "Internal error: port search failed: $error"
1617            return 1
1618        }
1619        foreach {name array} $res {
1620            array set portinfo $array
1621            if {[info exists portinfo(porturl)]} {
1622                set porturl $portinfo(porturl)
1623                break
1624            }
1625        }
1626
1627        if {![info exists porturl]} {
1628            ui_error "Dependency '$dep_portname' not found."
1629            return 1
1630        }
1631
1632        set options [ditem_key $mport options]
1633        set variations [ditem_key $mport variations]
1634
1635        # Figure out the subport.   
1636        set subport [mportopen $porturl $options $variations]
1637
1638        # Is that dependency satisfied or this port installed?
1639        # If we don't skip or if it is not, add it to the list.
1640        if {!$skipSatisfied || ![_mportispresent $subport $depspec]} {
1641            # Append the sub-port's provides to the port's requirements list.
1642            ditem_append_unique $mport requires "[ditem_key $subport provides]"
1643   
1644            if {$recurseDeps} {
1645                # Skip the port if it's already in the accumulated list.
1646                if {[lsearch $accDeps $dep_portname] == -1} {
1647                    # Add it to the list
1648                    lappend accDeps $dep_portname
1649               
1650                    # We'll recursively iterate on it.
1651                    lappend subPorts $subport
1652                }
1653            }
1654        }
1655    }
1656
1657    # Loop on the subports.
1658    if {$recurseDeps} {
1659        foreach subport $subPorts {
1660            # Sub ports should be installed (all dependencies must be satisfied).
1661            set res [mportdepends $subport "" $recurseDeps $skipSatisfied $accDeps]
1662            if {$res != 0} {
1663                return $res
1664            }
1665        }
1666    }
1667   
1668    return 0
1669}
1670
1671# selfupdate procedure
1672proc macports::selfupdate {{optionslist {}}} {
1673    global macports::prefix macports::portdbpath macports::libpath macports::rsync_server macports::rsync_dir macports::rsync_options
1674    global macports::autoconf::macports_version macports::autoconf::rsync_path
1675    array set options $optionslist
1676   
1677    # syncing ports tree.
1678    if {![info exists options(ports_selfupdate_nosync)] || $options(ports_selfupdate_nosync) != "yes"} {
1679        if {[catch {mportsync} result]} {
1680            return -code error "Couldn't sync the ports tree: $result"
1681        }
1682    }
1683   
1684    # create the path to the to be downloaded sources if it doesn't exist
1685    set mp_source_path [file join $portdbpath sources ${rsync_server} ${rsync_dir}/]
1686    if {![file exists $mp_source_path]} {
1687        file mkdir $mp_source_path
1688    }
1689    ui_debug "MacPorts sources location: $mp_source_path"
1690   
1691    # sync the MacPorts sources
1692    ui_debug "Updating MacPorts sources using rsync"
1693    if { [catch { system "$rsync_path $rsync_options rsync://${rsync_server}/${rsync_dir} $mp_source_path" } result ] } {
1694       return -code error "Error synchronizing MacPorts sources: $result"
1695    }
1696
1697    # echo current MacPorts version
1698    ui_msg "\nMacPorts base version $macports::autoconf::macports_version installed"
1699
1700    if { [info exists options(ports_force)] && $options(ports_force) == "yes" } {
1701        set use_the_force_luke yes
1702        ui_debug "Forcing a rebuild and reinstallation of MacPorts"
1703    } else {
1704        set use_the_force_luke no
1705        ui_debug "Rebuilding and reinstalling MacPorts if needed"
1706    }
1707
1708    # Choose what version file to use: old, floating point format or new, real version number format
1709    set old_version_file [file join $mp_source_path config mp_version]
1710    set new_version_file [file join $mp_source_path config macports_version]
1711    if {[file exists $old_version_file]} {
1712        set fd [open $old_version_file r]
1713    } elseif {[file exists $new_version_file]} {
1714        set fd [open $new_version_file r]
1715    }
1716    # get downloaded MacPorts version
1717    gets $fd macports_version_new
1718    close $fd
1719    # echo downloaded MacPorts version
1720    ui_msg "Downloaded MacPorts base version $macports_version_new"
1721
1722    # check if we we need to rebuild base
1723    if {$use_the_force_luke == "yes" || [rpm-vercomp $macports_version_new $macports::autoconf::macports_version] > 0} {
1724        if {[info exists options(ports_selfupdate_pretend)] && $options(ports_selfupdate_pretend) == "yes"} {
1725            ui_msg "\nMacPorts base is outdated, selfupdate will install $macports_version_new"
1726        } else {
1727            # get installation user/group and permissions
1728            set owner [file attributes ${prefix} -owner]
1729            set group [file attributes ${prefix} -group]
1730            set perms [string range [file attributes ${prefix} -permissions] end-3 end]
1731            set installing_user [exec /usr/bin/id -un]
1732            if {![string equal $installing_user $owner]} {
1733                return -code error "User $installing_user does not own ${prefix} - try using sudo"
1734            }
1735            ui_debug "Permissions OK"
1736
1737            # where to install our macports1.0 tcl package
1738            set mp_tclpackage_path [file join $portdbpath .tclpackage]
1739            if { [file exists $mp_tclpackage_path]} {
1740                set fd [open $mp_tclpackage_path r]
1741                gets $fd tclpackage
1742                close $fd
1743            } else {
1744                set tclpackage $libpath
1745            }
1746           
1747            # do the actual configure, build and installation of new base
1748            ui_msg "\nInstalling new MacPorts release in $prefix as $owner:$group - TCL-PACKAGE in $tclpackage; Permissions: $perms\n"
1749            if { [catch { system "cd $mp_source_path && ./configure --prefix=$prefix --with-tclpackage=$tclpackage --with-install-user=$owner --with-install-group=$group --with-directory-mode=$perms && make && make install" } result] } {
1750                return -code error "Error installing new MacPorts base: $result"
1751            }
1752        }
1753    } else {
1754        ui_msg "\nThe MacPorts installation is not outdated so it was not updated"
1755    }
1756
1757    # set the MacPorts sources to the right owner
1758    set sources_owner [file attributes [file join $portdbpath sources/] -owner]
1759    ui_debug "Setting MacPorts sources ownership to $sources_owner"
1760    if { [catch { exec chown -R $sources_owner [file join $portdbpath sources/] } result] } {
1761        return -code error "Couldn't change permissions of the MacPorts sources at $mp_source_path to $sources_owner: $result"
1762    }
1763
1764    return 0
1765}
1766
1767proc macports::version {} {
1768    global macports::autoconf::macports_version
1769    return $macports::autoconf::macports_version
1770}
1771
1772# upgrade procedure
1773proc macports::upgrade {portname dspec variationslist optionslist {depscachename ""}} {
1774    global macports::registry.installtype
1775    global macports::portarchivemode
1776    array set options $optionslist
1777    array set variations $variationslist
1778    if {![string match "" $depscachename]} {
1779        upvar $depscachename depscache
1780    } 
1781
1782    # set to no-zero is epoch overrides version
1783    set epoch_override 0
1784
1785    # check if the port is in tree
1786    if {[catch {mportsearch $portname false exact} result]} {
1787        global errorInfo
1788        ui_debug "$errorInfo"
1789        ui_error "port search failed: $result"
1790        return 1
1791    }
1792    # argh! port doesnt exist!
1793    if {$result == ""} {
1794        ui_error "No port $portname found."
1795        return 1
1796    }
1797    # fill array with information
1798    array set portinfo [lindex $result 1]
1799
1800    # set version_in_tree and revision_in_tree
1801    if {![info exists portinfo(version)]} {
1802        ui_error "Invalid port entry for $portname, missing version"
1803        return 1
1804    }
1805    set version_in_tree "$portinfo(version)"
1806    set revision_in_tree "$portinfo(revision)"
1807    set epoch_in_tree "$portinfo(epoch)"
1808
1809    # the depflag tells us if we should follow deps (this is for stuff installed outside MacPorts)
1810    # if this is set (not 0) we dont follow the deps
1811    set depflag 0
1812
1813    # set version_installed and revision_installed
1814    set ilist {}
1815    if { [catch {set ilist [registry::installed $portname ""]} result] } {
1816        if {$result == "Registry error: $portname not registered as installed." } {
1817            ui_debug "$portname is *not* installed by MacPorts"
1818            # open porthandle   
1819            set porturl $portinfo(porturl)
1820            if {![info exists porturl]} {
1821                set porturl file://./   
1822            }   
1823            if {[catch {set workername [mportopen $porturl [array get options] ]} result]} {
1824                    global errorInfo
1825                    ui_debug "$errorInfo"
1826                    ui_error "Unable to open port: $result"       
1827                    return 1
1828            }
1829
1830            if {![_mportispresent $workername $dspec ] } {
1831                # port in not installed - install it!
1832                if {[catch {set result [mportexec $workername install]} result]} {
1833                    global errorInfo
1834                    ui_debug "$errorInfo"
1835                    ui_error "Unable to exec port: $result"
1836                    return 1
1837                }
1838            } else {
1839                # port installed outside MacPorts
1840                ui_debug "$portname installed outside the MacPorts system"
1841                set depflag 1
1842            }
1843
1844        } else {
1845            ui_error "Checking installed version failed: $result"
1846            exit 1
1847        }
1848    }
1849    set anyactive 0
1850    set version_installed {}
1851    set revision_installed {}
1852    set epoch_installed 0
1853    if {$ilist == ""} {
1854        # XXX  this sets $version_installed to $version_in_tree even if not installed!!
1855        set version_installed $version_in_tree
1856        set revision_installed $revision_in_tree
1857        # That was a very dirty hack showing how ugly our depencendy and upgrade code is.
1858        # To get it working when user provides -f, we also need to set the variant to
1859        # avoid a future failure.
1860        set variant ""
1861    } else {
1862        # a port could be installed but not activated
1863        # so, deactivate all and save newest for activation later
1864        set num 0
1865        set variant ""
1866        foreach i $ilist {
1867            set variant [lindex $i 3]
1868            set version [lindex $i 1]
1869            set revision [lindex $i 2]
1870            if { $version_installed == {} ||
1871                    [rpm-vercomp $version $version_installed] > 0
1872                    || ([rpm-vercomp $version $version_installed] == 0
1873                        && [rpm-vercomp $revision $revision_installed] > 0)} {
1874                set version_installed $version
1875                set revision_installed $revision
1876                set epoch_installed [registry::property_retrieve [registry::open_entry $portname [lindex $i 1] [lindex $i 2] $variant] epoch]
1877                set num $i
1878            }
1879
1880            set isactive [lindex $i 4]
1881            if {$isactive == 1} {
1882                if { [rpm-vercomp $version_installed $version] < 0
1883                        || ([rpm-vercomp $version_installed $version] == 0
1884                            && [rpm-vercomp $revision_installed $revision] < 0)} {
1885                    # deactivate version
1886                    if {[catch {portimage::deactivate $portname $version $optionslist} result]} {
1887                        global errorInfo
1888                        ui_debug "$errorInfo"
1889                        ui_error "Deactivating $portname $version_installed_$revision_installed failed: $result"
1890                        return 1
1891                    }
1892                }
1893            }
1894        }
1895        if { [lindex $num 4] == 0 && 0 == [string compare "image" ${macports::registry.installtype}] } {
1896            # activate the latest installed version
1897            if {[catch {portimage::activate $portname ${version_installed}_$revision_installed$variant $optionslist} result]} {
1898                global errorInfo
1899                ui_debug "$errorInfo"
1900                ui_error "Activating $portname ${version_installed}_$revision_installed failed: $result"
1901                return 1
1902            }
1903        }
1904    }
1905
1906    # output version numbers
1907    ui_debug "epoch: in tree: $epoch_in_tree installed: $epoch_installed"
1908    ui_debug "$portname ${version_in_tree}_$revision_in_tree exists in the ports tree"
1909    ui_debug "$portname ${version_installed}_$revision_installed is installed"
1910
1911    # set the nodeps option 
1912    if {![info exists options(ports_nodeps)]} {
1913        set nodeps no
1914    } else {
1915        set nodeps yes
1916    }
1917
1918    if {$nodeps == "yes" || $depflag == 1} {
1919        ui_debug "Not following dependencies"
1920        set depflag 0
1921    } else {
1922        # build depends is upgraded
1923        if {[info exists portinfo(depends_build)]} {
1924            foreach i $portinfo(depends_build) {
1925                if {![llength [array get depscache $i]]} {
1926                set d [lindex [split $i :] end]
1927                    set depscache($i) 1
1928                    upgrade $d $i $variationslist $optionslist depscache
1929                } 
1930            }
1931        }
1932        # library depends is upgraded
1933        if {[info exists portinfo(depends_lib)]} {
1934            foreach i $portinfo(depends_lib) {
1935                if {![llength [array get depscache $i]]} {
1936                set d [lindex [split $i :] end]
1937                    set depscache($i) 1
1938                    upgrade $d $i $variationslist $optionslist depscache
1939                } 
1940            }
1941        }
1942        # runtime depends is upgraded
1943        if {[info exists portinfo(depends_run)]} {
1944            foreach i $portinfo(depends_run) {
1945                if {![llength [array get depscache $i]]} {
1946                set d [lindex [split $i :] end]
1947                    set depscache($i) 1
1948                    upgrade $d $i $variationslist $optionslist depscache
1949                } 
1950            }
1951        }
1952    }
1953
1954    # check installed version against version in ports
1955    if { ( [rpm-vercomp $version_installed $version_in_tree] > 0
1956            || ([rpm-vercomp $version_installed $version_in_tree] == 0
1957                && [rpm-vercomp $revision_installed $revision_in_tree] >= 0 ))
1958        && ![info exists options(ports_force)] } {
1959        ui_debug "No need to upgrade! $portname ${version_installed}_$revision_installed >= $portname ${version_in_tree}_$revision_in_tree"
1960        if { $epoch_installed >= $epoch_in_tree } {
1961            # Check if we have to do dependents
1962            if {[info exists options(ports_do_dependents)]} {
1963                # We do dependents ..
1964                set options(ports_nodeps) 1
1965
1966                registry::open_dep_map
1967                set deplist [registry::list_dependents $portname]
1968
1969                if { [llength deplist] > 0 } {
1970                    foreach dep $deplist {
1971                        set mpname [lindex $dep 2] 
1972                        macports::upgrade $mpname "port:$mpname" [array get variations] [array get options]
1973                    }
1974                }
1975            }
1976
1977            return 0
1978        } else {
1979            ui_debug "epoch override ... upgrading!"
1980            set epoch_override 1
1981        }
1982    }
1983
1984    # open porthandle
1985    set porturl $portinfo(porturl)
1986    if {![info exists porturl]} {
1987        set porturl file://./
1988    }
1989
1990    # check if the variants is present in $version_in_tree
1991    set oldvariant $variant
1992    set variant [split $variant +]
1993    ui_debug "variants to install $variant"
1994    if {[info exists portinfo(variants)]} {
1995        set avariants $portinfo(variants)
1996    } else {
1997        set avariants {}
1998    }
1999    ui_debug "available variants are : $avariants"
2000    foreach v $variant {
2001        if {[lsearch $avariants $v] == -1} {
2002        } else {
2003            ui_debug "variant $v is present in $portname ${version_in_tree}_$revision_in_tree"
2004            set variations($v) "+"
2005        }
2006    }
2007    ui_debug "new portvariants: [array get variations]"
2008   
2009    if {[catch {set workername [mportopen $porturl [array get options] [array get variations]]} result]} {
2010        global errorInfo
2011        ui_debug "$errorInfo"
2012        ui_error "Unable to open port: $result"
2013        return 1
2014    }
2015
2016    # install version_in_tree
2017    if {0 == [string compare "yes" ${macports::portarchivemode}]} {
2018        set upgrade_action "archive"
2019    } else {
2020        set upgrade_action "destroot"
2021    }
2022
2023    if {[catch {set result [mportexec $workername $upgrade_action]} result] || $result != 0} {
2024        global errorInfo
2025        ui_debug "$errorInfo"
2026        ui_error "Unable to upgrade port: $result"
2027        return 1
2028    }
2029
2030    # uninstall old ports
2031    if {[info exists options(port_uninstall_old)] || $epoch_override == 1 || [info exists options(ports_force)] || 0 != [string compare "image" ${macports::registry.installtype}] } {
2032        # uninstall old
2033        ui_debug "Uninstalling $portname ${version_installed}_$revision_installed$oldvariant"
2034        if {[catch {portuninstall::uninstall $portname ${version_installed}_$revision_installed$oldvariant $optionslist} result]} {
2035            global errorInfo
2036            ui_debug "$errorInfo"
2037            ui_error "Uninstall $portname ${version_installed}_$revision_installed$oldvariant failed: $result"
2038            return 1
2039        }
2040    } else {
2041        # XXX deactivate version_installed
2042        if {[catch {portimage::deactivate $portname ${version_installed}_$revision_installed$oldvariant $optionslist} result]} {
2043            global errorInfo
2044            ui_debug "$errorInfo"
2045            ui_error "Deactivating $portname ${version_installed}_$revision_installed failed: $result"
2046            return 1
2047        }
2048    }
2049
2050    if {[catch {set result [mportexec $workername install]} result]} {
2051        global errorInfo
2052        ui_debug "$errorInfo"
2053        ui_error "Couldn't activate $portname ${version_in_tree}_$revision_in_tree$oldvariant: $result"
2054        return 1
2055    }
2056
2057    # Check if we have to do dependents
2058    if {[info exists options(ports_do_dependents)]} {
2059        # We do dependents ..
2060        set options(ports_nodeps) 1
2061
2062        registry::open_dep_map
2063        set deplist [registry::list_dependents $portname]
2064
2065        if { [llength deplist] > 0 } {
2066            foreach dep $deplist {
2067                set mpname [lindex $dep 2] 
2068                macports::upgrade $mpname "port:$mpname" [array get variations] [array get options]
2069            }
2070        }
2071    }
2072
2073   
2074    # close the port handle
2075    mportclose $workername
2076}
Note: See TracBrowser for help on using the repository browser.