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

Last change on this file since 146674 was 146674, checked in by petr@…, 4 years ago

base: avoid signals swallowing in try/catch for some occurences in macports.tcl

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 208.4 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 146674 2016-03-15 12:27:00Z petr@macports.org $
4#
5# Copyright (c) 2002 - 2003 Apple 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# Copyright (c) 2004 - 2013 The MacPorts Project
10# All rights reserved.
11#
12# Redistribution and use in source and binary forms, with or without
13# modification, are permitted provided that the following conditions
14# are met:
15# 1. Redistributions of source code must retain the above copyright
16#    notice, this list of conditions and the following disclaimer.
17# 2. Redistributions in binary form must reproduce the above copyright
18#    notice, this list of conditions and the following disclaimer in the
19#    documentation and/or other materials provided with the distribution.
20# 3. Neither the name of Apple Inc. nor the names of its contributors
21#    may be used to endorse or promote products derived from this software
22#    without specific prior written permission.
23#
24# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
25# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
26# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
27# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
28# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
29# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
30# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
31# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
32# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
33# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34# POSSIBILITY OF SUCH DAMAGE.
35#
36package provide macports 1.0
37package require macports_dlist 1.0
38package require macports_util 1.0
39package require diagnose 1.0
40package require reclaim 1.0
41package require Tclx
42
43namespace eval macports {
44    namespace export bootstrap_options user_options portinterp_options open_mports ui_priorities
45    variable bootstrap_options "\
46        portdbpath binpath auto_path extra_env sources_conf prefix portdbformat \
47        portarchivetype portautoclean \
48        porttrace portverbose keeplogs destroot_umask variants_conf rsync_server rsync_options \
49        rsync_dir startupitem_type startupitem_install place_worksymlink xcodeversion xcodebuildcmd \
50        configureccache ccache_dir ccache_size configuredistcc configurepipe buildnicevalue buildmakejobs \
51        applications_dir frameworks_dir developer_dir universal_archs build_arch macosx_sdk_version macosx_deployment_target \
52        macportsuser proxy_override_env proxy_http proxy_https proxy_ftp proxy_rsync proxy_skip \
53        master_site_local patch_site_local archive_site_local buildfromsource \
54        revupgrade_autorun revupgrade_mode revupgrade_check_id_loadcmds \
55        host_blacklist preferred_hosts sandbox_enable delete_la_files cxx_stdlib \
56        packagemaker_path default_compilers pkg_post_unarchive_deletions ui_interactive"
57    variable user_options {}
58    variable portinterp_options "\
59        portdbpath porturl portpath portbuildpath auto_path prefix prefix_frozen portsharepath \
60        registry.path registry.format user_home user_path \
61        portarchivetype archivefetch_pubkeys portautoclean porttrace keeplogs portverbose destroot_umask \
62        rsync_server rsync_options rsync_dir startupitem_type startupitem_install place_worksymlink macportsuser \
63        configureccache ccache_dir ccache_size configuredistcc configurepipe buildnicevalue buildmakejobs \
64        applications_dir current_phase frameworks_dir developer_dir universal_archs build_arch \
65        os_arch os_endian os_version os_major os_minor os_platform macosx_version macosx_sdk_version macosx_deployment_target \
66        packagemaker_path default_compilers sandbox_enable delete_la_files cxx_stdlib \
67        pkg_post_unarchive_deletions $user_options"
68
69    # deferred options are only computed when needed.
70    # they are not exported to the trace thread.
71    # they are not exported to the interpreter in system_options array.
72    variable portinterp_deferred_options "xcodeversion xcodebuildcmd developer_dir"
73
74    variable open_mports {}
75
76    variable ui_priorities "error warn msg notice info debug any"
77    variable current_phase main
78
79    variable ui_prefix "---> "
80}
81
82##
83# Return the version of MacPorts you are running
84#
85# This proc never fails and always returns the current version in the format
86# major.minor.patch. Note that the value of patch will not be meaningful for
87# trunk releases, but we guarantee that it will compare to be greater than any
88# released versions from the same major.minor.x series. You should use the
89# MacPorts-provided Tcl extension "vercmp" to do version number comparisons on
90# the return value of this function.
91proc macports::version {} {
92    return ${macports::autoconf::macports_version}
93}
94
95# Provided UI instantiations
96# For standard messages, the following priorities are defined
97#     debug, info, msg, warn, error
98# Clients of the library are expected to provide ui_prefix and ui_channels with
99# the following prototypes.
100#     proc ui_prefix {priority}
101#     proc ui_channels {priority}
102# ui_prefix returns the prefix for the messages, if any.
103# ui_channels returns a list of channels to output the message to, empty for
104#     no message.
105# if these functions are not provided, defaults are used.
106# Clients of the library may optionally provide ui_init with the following
107# prototype.
108#     proc ui_init {priority prefix channels message}
109# ui_init needs to correctly define the proc ::ui_$priority {message} or throw
110# an error.
111# if this function is not provided or throws an error, default procedures for
112# ui_$priority are defined.
113
114# ui_options accessor
115proc macports::ui_isset {val} {
116    if {[info exists macports::ui_options($val)]} {
117        return [string is true -strict $macports::ui_options($val)]
118    }
119    return 0
120}
121
122
123# global_options accessor
124proc macports::global_option_isset {val} {
125    if {[info exists macports::global_options($val)]} {
126        return [string is true -strict $macports::global_options($val)]
127    }
128    return 0
129}
130
131proc macports::init_logging {mport} {
132    global macports::channels macports::portdbpath
133
134    if {[getuid] == 0 && [geteuid] != 0} {
135        seteuid 0; setegid 0
136    }
137    if {[catch {macports::ch_logging $mport} err]} {
138        ui_debug "Logging disabled, error opening log file: $err"
139        return 1
140    }
141    return 0
142}
143proc macports::ch_logging {mport} {
144    global ::debuglog ::debuglogname
145
146    set portname [_mportkey $mport subport]
147    set portpath [_mportkey $mport portpath]
148
149    ui_debug "Starting logging for $portname"
150
151    set logname [macports::getportlogpath $portpath $portname]
152    file mkdir $logname
153    set logname [file join $logname main.log]
154
155    set ::debuglogname $logname
156
157    # Truncate the file if already exists
158    set ::debuglog [open $::debuglogname w]
159    puts $::debuglog version:1
160}
161proc macports::push_log {mport} {
162    global ::logstack ::logenabled ::debuglog ::debuglogname
163    if {![info exists ::logenabled]} {
164        if {[macports::init_logging $mport] == 0} {
165            set ::logenabled yes
166            set ::logstack [list [list $::debuglog $::debuglogname]]
167            return
168        } else {
169            set ::logenabled no
170        }
171    }
172    if {$::logenabled} {
173        if {[getuid] == 0 && [geteuid] != 0} {
174            seteuid 0; setegid 0
175        }
176        if {[catch {macports::ch_logging $mport} err]} {
177            ui_debug "Logging disabled, error opening log file: $err"
178            return
179        }
180        lappend ::logstack [list $::debuglog $::debuglogname]
181    }
182}
183
184proc macports::pop_log {} {
185    global ::logenabled ::logstack ::debuglog ::debuglogname
186    if {![info exists ::logenabled]} {
187        return -code error "pop_log called before push_log"
188    }
189    if {$::logenabled && [llength $::logstack] > 0} {
190        close $::debuglog
191        set ::logstack [lreplace $::logstack end end]
192        if {[llength $::logstack] > 0} {
193            set top [lindex $::logstack end]
194            set ::debuglog [lindex $top 0]
195            set ::debuglogname [lindex $top 1]
196        } else {
197            unset ::debuglog
198            unset ::debuglogname
199        }
200    }
201}
202
203proc set_phase {phase} {
204    global macports::current_phase
205    set macports::current_phase $phase
206    if {$phase ne "main"} {
207        set cur_time [clock format [clock seconds] -format  {%+}]
208        ui_debug "$phase phase started at $cur_time"
209    }
210}
211
212proc ui_message {priority prefix args} {
213    global macports::channels ::debuglog macports::current_phase
214
215    #
216    # validate $args
217    #
218    switch [llength $args] {
219       0 - 1 {}
220       2 {
221           if {[lindex $args 0] ne "-nonewline"} {
222               set hint "error: when 4 arguments are given, 3rd must be \"-nonewline\""
223               error "$hint\nusage: ui_message priority prefix ?-nonewline? string"
224           }
225       }
226       default {
227           set hint "error: too many arguments specified"
228           error "$hint\nusage: ui_message priority prefix ?-nonewline? string"
229       }
230    } 
231
232    foreach chan $macports::channels($priority) {
233        if {[lindex $args 0] eq "-nonewline"} {
234            puts -nonewline $chan $prefix[lindex $args 1]
235        } else {
236            puts $chan $prefix[lindex $args 0]
237        }
238    }
239
240    if {[info exists ::debuglog]} {
241        set chan $::debuglog
242        if {[info exists macports::current_phase]} {
243            set phase $macports::current_phase
244        }
245        set strprefix ":${priority}:$phase "
246        if {[lindex $args 0] eq "-nonewline"} {
247            puts -nonewline $chan $strprefix[lindex $args 1]
248        } else {
249            foreach str [split [lindex $args 0] "\n"] {
250                puts $chan $strprefix$str
251            }
252        }
253    }
254}
255
256proc macports::ui_init {priority args} {
257    global macports::channels ::debuglog
258    set default_channel [macports::ui_channels_default $priority]
259    # Get the list of channels.
260    if {[llength [info commands ui_channels]] > 0} {
261        set channels($priority) [ui_channels $priority]
262    } else {
263        set channels($priority) $default_channel
264    }
265
266    # Simplify ui_$priority.
267    try {
268        set prefix [ui_prefix $priority]
269    } catch * {
270        set prefix [ui_prefix_default $priority]
271    }
272    try {
273        ::ui_init $priority $prefix $channels($priority) {*}$args
274    } catch * {
275        interp alias {} ui_$priority {} ui_message $priority $prefix
276    }
277}
278
279# Default implementation of ui_prefix
280proc macports::ui_prefix_default {priority} {
281    switch -- $priority {
282        debug {
283            return "DEBUG: "
284        }
285        error {
286            return "Error: "
287        }
288        warn {
289            return "Warning: "
290        }
291        default {
292            return {}
293        }
294    }
295}
296
297# Default implementation of ui_channels:
298# ui_options(ports_debug) - If set, output debugging messages
299# ui_options(ports_verbose) - If set, output info messages (ui_info)
300# ui_options(ports_quiet) - If set, don't output "standard messages"
301proc macports::ui_channels_default {priority} {
302    switch -- $priority {
303        debug {
304            if {[ui_isset ports_debug]} {
305                return stderr
306            } else {
307                return {}
308            }
309        }
310        info {
311            if {[ui_isset ports_verbose]} {
312                return stdout
313            } else {
314                return {}
315            }
316        }
317        notice {
318            if {[ui_isset ports_quiet]} {
319                return {}
320            } else {
321                return stdout
322            }
323        }
324        msg {
325            return stdout
326        }
327        warn -
328        error {
329            return stderr
330        }
331        default {
332            return stdout
333        }
334    }
335}
336
337proc ui_warn_once {id msg} {
338    variable macports::warning_done
339    if {![info exists macports::warning_done($id)]} {
340        ui_warn $msg
341        set macports::warning_done($id) 1
342    }
343}
344
345# Replace puts to catch errors (typically broken pipes when being piped to head)
346rename puts tcl::puts
347proc puts {args} {
348    catch "tcl::puts $args"
349}
350
351# find a binary either in a path defined at MacPorts' configuration time
352# or in the PATH environment variable through macports::binaryInPath (fallback)
353proc macports::findBinary {prog {autoconf_hint {}}} {
354    if {$autoconf_hint ne "" && [file executable $autoconf_hint]} {
355        return $autoconf_hint
356    } else {
357        try -pass_signal {
358            set cmd_path [macports::binaryInPath $prog]
359            return $cmd_path
360        } catch {{*} eCode eMessage} {
361            error "$eMessage or at its MacPorts configuration time location, did you move it?"
362        }
363    }
364}
365
366# check for a binary in the path
367# returns an error code if it cannot be found
368proc macports::binaryInPath {prog} {
369    global env
370    foreach dir [split $env(PATH) :] {
371        if {[file executable [file join $dir $prog]]} {
372            return [file join $dir $prog]
373        }
374    }
375    return -code error [format [msgcat::mc "Failed to locate '%s' in path: '%s'"] $prog $env(PATH)];
376}
377
378# deferred option processing
379proc macports::getoption {name} {
380    global macports::$name
381    return [set $name]
382}
383
384# deferred and on-need extraction of xcodeversion and xcodebuildcmd.
385proc macports::setxcodeinfo {name1 name2 op} {
386    global macports::xcodeversion macports::xcodebuildcmd
387
388    trace remove variable macports::xcodeversion read macports::setxcodeinfo
389    trace remove variable macports::xcodebuildcmd read macports::setxcodeinfo
390
391    try -pass_signal {
392        findBinary xcodebuild $macports::autoconf::xcodebuild_path
393        if {![info exists xcodeversion]} {
394            # Determine xcode version
395            set macports::xcodeversion 2.0orlower
396            try -pass_signal {
397                set xcodebuildversion [exec -- $xcodebuild -version 2> /dev/null]
398                if {[regexp {Xcode ([0-9.]+)} $xcodebuildversion - xcode_v] == 1} {
399                    set macports::xcodeversion $xcode_v
400                } elseif {[regexp {DevToolsCore-(.*);} $xcodebuildversion - devtoolscore_v] == 1} {
401                    if {$devtoolscore_v >= 1809.0} {
402                        set macports::xcodeversion 3.2.6
403                    } elseif {$devtoolscore_v >= 1204.0} {
404                        set macports::xcodeversion 3.1.4
405                    } elseif {$devtoolscore_v >= 1100.0} {
406                        set macports::xcodeversion 3.1
407                    } elseif {$devtoolscore_v >= 921.0} {
408                        set macports::xcodeversion 3.0
409                    } elseif {$devtoolscore_v >= 798.0} {
410                        set macports::xcodeversion 2.5
411                    } elseif {$devtoolscore_v >= 762.0} {
412                        set macports::xcodeversion 2.4.1
413                    } elseif {$devtoolscore_v >= 757.0} {
414                        set macports::xcodeversion 2.4
415                    } elseif {$devtoolscore_v > 650.0} {
416                        # XXX find actual version corresponding to 2.3
417                        set macports::xcodeversion 2.3
418                    } elseif {$devtoolscore_v >= 650.0} {
419                        set macports::xcodeversion 2.2.1
420                    } elseif {$devtoolscore_v > 620.0} {
421                        # XXX find actual version corresponding to 2.2
422                        set macports::xcodeversion 2.2
423                    } elseif {$devtoolscore_v >= 620.0} {
424                        set macports::xcodeversion 2.1
425                    }
426                }
427            } catch {*} {
428                ui_warn "xcodebuild exists but failed to execute"
429                set macports::xcodeversion none
430            }
431        }
432        if {![info exists xcodebuildcmd]} {
433            set macports::xcodebuildcmd $xcodebuild
434        }
435    } catch {*} {
436        if {![info exists xcodeversion]} {
437            set macports::xcodeversion none
438        }
439        if {![info exists xcodebuildcmd]} {
440            set macports::xcodebuildcmd none
441        }
442    }
443}
444
445# deferred calculation of developer_dir
446proc macports::set_developer_dir {name1 name2 op} {
447    global macports::developer_dir macports::os_major macports::xcodeversion
448
449    trace remove variable macports::developer_dir read macports::set_developer_dir
450
451    # Look for xcodeselect, and make sure it has a valid value
452    try -pass_signal {
453        findBinary xcode-select $macports::autoconf::xcode_select_path
454
455        # We have xcode-select: ask it where xcode is and check if it's valid.
456        # If no xcode is selected, xcode-select will fail, so catch that
457        try -pass_signal {
458            set devdir [exec $xcodeselect -print-path 2> /dev/null]
459            if {[_is_valid_developer_dir $devdir]} {
460                set macports::developer_dir $devdir
461                return
462            }
463        } catch {*} {}
464
465        # The directory from xcode-select isn't correct.
466
467        # Ask mdfind where Xcode is and make some suggestions for the user,
468        # searching by bundle identifier for various Xcode versions (3.x and 4.x)
469        set installed_xcodes {}
470
471        try -pass_signal {
472            findBinary mdfind $macports::autoconf::mdfind_path
473            set installed_xcodes [exec $mdfind "kMDItemCFBundleIdentifier == 'com.apple.Xcode' || kMDItemCFBundleIdentifier == 'com.apple.dt.Xcode'"]
474        } catch {*} {}
475
476        # In case mdfind metadata wasn't complete, also look in two well-known locations for Xcode.app
477        foreach app {/Applications/Xcode.app /Developer/Applications/Xcode.app} {
478            if {[file isdirectory $app]} {
479                lappend installed_xcodes $app
480            }
481        }
482
483        # Form a list of unique xcode installations
484        set installed_xcodes [lsort -unique $installed_xcodes]
485
486        # Present instructions to the user
487        ui_error
488        try -pass_signal {
489            if {[llength $installed_xcodes] == 0} {
490                error "No Xcode installation was found."
491            }
492
493            findBinary mdls $macports::autoconf::mdls_path
494
495            # One, or more than one, Xcode installations found
496            ui_error "No valid Xcode installation is properly selected."
497            ui_error "Please use xcode-select to select an Xcode installation:"
498            foreach xcode $installed_xcodes {
499                set vers [exec $mdls -raw -name kMDItemVersion $xcode]
500                if {$vers eq {(null)}} {set vers unknown}
501                if {[_is_valid_developer_dir ${xcode}/Contents/Developer]} {
502                    # Though xcode-select shipped with xcode 4.3 supports and encourages
503                    # direct use of the app path, older xcode-select does not.
504                    # Specify the Contents/Developer directory if it exists
505                    ui_error "    sudo xcode-select -switch ${xcode}/Contents/Developer # version $vers"
506                } elseif {[vercmp $vers 4.3] >= 0} {
507                    # Future proofing: fall back to the app-path only for xcode >= 4.3, since Contents/Developer doesn't exist
508                    ui_error "    sudo xcode-select -switch $xcode # version $vers"
509                } elseif {[_is_valid_developer_dir ${xcode}/../..]} {
510                    # Older xcode (< 4.3) is below the developer directory
511                    ui_error "    sudo xcode-select -switch [file normalize ${xcode}/../..] # version $vers"
512                } else {
513                    ui_error "    # malformed Xcode at ${xcode}, version $vers"
514                }
515            }
516        } catch {*} {
517            ui_error "No Xcode installation was found."
518            ui_error "Please install Xcode and/or run xcode-select to specify its location."
519        }
520        ui_error
521    } catch {*} {}
522
523    # Try the default
524    if {$os_major >= 11 && [vercmp $xcodeversion 4.3] >= 0} {
525        set devdir /Applications/Xcode.app/Contents/Developer
526    } else {
527        set devdir /Developer
528    }
529
530    set macports::developer_dir $devdir
531}
532
533proc macports::_is_valid_developer_dir {dir} {
534    # Check whether specified directory looks valid for an Xcode installation
535
536    # Verify that the directory exists
537    if {![file isdirectory $dir]} {
538        return 0
539    }
540
541    # Verify that the directory has some key subdirectories
542    foreach subdir {Library usr} {
543        if {![file isdirectory ${dir}/$subdir]} {
544            return 0
545        }
546    }
547
548    # The specified directory seems valid for Xcode
549    return 1
550}
551
552
553proc mportinit {{up_ui_options {}} {up_options {}} {up_variations {}}} {
554    if {$up_ui_options eq {}} {
555        array set macports::ui_options {}
556    } else {
557        upvar $up_ui_options temp_ui_options
558        array set macports::ui_options [array get temp_ui_options]
559    }
560    if {$up_options eq {}} {
561        array set macports::global_options {}
562    } else {
563        upvar $up_options temp_options
564        array set macports::global_options [array get temp_options]
565    }
566    if {$up_variations eq {}} {
567        array set variations {}
568    } else {
569        upvar $up_variations variations
570    }
571
572    # Initialize ui_*
573    foreach priority $macports::ui_priorities {
574        macports::ui_init $priority
575    }
576
577    package require Pextlib 1.0
578    package require registry 1.0
579    package require registry2 2.0
580    package require machista 1.0
581
582    global auto_path env tcl_platform \
583        macports::autoconf::macports_conf_path \
584        macports::macports_user_dir \
585        macports::bootstrap_options \
586        macports::user_options \
587        macports::portconf \
588        macports::portsharepath \
589        macports::registry.format \
590        macports::registry.path \
591        macports::sources \
592        macports::sources_default \
593        macports::destroot_umask \
594        macports::prefix \
595        macports::macportsuser \
596        macports::prefix_frozen \
597        macports::xcodebuildcmd \
598        macports::xcodeversion \
599        macports::configureccache \
600        macports::ccache_dir \
601        macports::ccache_size \
602        macports::configuredistcc \
603        macports::configurepipe \
604        macports::buildnicevalue \
605        macports::buildmakejobs \
606        macports::universal_archs \
607        macports::build_arch \
608        macports::os_arch \
609        macports::os_endian \
610        macports::os_version \
611        macports::os_major \
612        macports::os_minor \
613        macports::os_platform \
614        macports::macosx_version \
615        macports::macosx_sdk_version \
616        macports::macosx_deployment_target \
617        macports::archivefetch_pubkeys \
618        macports::ping_cache \
619        macports::host_blacklisted \
620        macports::host_preferred \
621        macports::delete_la_files \
622        macports::cxx_stdlib
623
624    # Set the system encoding to utf-8
625    encoding system utf-8
626
627    # Set up signal handling for SIGTERM and SIGINT
628    # Specifying error here will case the program to abort where it is with
629    # a Tcl error, which can be caught, if necessary.
630    signal -restart error {TERM INT}
631
632    # set up platform info variables
633    set os_arch $tcl_platform(machine)
634    if {$os_arch eq "Power Macintosh"} {set os_arch "powerpc"}
635    if {$os_arch eq "i586" || $os_arch eq "i686" || $os_arch eq "x86_64"} {set os_arch "i386"}
636    set os_version $tcl_platform(osVersion)
637    set os_major [lindex [split $os_version .] 0]
638    set os_minor [lindex [split $os_version .] 1]
639    set os_platform [string tolower $tcl_platform(os)]
640    # Remove trailing "Endian"
641    set os_endian [string range $tcl_platform(byteOrder) 0 end-6]
642    set macosx_version {}
643    if {$os_platform eq "darwin" && [file executable /usr/bin/sw_vers]} {
644
645        try -pass_signal {
646            set macosx_version [exec /usr/bin/sw_vers -productVersion | cut -f1,2 -d.]
647        } catch {*} {
648            ui_debug "sw_vers exists but running it failed: $result"
649        }
650    }
651
652    # Check that the current platform is the one we were configured for, otherwise need to do migration
653    if {($os_platform ne $macports::autoconf::os_platform) || ($os_major != $macports::autoconf::os_major)} {
654        ui_error "Current platform \"$os_platform $os_major\" does not match expected platform \"$macports::autoconf::os_platform $macports::autoconf::os_major\""
655        ui_error "If you upgraded your OS, please follow the migration instructions: https://trac.macports.org/wiki/Migration"
656        return -code error "OS platform mismatch"
657    }
658
659    # Ensure that the macports user directory (i.e. ~/.macports) exists if HOME is defined.
660    # Also save $HOME for later use before replacing it with our own.
661    if {[info exists env(HOME)]} {
662        set macports::user_home $env(HOME)
663        set macports::macports_user_dir [file normalize $macports::autoconf::macports_user_dir]
664    } elseif {[info exists env(SUDO_USER)] && $os_platform eq "darwin"} {
665        set macports::user_home [exec dscl -q . -read /Users/$env(SUDO_USER) NFSHomeDirectory | cut -d ' ' -f 2]
666        set macports::macports_user_dir [file join $macports::user_home [string range $macports::autoconf::macports_user_dir 2 end]]
667    } elseif {[exec id -u] != 0 && $os_platform eq "darwin"} {
668        set macports::user_home [exec dscl -q . -read /Users/[exec id -un] NFSHomeDirectory | cut -d ' ' -f 2]
669        set macports::macports_user_dir [file join $macports::user_home [string range $macports::autoconf::macports_user_dir 2 end]]
670    } else {
671        # Otherwise define the user directory as a directory that will never exist
672        set macports::macports_user_dir /dev/null/NO_HOME_DIR
673        set macports::user_home /dev/null/NO_HOME_DIR
674    }
675
676    # Save the path for future processing
677    set macports::user_path $env(PATH)
678
679    # Configure the search path for configuration files
680    set conf_files {}
681    lappend conf_files ${macports_conf_path}/macports.conf
682    if {[file isdirectory $macports_user_dir]} {
683        lappend conf_files ${macports_user_dir}/macports.conf
684    }
685    if {[info exists env(PORTSRC)]} {
686        set PORTSRC $env(PORTSRC)
687        lappend conf_files $PORTSRC
688    }
689
690    # Process all configuration files we find on conf_files list
691    foreach file $conf_files {
692        if {[file exists $file]} {
693            set portconf $file
694            set fd [open $file r]
695            while {[gets $fd line] >= 0} {
696                if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
697                    if {$option in $bootstrap_options} {
698                        set macports::$option [string trim $val]
699                        global macports::$option
700                    }
701                }
702            }
703            close $fd
704        }
705    }
706
707    # Process per-user only settings
708    set per_user ${macports_user_dir}/user.conf
709    if {[file exists $per_user]} {
710        set fd [open $per_user r]
711        while {[gets $fd line] >= 0} {
712            if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
713                if {$option in $user_options} {
714                    set macports::$option $val
715                    global macports::$option
716                }
717            }
718        }
719        close $fd
720    }
721
722    if {![info exists sources_conf]} {
723        return -code error "sources_conf must be set in ${macports_conf_path}/macports.conf or in your ${macports_user_dir}/macports.conf file"
724    }
725    set fd [open $sources_conf r]
726    while {[gets $fd line] >= 0} {
727        set line [string trimright $line]
728        if {![regexp {^\s*#|^$} $line]} {
729            if {[regexp {^([\w-]+://\S+)(?:\s+\[(\w+(?:,\w+)*)\])?$} $line _ url flags]} {
730                set flags [split $flags ,]
731                foreach flag $flags {
732                    if {$flag ni [list nosync default]} {
733                        ui_warn "$sources_conf source '$line' specifies invalid flag '$flag'"
734                    }
735                    if {$flag eq "default"} {
736                        if {[info exists sources_default]} {
737                            ui_warn "More than one default port source is defined."
738                        }
739                        set sources_default [concat [list $url] $flags]
740                    }
741                }
742                lappend sources [concat [list $url] $flags]
743            } else {
744                ui_warn "$sources_conf specifies invalid source '$line', ignored."
745            }
746        }
747    }
748    close $fd
749    # Make sure the default port source is defined. Otherwise
750    # [macports::getportresourcepath] fails when the first source doesn't
751    # contain _resources.
752    if {![info exists sources_default]} {
753        ui_warn "No default port source specified in ${sources_conf}, using last source as default"
754        set sources_default [lindex $sources end]
755    }
756
757    if {![info exists sources]} {
758        if {[file isdirectory ports]} {
759            set sources file://[pwd]/ports
760        } else {
761            return -code error "No sources defined in $sources_conf"
762        }
763    }
764
765    if {[info exists variants_conf]} {
766        if {[file exists $variants_conf]} {
767            set fd [open $variants_conf r]
768            while {[gets $fd line] >= 0} {
769                set line [string trimright $line]
770                if {![regexp {^[\ \t]*#.*$|^$} $line]} {
771                    foreach arg [split $line " \t"] {
772                        if {[regexp {^([-+])([-A-Za-z0-9_+\.]+)$} $arg match sign opt] == 1} {
773                            if {![info exists variations($opt)]} {
774                                set variations($opt) $sign
775                            }
776                        } else {
777                            ui_warn "$variants_conf specifies invalid variant syntax '$arg', ignored."
778                        }
779                    }
780                }
781            }
782            close $fd
783        } else {
784            ui_debug "$variants_conf does not exist, variants_conf setting ignored."
785        }
786    }
787    global macports::global_variations
788    array set macports::global_variations [array get variations]
789
790    # pubkeys.conf
791    set macports::archivefetch_pubkeys {}
792    if {[file isfile [file join $macports_conf_path pubkeys.conf]]} {
793        set fd [open [file join $macports_conf_path pubkeys.conf] r]
794        while {[gets $fd line] >= 0} {
795            set line [string trim $line]
796            if {![regexp {^[\ \t]*#.*$|^$} $line]} {
797                lappend macports::archivefetch_pubkeys $line
798            }
799        }
800        close $fd
801    } else {
802        ui_debug "pubkeys.conf does not exist."
803    }
804
805    if {![info exists portdbpath]} {
806        return -code error "portdbpath must be set in ${macports_conf_path}/macports.conf or in your ${macports_user_dir}/macports.conf"
807    }
808    if {![file isdirectory $portdbpath]} {
809        if {![file exists $portdbpath]} {
810            if {[catch {file mkdir $portdbpath} result]} {
811                return -code error "portdbpath $portdbpath does not exist and could not be created: $result"
812            }
813        } else {
814            return -code error "$portdbpath is not a directory. Please create the directory $portdbpath and try again"
815        }
816    }
817
818    set env(HOME) [file join $portdbpath home]
819    set registry.path $portdbpath
820
821    # Format for receipts; currently only "sqlite" is allowed
822    # could previously be "flat", so we switch that to sqlite
823    if {![info exists portdbformat] || $portdbformat eq "flat" || $portdbformat eq "sqlite"} {
824        set registry.format receipt_sqlite
825    } else {
826        return -code error "unknown registry format '$portdbformat' set in macports.conf"
827    }
828
829    # Autoclean mode, whether to automatically call clean after "install"
830    if {![info exists portautoclean]} {
831        set macports::portautoclean yes
832        global macports::portautoclean
833    }
834    # whether to keep logs after successful builds
835    if {![info exists keeplogs]} {
836        set macports::keeplogs no
837        global macports::keeplogs
838    }
839
840    # Check command line override for autoclean
841    if {[info exists macports::global_options(ports_autoclean)]} {
842        if {$macports::global_options(ports_autoclean) ne $portautoclean} {
843            set macports::portautoclean $macports::global_options(ports_autoclean)
844        }
845    }
846    # Trace mode, whether to use darwintrace to debug ports.
847    if {![info exists porttrace]} {
848        set macports::porttrace no
849        global macports::porttrace
850    }
851    # Check command line override for trace
852    if {[info exists macports::global_options(ports_trace)]} {
853        if {$macports::global_options(ports_trace) ne $porttrace} {
854            set macports::porttrace $macports::global_options(ports_trace)
855        }
856    }
857    # Check command line override for source/binary only mode
858    if {![info exists macports::global_options(ports_binary_only)]
859        && ![info exists macports::global_options(ports_source_only)]
860        && [info exists macports::buildfromsource]} {
861        if {$macports::buildfromsource eq "never"} {
862            set macports::global_options(ports_binary_only) yes
863            set temp_options(ports_binary_only) yes
864        } elseif {$macports::buildfromsource eq "always"} {
865            set macports::global_options(ports_source_only) yes
866            set temp_options(ports_source_only) yes
867        } elseif {$macports::buildfromsource ne "ifneeded"} {
868            ui_warn "'buildfromsource' set to unknown value '$macports::buildfromsource', using 'ifneeded' instead"
869        }
870    }
871
872    # Duplicate prefix into prefix_frozen, so that port actions
873    # can always get to the original prefix, even if a portfile overrides prefix
874    set macports::prefix_frozen $prefix
875
876    if {![info exists macports::applications_dir]} {
877        set macports::applications_dir /Applications/MacPorts
878    }
879
880    # Export verbosity.
881    if {![info exists portverbose]} {
882        set macports::portverbose no
883        global macports::portverbose
884    }
885    if {[info exists macports::ui_options(ports_verbose)]} {
886        if {$macports::ui_options(ports_verbose) ne $portverbose} {
887            set macports::portverbose $macports::ui_options(ports_verbose)
888        }
889    }
890
891    # Set noninteractive mode if specified in config
892    if {[info exists ui_interactive] && !$ui_interactive} {
893        set macports::ui_options(ports_noninteractive) yes
894        unset -nocomplain macports::ui_options(questions_yesno) macports::ui_options(questions_singlechoice) macports::ui_options(questions_multichoice)
895    }
896
897    # Archive type, what type of binary archive to use (CPIO, gzipped
898    # CPIO, XAR, etc.)
899    global macports::portarchivetype
900    if {![info exists portarchivetype]} {
901        set macports::portarchivetype tbz2
902    } else {
903        set macports::portarchivetype [lindex $portarchivetype 0]
904    }
905
906    # Set rync options
907    if {![info exists rsync_server]} {
908        global macports::rsync_server
909        set macports::rsync_server rsync.macports.org
910    }
911    if {![info exists rsync_dir]} {
912        global macports::rsync_dir
913        set macports::rsync_dir release/tarballs/base.tar
914    }
915    if {![info exists rsync_options]} {
916        global macports::rsync_options
917        set rsync_options "-rtzv --delete-after"
918    }
919
920    set portsharepath ${prefix}/share/macports
921    if {![file isdirectory $portsharepath]} {
922        return -code error "Data files directory '$portsharepath' must exist"
923    }
924
925    if {![info exists binpath]} {
926        set env(PATH) ${prefix}/bin:${prefix}/sbin:/bin:/sbin:/usr/bin:/usr/sbin
927    } else {
928        set env(PATH) $binpath
929    }
930
931    # Set startupitem default type (can be overridden by portfile)
932    if {![info exists macports::startupitem_type]} {
933        set macports::startupitem_type default
934    }
935
936    # Set whether startupitems are symlinked into system directories
937    if {![info exists macports::startupitem_install]} {
938        set macports::startupitem_install yes
939    }
940
941    # Default place_worksymlink
942    if {![info exists macports::place_worksymlink]} {
943        set macports::place_worksymlink yes
944    }
945
946    # Default mp configure options
947    if {![info exists macports::configureccache]} {
948        set macports::configureccache no
949    }
950    if {![info exists macports::ccache_dir]} {
951        set macports::ccache_dir [file join $portdbpath build .ccache]
952    }
953    if {![info exists macports::ccache_size]} {
954        set macports::ccache_size 2G
955    }
956    if {![info exists macports::configuredistcc]} {
957        set macports::configuredistcc no
958    }
959    if {![info exists macports::configurepipe]} {
960        set macports::configurepipe yes
961    }
962
963    # Default mp build options
964    if {![info exists macports::buildnicevalue]} {
965        set macports::buildnicevalue 0
966    }
967    if {![info exists macports::buildmakejobs]} {
968        set macports::buildmakejobs 0
969    }
970
971    # default user to run as when privileges can be dropped
972    if {![info exists macports::macportsuser]} {
973        set macports::macportsuser $macports::autoconf::macportsuser
974    }
975
976    # Default mp universal options
977    if {![info exists macports::universal_archs]} {
978        if {$os_major >= 10} {
979            set macports::universal_archs {x86_64 i386}
980        } else {
981            set macports::universal_archs {i386 ppc}
982        }
983    } elseif {[llength $macports::universal_archs] < 2} {
984        ui_warn "invalid universal_archs configured (should contain at least 2 archs)"
985    }
986
987    # Default arch to build for
988    if {![info exists macports::build_arch]} {
989        if {$os_platform eq "darwin"} {
990            if {$os_major >= 10} {
991                if {[sysctl hw.cpu64bit_capable] == 1} {
992                    set macports::build_arch x86_64
993                } else {
994                    set macports::build_arch i386
995                }
996            } else {
997                if {$os_arch eq "powerpc"} {
998                    set macports::build_arch ppc
999                } else {
1000                    set macports::build_arch i386
1001                }
1002            }
1003        } else {
1004            set macports::build_arch {}
1005        }
1006    } else {
1007        set macports::build_arch [lindex $macports::build_arch 0]
1008    }
1009
1010    if {![info exists macports::macosx_deployment_target]} {
1011        set macports::macosx_deployment_target $macosx_version
1012    }
1013    if {![info exists macports::macosx_sdk_version]} {
1014        set macports::macosx_sdk_version $macosx_version
1015    }
1016
1017    if {![info exists macports::revupgrade_autorun]} {
1018        set macports::revupgrade_autorun yes
1019    }
1020    if {![info exists macports::revupgrade_mode]} {
1021        set macports::revupgrade_mode rebuild
1022    }
1023    if {![info exists macports::delete_la_files]} {
1024        if {$os_platform eq "darwin" && $os_major >= 13} {
1025            set macports::delete_la_files yes
1026        } else {
1027            set macports::delete_la_files no
1028        }
1029    }
1030    if {![info exists macports::cxx_stdlib]} {
1031        if {$os_platform eq "darwin" && $os_major >= 13} {
1032            set macports::cxx_stdlib libc++
1033        } elseif {$os_platform eq "darwin"} {
1034            set macports::cxx_stdlib libstdc++
1035        } else {
1036            set macports::cxx_stdlib {}
1037        }
1038    }
1039    if {![info exists macports::global_options(ports_rev-upgrade_id-loadcmd-check)]
1040         && [info exists macports::revupgrade_check_id_loadcmds]} {
1041        set macports::global_options(ports_rev-upgrade_id-loadcmd-check) $macports::revupgrade_check_id_loadcmds
1042        set temp_options(ports_rev-upgrade_id-loadcmd-check) $macports::revupgrade_check_id_loadcmds
1043    }
1044
1045    if {![info exists macports::sandbox_enable]} {
1046        set macports::sandbox_enable yes
1047    }
1048
1049    # make tools we run operate in UTF-8 mode
1050    set env(LANG) en_US.UTF-8
1051
1052    # ENV cleanup.
1053    set keepenvkeys {
1054        DISPLAY DYLD_FALLBACK_FRAMEWORK_PATH
1055        DYLD_FALLBACK_LIBRARY_PATH DYLD_FRAMEWORK_PATH
1056        DYLD_LIBRARY_PATH DYLD_INSERT_LIBRARIES
1057        HOME JAVA_HOME MASTER_SITE_LOCAL ARCHIVE_SITE_LOCAL
1058        PATCH_SITE_LOCAL PATH PORTSRC RSYNC_PROXY
1059        USER GROUP LANG
1060        http_proxy HTTPS_PROXY FTP_PROXY ALL_PROXY NO_PROXY
1061        COLUMNS LINES
1062    }
1063    if {[info exists extra_env]} {
1064        set keepenvkeys [concat $keepenvkeys $extra_env]
1065    }
1066
1067    # set the hidden flag on $portdbpath to avoid spotlight indexing, which
1068    # might slow builds down considerably. You can avoid this by touching
1069    # $portdbpath/.nohide.
1070    if {$os_platform eq "darwin" && [vercmp [info tclversion] 8.5] >= 0 && ![file exists [file join $portdbpath .nohide]] && [file writable $portdbpath] && [file attributes $portdbpath -hidden] == 0} {
1071        try -pass_signal {
1072            file attributes $portdbpath -hidden yes
1073        } catch {{*} eCode eMessage} {
1074            ui_debug "error setting hidden flag for $portdbpath: $eMessage"
1075        }
1076    }
1077
1078    # don't keep unusable TMPDIR/TMP values
1079    foreach var {TMP TMPDIR} {
1080        if {[info exists env($var)] && [file writable $env($var)] &&
1081            ([getuid] != 0 || $macportsuser eq "root" ||
1082             [file attributes $env($var) -owner] eq $macportsuser)} {
1083            lappend keepenvkeys $var
1084        }
1085    }
1086
1087    set env_names [array names env]
1088    foreach envkey $env_names {
1089        if {$envkey ni $keepenvkeys} {
1090            unset env($envkey)
1091        }
1092    }
1093
1094    if {![info exists xcodeversion] || ![info exists xcodebuildcmd]} {
1095        # We'll resolve these later (if needed)
1096        trace add variable macports::xcodeversion read macports::setxcodeinfo
1097        trace add variable macports::xcodebuildcmd read macports::setxcodeinfo
1098    }
1099
1100    if {![info exists developer_dir]} {
1101        if {$os_platform eq "darwin"} {
1102            trace add variable macports::developer_dir read macports::set_developer_dir
1103        } else {
1104            set macports::developer_dir {}
1105        }
1106    } else {
1107        if {$os_platform eq "darwin" && ![file isdirectory $developer_dir]} {
1108            ui_warn "Your developer_dir setting in macports.conf points to a non-existing directory.\
1109                Since this is known to cause problems, please correct the setting or comment it and let\
1110                macports auto-discover the correct path."
1111        }
1112    }
1113
1114    if {[getuid] == 0 && $os_major >= 11 && $os_platform eq "darwin" &&
1115            [file isfile "${macports::user_home}/Library/Preferences/com.apple.dt.Xcode.plist"]} {
1116        macports::copy_xcode_plist $env(HOME)
1117    }
1118
1119    # Set the default umask
1120    if {![info exists destroot_umask]} {
1121        set destroot_umask 022
1122    }
1123
1124    if {[info exists master_site_local] && ![info exists env(MASTER_SITE_LOCAL)]} {
1125        set env(MASTER_SITE_LOCAL) $master_site_local
1126    }
1127    if {[info exists patch_site_local] && ![info exists env(PATCH_SITE_LOCAL)]} {
1128        set env(PATCH_SITE_LOCAL) $patch_site_local
1129    }
1130    if {[info exists archive_site_local] && ![info exists env(ARCHIVE_SITE_LOCAL)]} {
1131        set env(ARCHIVE_SITE_LOCAL) $archive_site_local
1132    }
1133
1134    # Proxy handling (done this late since Pextlib is needed)
1135    if {![info exists proxy_override_env] || ![string is true -strict $proxy_override_env]} {
1136        set proxy_override_env no
1137    }
1138    if {[catch {array set sysConfProxies [get_systemconfiguration_proxies]} result]} {
1139        return -code error "Unable to get proxy configuration from system: $result"
1140    }
1141    if {![info exists env(http_proxy)] || $proxy_override_env} {
1142        if {[info exists proxy_http]} {
1143            set env(http_proxy) $proxy_http
1144        } elseif {[info exists sysConfProxies(proxy_http)]} {
1145            set env(http_proxy) $sysConfProxies(proxy_http)
1146        }
1147    }
1148    if {![info exists env(HTTPS_PROXY)] || $proxy_override_env} {
1149        if {[info exists proxy_https]} {
1150            set env(HTTPS_PROXY) $proxy_https
1151        } elseif {[info exists sysConfProxies(proxy_https)]} {
1152            set env(HTTPS_PROXY) $sysConfProxies(proxy_https)
1153        }
1154    }
1155    if {![info exists env(FTP_PROXY)] || $proxy_override_env} {
1156        if {[info exists proxy_ftp]} {
1157            set env(FTP_PROXY) $proxy_ftp
1158        } elseif {[info exists sysConfProxies(proxy_ftp)]} {
1159            set env(FTP_PROXY) $sysConfProxies(proxy_ftp)
1160        }
1161    }
1162    if {![info exists env(RSYNC_PROXY)] || $proxy_override_env} {
1163        if {[info exists proxy_rsync]} {
1164            set env(RSYNC_PROXY) $proxy_rsync
1165        }
1166    }
1167    if {![info exists env(NO_PROXY)] || $proxy_override_env} {
1168        if {[info exists proxy_skip]} {
1169            set env(NO_PROXY) $proxy_skip
1170        } elseif {[info exists sysConfProxies(proxy_skip)]} {
1171            set env(NO_PROXY) $sysConfProxies(proxy_skip)
1172        }
1173    }
1174
1175    # add ccache to environment
1176    set env(CCACHE_DIR) $macports::ccache_dir
1177
1178    # load cached ping times
1179    try -pass_signal {
1180        set pingfile -1
1181        set pingfile [open ${macports::portdbpath}/pingtimes r]
1182        array set macports::ping_cache [gets $pingfile]
1183    } catch {*} {
1184        array set macports::ping_cache {}
1185    } finally {
1186        if {$pingfile != -1} {
1187            close $pingfile
1188        }
1189    }
1190    # set up arrays of blacklisted and preferred hosts
1191    if {[info exists macports::host_blacklist]} {
1192        foreach host $macports::host_blacklist {
1193            set macports::host_blacklisted($host) 1
1194        }
1195    }
1196    if {[info exists macports::preferred_hosts]} {
1197        foreach host $macports::preferred_hosts {
1198            set macports::host_preferred($host) 1
1199        }
1200    }
1201
1202    # load the quick index
1203    _mports_load_quickindex
1204
1205    if {![info exists macports::ui_options(ports_no_old_index_warning)]} {
1206        set default_source_url [lindex $sources_default 0]
1207        if {[macports::getprotocol $default_source_url] eq "file" || [macports::getprotocol $default_source_url] eq "rsync"} {
1208            set default_portindex [macports::getindex $default_source_url]
1209            if {[file exists $default_portindex] && [clock seconds] - [file mtime $default_portindex] > 1209600} {
1210                ui_warn "port definitions are more than two weeks old, consider updating them by running 'port selfupdate'."
1211            }
1212        }
1213    }
1214
1215    # init registry
1216    set db_path [file join ${registry.path} registry registry.db]
1217    set db_exists [file exists $db_path]
1218    registry::open $db_path
1219    # for the benefit of the portimage code that is called from multiple interpreters
1220    global registry_open
1221    set registry_open yes
1222    # convert any flat receipts if we just created a new db
1223    if {$db_exists == 0 && [file exists ${registry.path}/receipts] && [file writable $db_path]} {
1224        ui_warn "Converting your registry to sqlite format, this might take a while..."
1225        # XXX: catch, leave unfixed, code should go away.
1226        if {[catch {registry::convert_to_sqlite}]} {
1227            ui_debug $::errorInfo
1228            file delete -force $db_path
1229            error "Failed to convert your registry to sqlite!"
1230        } else {
1231            ui_warn "Successfully converted your registry to sqlite!"
1232        }
1233    }
1234}
1235
1236# call this just before you exit
1237proc mportshutdown {} {
1238    # save ping times
1239    global macports::ping_cache macports::portdbpath
1240    if {[file writable $macports::portdbpath]} {
1241        catch {
1242            foreach host [array names ping_cache] {
1243                # don't save expired entries
1244                if {[clock seconds] - [lindex $ping_cache($host) 1] < 86400} {
1245                    lappend pinglist_fresh $host $ping_cache($host)
1246                }
1247            }
1248            set pingfile [open ${macports::portdbpath}/pingtimes w]
1249            puts $pingfile $pinglist_fresh
1250            close $pingfile
1251        }
1252    }
1253    # close it down so the cleanup stuff is called, e.g. vacuuming the db
1254    registry::close
1255
1256    # Check the last time 'reclaim' was run
1257    if {![macports::ui_isset ports_quiet]} {
1258        reclaim::check_last_run
1259    }
1260}
1261
1262# link plist for xcode 4.3's benefit
1263proc macports::copy_xcode_plist {target_homedir} {
1264    global macports::user_home macports::macportsuser
1265    set user_plist "${user_home}/Library/Preferences/com.apple.dt.Xcode.plist"
1266    set target_dir "${target_homedir}/Library/Preferences"
1267    file delete -force "${target_dir}/com.apple.dt.Xcode.plist"
1268    if {[file isfile $user_plist]} {
1269        if {![file isdirectory $target_dir]} {
1270            if {[catch {file mkdir $target_dir} result]} {
1271                ui_warn "Failed to create Library/Preferences in ${target_homedir}: $result"
1272                return
1273            }
1274        }
1275        if {[file writable $target_dir] && [catch {
1276            ui_debug "Copying $user_plist to $target_dir"
1277            file copy -force $user_plist $target_dir
1278            file attributes ${target_dir}/com.apple.dt.Xcode.plist -owner $macportsuser -permissions 0644
1279        } result]} {
1280            ui_warn "Failed to copy com.apple.dt.Xcode.plist to ${target_dir}: $result"
1281        }
1282    }
1283}
1284
1285proc macports::worker_init {workername portpath porturl portbuildpath options variations} {
1286    global macports::portinterp_options macports::portinterp_deferred_options
1287
1288    # Hide any Tcl commands that should be inaccessible to port1.0 and Portfiles
1289    # exit: It should not be possible to exit the interpreter
1290    interp hide $workername exit
1291
1292    # cd: This is necessary for some code in port1.0, but should be hidden
1293    interp eval $workername "rename cd _cd"
1294
1295    # Tell the sub interpreter about all the Tcl packages we already
1296    # know about so it won't glob for packages.
1297    foreach pkgName [package names] {
1298        foreach pkgVers [package versions $pkgName] {
1299            set pkgLoadScript [package ifneeded $pkgName $pkgVers]
1300            $workername eval "package ifneeded $pkgName $pkgVers {$pkgLoadScript}"
1301        }
1302    }
1303
1304    # Create package require abstraction procedure
1305    $workername eval "proc PortSystem \{version\} \{ \n\
1306            package require port \$version \}"
1307
1308    # Clearly separate slave interpreters and the master interpreter.
1309    $workername alias mport_exec mportexec
1310    $workername alias mport_open mportopen
1311    $workername alias mport_close mportclose
1312    $workername alias mport_lookup mportlookup
1313    $workername alias mport_info mportinfo
1314    $workername alias set_phase set_phase
1315
1316    # instantiate the UI call-backs
1317    foreach priority $macports::ui_priorities {
1318        $workername alias ui_$priority ui_$priority
1319    }
1320    # add the UI progress call-back
1321    if {[info exists macports::ui_options(progress_download)]} {
1322        $workername alias ui_progress_download $macports::ui_options(progress_download)
1323    }
1324
1325    # notifications callback
1326    if {[info exists macports::ui_options(notifications_append)]} {
1327        $workername alias ui_notifications_append $macports::ui_options(notifications_append)
1328    } else {
1329        # provide a no-op if notifications_append wasn't set. See http://wiki.tcl.tk/3044
1330        $workername alias ui_notifications_append return -level 0
1331    }
1332
1333    $workername alias ui_prefix ui_prefix
1334    $workername alias ui_channels ui_channels
1335
1336    $workername alias ui_warn_once ui_warn_once
1337
1338    # Export some utility functions defined here.
1339    $workername alias macports_version macports::version
1340    $workername alias macports_create_thread macports::create_thread
1341    $workername alias getportworkpath_from_buildpath macports::getportworkpath_from_buildpath
1342    $workername alias getportresourcepath macports::getportresourcepath
1343    $workername alias getportlogpath macports::getportlogpath
1344    $workername alias getdefaultportresourcepath macports::getdefaultportresourcepath
1345    $workername alias getprotocol macports::getprotocol
1346    $workername alias getportdir macports::getportdir
1347    $workername alias findBinary macports::findBinary
1348    $workername alias binaryInPath macports::binaryInPath
1349    $workername alias sysctl sysctl
1350    $workername alias realpath realpath
1351    $workername alias _mportsearchpath _mportsearchpath
1352    $workername alias _portnameactive _portnameactive
1353
1354    # New Registry/Receipts stuff
1355    $workername alias registry_new registry::new_entry
1356    $workername alias registry_open registry::open_entry
1357    $workername alias registry_write registry::write_entry
1358    $workername alias registry_prop_store registry::property_store
1359    $workername alias registry_prop_retr registry::property_retrieve
1360    $workername alias registry_exists registry::entry_exists
1361    $workername alias registry_exists_for_name registry::entry_exists_for_name
1362    $workername alias registry_activate portimage::activate
1363    $workername alias registry_deactivate portimage::deactivate
1364    $workername alias registry_deactivate_composite portimage::deactivate_composite
1365    $workername alias registry_uninstall registry_uninstall::uninstall
1366    $workername alias registry_register_deps registry::register_dependencies
1367    $workername alias registry_fileinfo_for_index registry::fileinfo_for_index
1368    $workername alias registry_fileinfo_for_file registry::fileinfo_for_file
1369    $workername alias registry_bulk_register_files registry::register_bulk_files
1370    $workername alias registry_active registry::active
1371    $workername alias registry_file_registered registry::file_registered
1372    $workername alias registry_port_registered registry::port_registered
1373    $workername alias registry_list_depends registry::list_depends
1374
1375    # deferred options processing.
1376    $workername alias getoption macports::getoption
1377
1378    # ping cache
1379    $workername alias get_pingtime macports::get_pingtime
1380    $workername alias set_pingtime macports::set_pingtime
1381
1382    # archive_sites.conf handling
1383    $workername alias get_archive_sites_conf_values macports::get_archive_sites_conf_values
1384
1385    foreach opt $portinterp_options {
1386        if {![info exists $opt]} {
1387            global macports::$opt
1388        }
1389        if {[info exists $opt]} {
1390            $workername eval set system_options($opt) \{[set $opt]\}
1391            $workername eval set $opt \{[set $opt]\}
1392        }
1393    }
1394
1395    foreach opt $portinterp_deferred_options {
1396        global macports::$opt
1397        # define the trace hook.
1398        $workername eval \
1399            "proc trace_$opt {name1 name2 op} { \n\
1400                trace remove variable ::$opt read ::trace_$opt \n\
1401                global $opt \n\
1402                set $opt \[getoption $opt\] \n\
1403            }"
1404        # next access will actually define the variable.
1405        $workername eval "trace add variable ::$opt read ::trace_$opt"
1406        # define some value now
1407        $workername eval set $opt ?
1408    }
1409
1410    foreach {opt val} $options {
1411        $workername eval set user_options($opt) $val
1412        $workername eval set $opt $val
1413    }
1414
1415    foreach {var val} $variations {
1416        $workername eval set variations($var) $val
1417    }
1418}
1419
1420# Create a thread with most configuration options set.
1421# The newly created thread is sent portinterp_options vars and knows where to
1422# find all packages we know.
1423proc macports::create_thread {} {
1424    package require Thread
1425
1426    global macports::portinterp_options
1427
1428    # Create the thread.
1429    set result [thread::create -preserved {thread::wait}]
1430
1431    # Tell the thread about all the Tcl packages we already
1432    # know about so it won't glob for packages.
1433    foreach pkgName [package names] {
1434        foreach pkgVers [package versions $pkgName] {
1435            set pkgLoadScript [package ifneeded $pkgName $pkgVers]
1436            thread::send -async $result "package ifneeded $pkgName $pkgVers {$pkgLoadScript}"
1437        }
1438    }
1439
1440    # inherit configuration variables.
1441    thread::send -async $result "namespace eval macports {}"
1442    foreach opt $portinterp_options {
1443        if {![info exists $opt]} {
1444            global macports::$opt
1445        }
1446        if {[info exists $opt]} {
1447            thread::send -async $result "global macports::$opt"
1448            set val [set macports::$opt]
1449            thread::send -async $result "set macports::$opt \"$val\""
1450        }
1451    }
1452
1453    return $result
1454}
1455
1456proc macports::get_tar_flags {suffix} {
1457    switch -- $suffix {
1458        .tbz -
1459        .tbz2 {
1460            return -j
1461        }
1462        .tgz {
1463            return -z
1464        }
1465        .txz {
1466            return "--use-compress-program [findBinary xz {}] -"
1467        }
1468        .tlz {
1469            return "--use-compress-program [findBinary lzma {}] -"
1470        }
1471        default {
1472            return -
1473        }
1474    }
1475}
1476
1477##
1478# Extracts a Portfile from a tarball pointed to by the given \a url to a path
1479# in \c $portdbpath and returns its path.
1480#
1481# @param url URL pointing to a tarball containing either a file named \c
1482#            Portfile at the root level -- in which case the tarball is
1483#            extracted completely, --  or a file named \c +CONTENTS at the root
1484#            level (i.e., the archive is a valid MacPorts binary archive), in
1485#            which case the Portfile is extracted from the file \c +PORTFILE
1486#            and put in a separate directory.
1487# @param local one, if the URL is local, zero otherwise
1488# @return a path to a directory containing the Portfile, or an error code
1489proc macports::fetch_port {url {local 0}} {
1490    global macports::portdbpath macports::ui_prefix macports::portverbose macports::ui_options
1491
1492    set fetchdir [file join $portdbpath portdirs]
1493    file mkdir $fetchdir
1494    if {![file writable $fetchdir]} {
1495        return -code error "Port remote fetch failed: You do not have permission to write to $fetchdir"
1496    }
1497
1498    if {$local} {
1499        set filepath $url
1500    } else {
1501        ui_msg "$macports::ui_prefix Fetching port $url"
1502        set fetchfile [file tail $url]
1503        set progressflag {}
1504        if {$macports::portverbose} {
1505            set progressflag "--progress builtin"
1506        } elseif {[info exists macports::ui_options(progress_download)]} {
1507            set progressflag "--progress ${macports::ui_options(progress_download)}"
1508        }
1509        set filepath [file join $fetchdir $fetchfile]
1510        if {[catch {curl fetch {*}$progressflag $url $filepath} result]} {
1511            return -code error "Port remote fetch failed: $result"
1512        }
1513    }
1514
1515    set oldpwd [pwd]
1516    cd $fetchdir
1517
1518    # check if this is a binary archive or just the port dir by checking
1519    # whether the file "+CONTENTS" exists.
1520    set tarcmd [findBinary tar $macports::autoconf::tar_path]
1521    set tarflags [get_tar_flags [file extension $filepath]]
1522    set qflag $macports::autoconf::tar_q
1523    set cmdline [list $tarcmd ${tarflags}${qflag}xOf $filepath +CONTENTS]
1524    ui_debug $cmdline
1525    if {![catch {set contents [exec {*}$cmdline]}]} {
1526        # the file is probably a valid binary archive
1527        set binary 1
1528        ui_debug "getting port name from binary archive"
1529        # get the portname from the contents file
1530        foreach line [split $contents \n] {
1531            if {[lindex $line 0] eq {@name}} {
1532                # actually ${name}-${version}_$revision
1533                set portname [lindex $line 1]
1534            }
1535        }
1536        ui_debug "port name is '$portname'"
1537
1538        # create a correctly-named directory and put the Portfile there
1539        file mkdir $portname
1540        cd $portname
1541    } else {
1542        # the file is not a valid binary archive, assume it's an archive just
1543        # containing Portfile and the files directory
1544        set binary 0
1545        set portname [file rootname [file tail $filepath]]
1546    }
1547
1548    # extract the portfile (and possibly files dir if not a binary archive)
1549    ui_debug "extracting port archive to [pwd]"
1550    if {$binary} {
1551        set cmdline [list $tarcmd ${tarflags}${qflag}xOf $filepath +PORTFILE > Portfile]
1552    } else {
1553        set cmdline [list $tarcmd ${tarflags}${qflag}xf $filepath]
1554    }
1555    ui_debug $cmdline
1556    if {[catch {exec {*}$cmdline} result]} {
1557        if {!$local} {
1558            # clean up the archive, we don't need it anymore
1559            file delete [file join $fetchdir $fetchfile]
1560        }
1561
1562        cd $oldpwd
1563        return -code error "Port extract failed: $result"
1564    }
1565
1566    if {!$local} {
1567        # clean up the archive, we don't need it anymore
1568        file delete [file join $fetchdir $fetchfile]
1569    }
1570
1571    cd $oldpwd
1572    return [file join $fetchdir $portname]
1573}
1574
1575proc macports::getprotocol {url} {
1576    if {[regexp {(?x)([^:]+)://.+} $url match protocol] == 1} {
1577        return $protocol
1578    } else {
1579        return -code error "Can't parse url $url"
1580    }
1581}
1582
1583##
1584# Return the directory where the port identified by the given \a url is
1585# located. Can be called with either local paths (starting with \c file://), or
1586# local or remote URLs pointing to a tarball that will be extracted.
1587#
1588# @param url URL identifying the port to be installed
1589# @return normalized path to the port's directory, or error when called with an
1590#         unsupported protocol, or if the tarball pointed to by \a url didn't
1591#         contain a Portfile.
1592proc macports::getportdir {url} {
1593    global macports::extracted_portdirs
1594
1595    set protocol [macports::getprotocol $url]
1596    switch -- $protocol {
1597        file {
1598            set path [file normalize [string range $url [expr {[string length $protocol] + 3}] end]]
1599            if {![file isfile $path]} {
1600                # the URL points to a local directory
1601                return $path
1602            } else {
1603                # the URL points to a local tarball that (hopefully) contains a Portfile
1604                # create a local dir for the extracted port, but only once
1605                if {![info exists macports::extracted_portdirs($url)]} {
1606                    set macports::extracted_portdirs($url) [macports::fetch_port $path 1]
1607                }
1608                return $macports::extracted_portdirs($url)
1609            }
1610        }
1611        https -
1612        http -
1613        ftp {
1614            # the URL points to a remote tarball that (hopefully) contains a Portfile
1615            # create a local dir for the extracted port, but only once
1616            if {![info exists macports::extracted_portdirs($url)]} {
1617                set macports::extracted_portdirs($url) [macports::fetch_port $url 0]
1618            }
1619            return $macports::extracted_portdirs($url)
1620        }
1621        default {
1622            return -code error "Unsupported protocol $protocol"
1623        }
1624    }
1625}
1626
1627##
1628# Get the path to the _resources directory of the source
1629#
1630# If the file is not available in the current source, it will fall back to the
1631# default source. This behavior is controlled by the fallback parameter.
1632#
1633# @param url port url
1634# @param path path in _resources we are interested in
1635# @param fallback fall back to the default source tree
1636# @return path to the _resources directory or the path to the fallback
1637proc macports::getportresourcepath {url {path {}} {fallback yes}} {
1638    global macports::sources_default
1639
1640    set protocol [getprotocol $url]
1641
1642    switch -- $protocol {
1643        file {
1644            set proposedpath [file normalize [file join [getportdir $url] .. ..]]
1645        }
1646        default {
1647            set proposedpath [getsourcepath $url]
1648        }
1649    }
1650
1651    # append requested path
1652    set proposedpath [file join $proposedpath _resources $path]
1653
1654    if {$fallback && ![file exists $proposedpath]} {
1655        return [getdefaultportresourcepath $path]
1656    }
1657
1658    return $proposedpath
1659}
1660
1661##
1662# Get the path to the _resources directory of the default source
1663#
1664# @param path path in _resources we are interested in
1665# @return path to the _resources directory of the default source
1666proc macports::getdefaultportresourcepath {{path {}}} {
1667    global macports::sources_default
1668
1669    set default_source_url [lindex $sources_default 0]
1670    if {[getprotocol $default_source_url] eq "file"} {
1671        set proposedpath [getportdir $default_source_url]
1672    } else {
1673        set proposedpath [getsourcepath $default_source_url]
1674    }
1675
1676    # append requested path
1677    set proposedpath [file join $proposedpath _resources $path]
1678
1679    return $proposedpath
1680}
1681
1682
1683##
1684# Opens a MacPorts portfile specified by a URL. The URL can be local (starting
1685# with file://), or remote (http, https, or ftp). In the local case, the URL
1686# can point to a directory containing a Portfile, or to a tarball in the format
1687# detailed below. In the remote case, the URL must point to a tarball. The
1688# Portfile is opened with the given list of options and variations. The result
1689# of this function should be treated as an opaque handle to a MacPorts
1690# Portfile.
1691#
1692# @param porturl URL to the directory of the port to be opened. Can the path to
1693#                a local directory, or an URL (both remote and local) pointing
1694#                to a tarball that
1695#                \li either contains a \c Portfile and possible a \c files
1696#                    directory, or
1697#                \li is a MacPorts binary archive, where the Portfile is in
1698#                    a file called \c +PORTFILE.
1699# @param options an optional array (in list format) of options
1700# @param variations an optional array (ist list format) of variations, passed
1701#                   to \c eval_variants after running the Portfile
1702# @param nocache a non-empty string, if port information caching should be
1703#                avoided.
1704proc mportopen {porturl {options {}} {variations {}} {nocache {}}} {
1705    global macports::portdbpath macports::portconf macports::open_mports auto_path
1706
1707    # Look for an already-open MPort with the same URL.
1708    # if found, return the existing reference and bump the refcount.
1709    if {$nocache ne ""} {
1710        set mport ""
1711    } else {
1712        set mport [dlist_match_multi $macports::open_mports [list porturl $porturl variations $variations options $options]]
1713    }
1714    if {$mport ne ""} {
1715        # just in case more than one somehow matches
1716        set mport [lindex $mport 0]
1717        set refcnt [ditem_key $mport refcnt]
1718        incr refcnt
1719        ditem_key $mport refcnt $refcnt
1720        return $mport
1721    }
1722
1723    # Will download if remote and extract if tarball.
1724    set portpath [macports::getportdir $porturl]
1725    ui_debug "Changing to port directory: $portpath"
1726    cd $portpath
1727    if {![file isfile Portfile]} {
1728        return -code error "Could not find Portfile in $portpath"
1729    }
1730
1731    set workername [interp create]
1732
1733    set mport [ditem_create]
1734    lappend macports::open_mports $mport
1735    ditem_key $mport porturl $porturl
1736    ditem_key $mport portpath $portpath
1737    ditem_key $mport workername $workername
1738    ditem_key $mport options $options
1739    ditem_key $mport variations $variations
1740    ditem_key $mport refcnt 1
1741
1742    macports::worker_init $workername $portpath $porturl [macports::getportbuildpath $portpath] $options $variations
1743
1744    $workername eval source Portfile
1745
1746    # add the default universal variant if appropriate, and set up flags that
1747    # are conditional on whether universal is set
1748    $workername eval universal_setup
1749
1750    # evaluate the variants
1751    if {[$workername eval eval_variants variations] != 0} {
1752        mportclose $mport
1753        error "Error evaluating variants"
1754    }
1755
1756    $workername eval port::run_callbacks
1757
1758    ditem_key $mport provides [$workername eval return \$subport]
1759
1760    return $mport
1761}
1762
1763# mportopen_installed
1764# opens a portfile stored in the registry
1765proc mportopen_installed {name version revision variants options} {
1766    global macports::registry.path
1767    set regref [lindex [registry::entry imaged $name $version $revision $variants] 0]
1768    set portfile_dir [file join ${registry.path} registry portfiles ${name}-${version}_${revision} [$regref portfile]]
1769
1770    set variations {}
1771    set minusvariant [lrange [split [$regref negated_variants] -] 1 end]
1772    set plusvariant [lrange [split [$regref variants] +] 1 end]
1773    foreach v $plusvariant {
1774        lappend variations $v +
1775    }
1776    foreach v $minusvariant {
1777        lappend variations $v -
1778    }
1779
1780    array set options_array $options
1781    set options_array(subport) $name
1782
1783    # find portgroups in registry
1784    set pgdirlist [list]
1785    foreach pg [$regref groups_used] {
1786        lappend pgdirlist [file join ${registry.path} registry portgroups [$pg sha256]-[$pg size]]
1787    }
1788    if {$pgdirlist ne ""} {
1789        set options_array(_portgroup_search_dirs) [list $pgdirlist]
1790    }
1791
1792    return [mportopen file://${portfile_dir}/ [array get options_array] $variations]
1793}
1794
1795# Traverse a directory with ports, calling a function on the path of ports
1796# (at the second depth).
1797# I.e. the structure of dir shall be:
1798# category/port/
1799# with a Portfile file in category/port/
1800#
1801# func:     function to call on every port directory (it is passed
1802#           category/port/ as its parameter)
1803# root:     the directory with all the categories directories.
1804proc mporttraverse {func {root .}} {
1805    # Save the current directory
1806    set pwd [pwd]
1807
1808    # Join the root.
1809    set pathToRoot [file join $pwd $root]
1810
1811    # Go to root because some callers expects us to be there.
1812    cd $pathToRoot
1813
1814    foreach category [lsort -increasing -unique [readdir $root]] {
1815        set pathToCategory [file join $root $category]
1816        # process the category dirs but not _resources
1817        if {[file isdirectory $pathToCategory] && [string index [file tail $pathToCategory] 0] ne "_"} {
1818            # Iterate on port directories.
1819            foreach port [lsort -increasing -unique [readdir $pathToCategory]] {
1820                set pathToPort [file join $pathToCategory $port]
1821                if {[file isdirectory $pathToPort] &&
1822                  [file exists [file join $pathToPort Portfile]]} {
1823                    # Call the function.
1824                    $func [file join $category $port]
1825
1826                    # Restore the current directory because some
1827                    # functions changes it.
1828                    cd $pathToRoot
1829                }
1830            }
1831        }
1832    }
1833
1834    # Restore the current directory.
1835    cd $pwd
1836}
1837
1838### _mportsearchpath is private; subject to change without notice
1839
1840# depregex -> regex on the filename to find.
1841# search_path -> directories to search
1842# executable -> whether we want to check that the file is executable by current
1843#               user or not.
1844proc _mportsearchpath {depregex search_path {executable 0} {return_match 0}} {
1845    set found 0
1846    foreach path $search_path {
1847        if {![file isdirectory $path]} {
1848            continue
1849        }
1850
1851        if {[catch {set filelist [readdir $path]} result]} {
1852            return -code error "$result ($path)"
1853        }
1854
1855        foreach filename $filelist {
1856            if {[regexp $depregex $filename] &&
1857              (($executable == 0) || [file executable [file join $path $filename]])} {
1858                ui_debug "Found Dependency: path: $path filename: $filename regex: $depregex"
1859                set found 1
1860                break
1861            }
1862        }
1863
1864        if {$found} {
1865            break
1866        }
1867    }
1868    if {$return_match} {
1869        if {$found} {
1870            return [file join $path $filename]
1871        } else {
1872            return {}
1873        }
1874    } else {
1875        return $found
1876    }
1877}
1878
1879
1880### _mportinstalled is private; may change without notice
1881
1882# Determine if a port is already *installed*, as in "in the registry".
1883proc _mportinstalled {mport} {
1884    # Check for the presence of the port in the registry
1885    set workername [ditem_key $mport workername]
1886    return [$workername eval registry_exists_for_name \$subport]
1887}
1888
1889# Determine if a port is active
1890proc _mportactive {mport} {
1891    set workername [ditem_key $mport workername]
1892    if {![catch {set reslist [$workername eval registry_active \$subport]}] && [llength $reslist] > 0} {
1893        set i [lindex $reslist 0]
1894        set name [lindex $i 0]
1895        set version [lindex $i 1]
1896        set revision [lindex $i 2]
1897        set variants [lindex $i 3]
1898        array set portinfo [mportinfo $mport]
1899        if {$name eq $portinfo(name) && $version eq $portinfo(version)
1900            && $revision == $portinfo(revision) && $variants eq $portinfo(canonical_active_variants)} {
1901            return 1
1902        }
1903    }
1904    return 0
1905}
1906
1907# Determine if the named port is active
1908proc _portnameactive {portname} {
1909    if {[catch {set reslist [registry::active $portname]}]} {
1910        return 0
1911    } else {
1912        return [expr {[llength $reslist] > 0}]
1913    }
1914}
1915
1916### _mportispresent is private; may change without notice
1917
1918# Determine if some depspec is satisfied or if the given port is installed
1919# and active.
1920# We actually start with the registry (faster?)
1921#
1922# mport     the port declaring the dep (context in which to evaluate $prefix etc)
1923# depspec   the dependency test specification (path, bin, lib, etc.)
1924proc _mportispresent {mport depspec} {
1925    set portname [lindex [split $depspec :] end]
1926    ui_debug "Searching for dependency: $portname"
1927    set res [_portnameactive $portname]
1928    if {$res != 0} {
1929        ui_debug "Found Dependency: receipt exists for $portname"
1930        return 1
1931    } else {
1932        # The receipt test failed, use one of the depspec regex mechanisms
1933        ui_debug "Didn't find receipt, going to depspec regex for: $portname"
1934        set workername [ditem_key $mport workername]
1935        set type [lindex [split $depspec :] 0]
1936        switch -- $type {
1937            lib {return [$workername eval _libtest $depspec]}
1938            bin {return [$workername eval _bintest $depspec]}
1939            path {return [$workername eval _pathtest $depspec]}
1940            port {return 0}
1941            default {return -code error "unknown depspec type: $type"}
1942        }
1943        return 0
1944    }
1945}
1946
1947### _mporterrorifconflictsinstalled is private; may change without notice
1948
1949# Determine if the port, per the conflicts option, has any conflicts
1950# with what is installed. If it does, raises an error unless force
1951# option is set.
1952#
1953# mport   the port to check for conflicts
1954proc _mporterrorifconflictsinstalled {mport} {
1955    set conflictlist {}
1956    array set portinfo [mportinfo $mport]
1957
1958    if {[info exists portinfo(conflicts)] &&
1959        [llength $portinfo(conflicts)] > 0} {
1960        ui_debug "Checking for conflicts against [_mportkey $mport subport]"
1961        foreach conflictport $portinfo(conflicts) {
1962            if {[_mportispresent $mport port:$conflictport]} {
1963                lappend conflictlist $conflictport
1964            }
1965        }
1966    } else {
1967        ui_debug "[_mportkey $mport subport] has no conflicts"
1968    }
1969
1970    if {[llength $conflictlist] != 0} {
1971        if {[macports::global_option_isset ports_force]} {
1972            ui_warn "Force option set; installing $portinfo(name) despite conflicts with: $conflictlist"
1973        } else {
1974            if {![macports::ui_isset ports_debug]} {
1975                ui_msg {}
1976            }
1977            ui_error "Can't install $portinfo(name) because conflicting ports are active: $conflictlist"
1978            return -code error "conflicting ports"
1979        }
1980    }
1981}
1982
1983### _mportexec is private; may change without notice
1984
1985proc _mportexec {target mport} {
1986    set portname [_mportkey $mport subport]
1987    macports::push_log $mport
1988    # xxx: set the work path?
1989    set workername [ditem_key $mport workername]
1990    $workername eval validate_macportsuser
1991    if {![catch {$workername eval check_variants $target} result] && $result == 0 &&
1992        ![catch {$workername eval check_supported_archs} result] && $result == 0 &&
1993        ![catch {$workername eval eval_targets $target} result] && $result == 0} {
1994        # If auto-clean mode, clean-up after dependency install
1995        if {$macports::portautoclean} {
1996            # Make sure we are back in the port path before clean
1997            # otherwise if the current directory had been changed to
1998            # inside the port,  the next port may fail when trying to
1999            # install because [pwd] will return a "no file or directory"
2000            # error since the directory it was in is now gone.
2001            set portpath [ditem_key $mport portpath]
2002            catch {cd $portpath}
2003            $workername eval eval_targets clean
2004        }
2005        # XXX hack to avoid running out of fds due to sqlite temp files, ticket #24857
2006        interp delete $workername
2007        macports::pop_log
2008        return 0
2009    } else {
2010        # An error occurred.
2011        global ::logenabled ::debuglogname
2012        ui_debug $::errorInfo
2013        if {[info exists ::logenabled] && $::logenabled && [info exists ::debuglogname]} {
2014            ui_error "See $::debuglogname for details."
2015        }
2016        macports::pop_log
2017        return 1
2018    }
2019}
2020
2021# mportexec
2022# Execute the specified target of the given mport.
2023proc mportexec {mport target} {
2024    set workername [ditem_key $mport workername]
2025
2026    # check for existence of macportsuser and use fallback if necessary
2027    $workername eval validate_macportsuser
2028    # check variants
2029    if {[$workername eval check_variants $target] != 0} {
2030        return 1
2031    }
2032    set portname [_mportkey $mport subport]
2033    set log_needs_pop no
2034    if {$target ne "clean"} {
2035        macports::push_log $mport
2036        set log_needs_pop yes
2037    }
2038
2039    # Use _target_needs_deps as a proxy for whether we're going to
2040    # build and will therefore need to check Xcode version and
2041    # supported_archs.
2042    if {[macports::_target_needs_deps $target]} {
2043        # possibly warn or error out depending on how old xcode is
2044        if {[$workername eval _check_xcode_version] != 0} {
2045            if {$log_needs_pop} {
2046                macports::pop_log
2047            }
2048            return 1
2049        }
2050        # error out if selected arch(s) not supported by this port
2051        if {[$workername eval check_supported_archs] != 0} {
2052            if {$log_needs_pop} {
2053                macports::pop_log
2054            }
2055            return 1
2056        }
2057    }
2058
2059    # Before we build the port, we must build its dependencies.
2060    set dlist {}
2061    if {[macports::_target_needs_deps $target] && [macports::_mport_has_deptypes $mport [macports::_deptypes_for_target $target $workername]]} {
2062        registry::exclusive_lock
2063        # see if we actually need to build this port
2064        if {$target ni {activate install} ||
2065            ![$workername eval registry_exists {$subport} {$version} {$revision} {$portvariants}]} {
2066
2067            # upgrade dependencies that are already installed
2068            if {![macports::global_option_isset ports_nodeps]} {
2069                macports::_upgrade_mport_deps $mport $target
2070            }
2071        }
2072
2073        ui_msg -nonewline "$macports::ui_prefix Computing dependencies for [_mportkey $mport subport]"
2074        if {[macports::ui_isset ports_debug]} {
2075            # play nice with debug messages
2076            ui_msg {}
2077        }
2078        if {[mportdepends $mport $target] != 0} {
2079            if {$log_needs_pop} {
2080                macports::pop_log
2081            }
2082            return 1
2083        }
2084        if {![macports::ui_isset ports_debug]} {
2085            ui_msg {}
2086        }
2087
2088        # Select out the dependents along the critical path,
2089        # but exclude this mport, we might not be installing it.
2090        set dlist [dlist_append_dependents $macports::open_mports $mport {}]
2091
2092        dlist_delete dlist $mport
2093
2094        # print the dep list
2095        if {[llength $dlist] > 0} {
2096            ##
2097            # User Interaction Question
2098            # Asking before installing dependencies
2099            if {[info exists macports::ui_options(questions_yesno)]} {
2100                set deplist {}
2101                foreach ditem $dlist {
2102                    lappend deplist [ditem_key $ditem provides]
2103                }
2104                set retvalue [$macports::ui_options(questions_yesno) "The following dependencies will be installed: " "TestCase#2" [lsort $deplist] {y} 0]
2105                if {$retvalue == 1} {
2106                    if {$log_needs_pop} {
2107                        macports::pop_log
2108                    }
2109                    foreach ditem $dlist {
2110                        mportclose $ditem
2111                    }
2112                    return 0
2113                } 
2114            } else {
2115                set depstring "$macports::ui_prefix Dependencies to be installed:"
2116                foreach ditem $dlist {
2117                    append depstring " [ditem_key $ditem provides]"
2118                }
2119                ui_msg $depstring
2120            }
2121        }
2122
2123        # install them
2124        set result [dlist_eval $dlist _mportactive [list _mportexec activate]]
2125
2126        registry::exclusive_unlock
2127
2128        if {$result ne ""} {
2129            ##
2130            # When this happens, the failing port usually already printed an
2131            # error message. Omit this one to avoid cluttering the output and
2132            # hiding the *real* problem.
2133
2134            #set errstring "The following dependencies were not installed:"
2135            #foreach ditem $result {
2136            #    append errstring " [ditem_key $ditem provides]"
2137            #}
2138            #ui_error $errstring
2139            foreach ditem $dlist {
2140                catch {mportclose $ditem}
2141            }
2142            if {$log_needs_pop} {
2143                macports::pop_log
2144            }
2145            return 1
2146        }
2147
2148        # Close the dependencies, we're done installing them.
2149        foreach ditem $dlist {
2150            mportclose $ditem
2151        }
2152    } else {
2153        # No dependencies, but we still need to check for conflicts.
2154        if {$target eq "" || $target eq "install" || $target eq "activate"} {
2155            if {[catch {_mporterrorifconflictsinstalled $mport}]} {
2156                if {$log_needs_pop} {
2157                    macports::pop_log
2158                }
2159                return 1
2160            }
2161        }
2162    }
2163
2164    set clean 0
2165    if {$macports::portautoclean && ($target eq "install" || $target eq "activate")} {
2166        # If we're doing an install, check if we should clean after
2167        set clean 1
2168    }
2169
2170    # Build this port with the specified target
2171    set result [$workername eval eval_targets $target]
2172
2173    # If auto-clean mode and successful install, clean-up after install
2174    if {$result == 0 && $clean == 1} {
2175        # Make sure we are back in the port path, just in case
2176        set portpath [ditem_key $mport portpath]
2177        catch {cd $portpath}
2178        $workername eval eval_targets clean
2179    }
2180
2181    global ::logenabled ::debuglogname
2182    if {$result != 0 && [info exists ::logenabled] && $::logenabled && [info exists ::debuglogname]} {
2183        ui_error "See $::debuglogname for details."
2184    }
2185
2186    if {$log_needs_pop} {
2187        macports::pop_log
2188    }
2189
2190    return $result
2191}
2192
2193# upgrade any dependencies of mport that are installed and needed for target
2194proc macports::_upgrade_mport_deps {mport target} {
2195    set options [ditem_key $mport options]
2196    set workername [ditem_key $mport workername]
2197    set deptypes [macports::_deptypes_for_target $target $workername]
2198    array set portinfo [mportinfo $mport]
2199    array set depscache {}
2200
2201    set required_archs [$workername eval get_canonical_archs]
2202    set depends_skip_archcheck [_mportkey $mport depends_skip_archcheck]
2203
2204    # Pluralize "arch" appropriately.
2205    set s [expr {[llength $required_archs] == 1 ? "" : "s"}]
2206
2207    set test _portnameactive
2208
2209    foreach deptype $deptypes {
2210        if {![info exists portinfo($deptype)]} {
2211            continue
2212        }
2213        foreach depspec $portinfo($deptype) {
2214            set dep_portname [$workername eval _get_dep_port $depspec]
2215            if {$dep_portname ne "" && ![info exists depscache(port:$dep_portname)] && [$test $dep_portname]} {
2216                set variants {}
2217
2218                # check that the dep has the required archs
2219                set active_archs [_get_registry_archs $dep_portname]
2220                if {$deptype ni {depends_fetch depends_extract} && $active_archs ni {{} noarch}
2221                    && $required_archs ne "noarch" && $dep_portname ni $depends_skip_archcheck} {
2222                    set missing {}
2223                    foreach arch $required_archs {
2224                        if {$arch ni $active_archs} {
2225                            lappend missing $arch
2226                        }
2227                    }
2228                    if {[llength $missing] > 0} {
2229                        set res [mportlookup $dep_portname]
2230                        array unset dep_portinfo
2231                        array set dep_portinfo [lindex $res 1]
2232                        if {[info exists dep_portinfo(installs_libs)] && !$dep_portinfo(installs_libs)} {
2233                            set missing {}
2234                        }
2235                    }
2236                    if {[llength $missing] > 0} {
2237                        if {[info exists dep_portinfo(variants)] && "universal" in $dep_portinfo(variants)} {
2238                            # dep offers a universal variant
2239                            if {[llength $active_archs] == 1} {
2240                                # not installed universal
2241                                set missing {}
2242                                foreach arch $required_archs {
2243                                    if {$arch ni $macports::universal_archs} {
2244                                        lappend missing $arch
2245                                    }
2246                                }
2247                                if {[llength $missing] > 0} {
2248                                    ui_error "Cannot install [_mportkey $mport subport] for the arch${s} '$required_archs' because"
2249                                    ui_error "its dependency $dep_portname is only installed for the arch '$active_archs'"
2250                                    ui_error "and the configured universal_archs '$macports::universal_archs' are not sufficient."
2251                                    return -code error "architecture mismatch"
2252                                } else {
2253                                    # upgrade the dep with +universal
2254                                    lappend variants universal +
2255                                    lappend options ports_upgrade_enforce-variants yes
2256                                    ui_debug "enforcing +universal upgrade for $dep_portname"
2257                                }
2258                            } else {
2259                                # already universal
2260                                ui_error "Cannot install [_mportkey $mport subport] for the arch${s} '$required_archs' because"
2261                                ui_error "its dependency $dep_portname is only installed for the archs '$active_archs'."
2262                                return -code error "architecture mismatch"
2263                            }
2264                        } else {
2265                            ui_error "Cannot install [_mportkey $mport subport] for the arch${s} '$required_archs' because"
2266                            ui_error "its dependency $dep_portname is only installed for the arch '$active_archs'"
2267                            ui_error "and does not have a universal variant."
2268                            return -code error "architecture mismatch"
2269                        }
2270                    }
2271                }
2272
2273                set status [macports::upgrade $dep_portname port:$dep_portname $variants $options depscache]
2274                # status 2 means the port was not found in the index
2275                if {$status != 0 && $status != 2 && ![macports::ui_isset ports_processall]} {
2276                    return -code error "upgrade $dep_portname failed"
2277                }
2278            }
2279        }
2280    }
2281}
2282
2283# get the archs with which the active version of portname is installed
2284proc macports::_get_registry_archs {portname} {
2285    set ilist [registry::active $portname]
2286    set i [lindex $ilist 0]
2287    set regref [registry::open_entry [lindex $i 0] [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
2288    set archs [registry::property_retrieve $regref archs]
2289    if {$archs == 0} {
2290        set archs {}
2291    }
2292    return $archs
2293}
2294
2295proc macports::getsourcepath {url} {
2296    global macports::portdbpath
2297
2298    set source_path [split $url ://]
2299
2300    if {[_source_is_snapshot $url]} {
2301        # daily snapshot tarball
2302        return [file join $portdbpath sources [join [lrange $source_path 3 end-1] /] ports]
2303    }
2304
2305    return [file join $portdbpath sources [lindex $source_path 3] [lindex $source_path 4] [lindex $source_path 5]]
2306}
2307
2308##
2309# Checks whether a supplied source URL is for a daily snapshot tarball
2310# (private)
2311#
2312# @param url source URL to check
2313# @return a list containing filename and extension or an empty list
2314proc _source_is_snapshot {url {filename {}} {extension {}}} {
2315    upvar $filename myfilename
2316    upvar $extension myextension
2317
2318    if {[regexp {^(?:https?|ftp|rsync)://.+/(.+\.(tar\.gz|tar\.bz2|tar))$} $url -> f e]} {
2319        set myfilename $f
2320        set myextension $e
2321
2322        return 1
2323    }
2324
2325    return 0
2326}
2327
2328proc macports::getportbuildpath {id {portname {}}} {
2329    global macports::portdbpath
2330    regsub {://} $id {.} port_path
2331    regsub -all {/} $port_path {_} port_path
2332    return [file join $portdbpath build $port_path $portname]
2333}
2334
2335proc macports::getportlogpath {id {portname {}}} {
2336    global macports::portdbpath
2337    regsub {://} $id {.} port_path
2338    regsub -all {/} $port_path {_} port_path
2339    return [file join $portdbpath logs $port_path $portname]
2340}
2341
2342proc macports::getportworkpath_from_buildpath {portbuildpath} {
2343    return [file normalize [file join $portbuildpath work]]
2344}
2345
2346proc macports::getportworkpath_from_portdir {portpath {portname {}}} {
2347    return [macports::getportworkpath_from_buildpath [macports::getportbuildpath $portpath $portname]]
2348}
2349
2350proc macports::getindex {source} {
2351    # Special case file:// sources
2352    if {[macports::getprotocol $source] eq "file"} {
2353        return [file join [macports::getportdir $source] PortIndex]
2354    }
2355
2356    return [file join [macports::getsourcepath $source] PortIndex]
2357}
2358
2359# macports::GetVCSUpdateCmd --
2360#
2361# Determine whether the given directory is associated with a repository
2362# for a supported version control system. If so, return a list
2363# containing two strings:
2364#
2365#   1) The human-readable name of the version control system.
2366#   2) A command that will update the repository's working tree to the
2367#      latest commit/changeset/revision/whatever. This command should
2368#      work properly from any working directory, although it doesn't
2369#      have to worry about cleaning up after itself (restoring the
2370#      environment, changing back to the initial directory, etc.).
2371#
2372# If the directory is not associated with any supported system, return
2373# an empty list.
2374#
2375proc macports::GetVCSUpdateCmd portDir {
2376
2377    set oldPWD [pwd]
2378    cd $portDir
2379
2380    # Subversion
2381    if {![catch {macports::findBinary svn} svn] &&
2382        ([file exists .svn] ||
2383         ![catch {exec $svn info >/dev/null 2>@1}])
2384    } then {
2385        return [list Subversion "$svn update --non-interactive $portDir"]
2386    }
2387
2388    # Git
2389    if {![catch {macports::findBinary git} git] &&
2390        ![catch {exec $git rev-parse --is-inside-work-tree}]
2391    } then {
2392        if {![catch {exec $git config --local --get svn-remote.svn.url}]} {
2393            # git-svn repository
2394            return [list git-svn "cd $portDir && $git svn rebase || true"]
2395        }
2396        # regular git repository
2397        return [list Git "cd $portDir && $git pull --rebase || true"]
2398    }
2399
2400    # Add new VCSes here!
2401
2402    cd $oldPWD
2403    return [list]
2404}
2405
2406# macports::UpdateVCS --
2407#
2408# Execute the given command in a shell. If called with superuser
2409# privileges, execute the command as the user/group that owns the given
2410# directory, restoring privileges before returning.
2411#
2412# This proc could probably be generalized and used elsewhere.
2413#
2414proc macports::UpdateVCS {cmd portDir} {
2415    if {[getuid] == 0} {
2416        # Must change egid before dropping root euid.
2417        set oldEGID [getegid]
2418        set newEGID [name_to_gid [file attributes $portDir -group]]
2419        setegid $newEGID
2420        ui_debug "Changed effective group ID from $oldEGID to $newEGID"
2421        set oldEUID [geteuid]
2422        set newEUID [name_to_uid [file attributes $portDir -owner]]
2423        seteuid $newEUID
2424        ui_debug "Changed effective user ID from $oldEUID to $newEUID"
2425    }
2426    ui_debug $cmd
2427    catch {system $cmd} result options
2428    if {[getuid] == 0} {
2429        seteuid $oldEUID
2430        ui_debug "Changed effective user ID from $newEUID to $oldEUID"
2431        setegid $oldEGID
2432        ui_debug "Changed effective group ID from $newEGID to $oldEGID"
2433    }
2434    return -options $options $result
2435}
2436
2437proc mportsync {{optionslist {}}} {
2438    global macports::sources macports::portdbpath macports::rsync_options \
2439           tcl_platform macports::portverbose macports::autoconf::rsync_path \
2440           macports::autoconf::tar_path macports::autoconf::openssl_path \
2441           macports::ui_options
2442    array set options $optionslist
2443    if {[info exists options(no_reindex)]} {
2444        upvar $options(needed_portindex_var) any_needed_portindex
2445    }
2446
2447    set numfailed 0
2448
2449    ui_msg "$macports::ui_prefix Updating the ports tree"
2450    foreach source $sources {
2451        set flags [lrange $source 1 end]
2452        set source [lindex $source 0]
2453        if {"nosync" in $flags} {
2454            ui_debug "Skipping $source"
2455            continue
2456        }
2457        set needs_portindex false
2458        ui_info "Synchronizing local ports tree from $source"
2459        switch -regexp -- [macports::getprotocol $source] {
2460            {^file$} {
2461                set portdir [macports::getportdir $source]
2462                if {[catch {macports::GetVCSUpdateCmd $portdir} repoInfo]} {
2463                    ui_debug $::errorInfo
2464                    ui_info "Could not access contents of $portdir"
2465                    incr numfailed
2466                    continue
2467                }
2468                if {[llength $repoInfo]} {
2469                    lassign $repoInfo vcs cmd
2470                    if {[catch {macports::UpdateVCS $cmd $portdir}]} {
2471                        ui_debug $::errorInfo
2472                        ui_info "Syncing local $vcs ports tree failed"
2473                        incr numfailed
2474                        continue
2475                    }
2476                }
2477                set needs_portindex true
2478            }
2479            {^rsync$} {
2480                # Where to, boss?
2481                set indexfile [macports::getindex $source]
2482                set destdir [file dirname $indexfile]
2483                set is_tarball [_source_is_snapshot $source]
2484                file mkdir $destdir
2485
2486                if {$is_tarball} {
2487                    set exclude_option {}
2488                    # need to do a few things before replacing the ports tree in this case
2489                    set destdir [file dirname $destdir]
2490                } else {
2491                    # Keep rsync happy with a trailing slash
2492                    if {[string index $source end] ne "/"} {
2493                        append source /
2494                    }
2495                    # don't sync PortIndex yet; we grab the platform specific one afterwards
2496                    set exclude_option '--exclude=/PortIndex*'
2497                }
2498                # Do rsync fetch
2499                set rsync_commandline "$macports::autoconf::rsync_path $rsync_options $exclude_option $source $destdir"
2500                ui_debug $rsync_commandline
2501                if {[catch {system $rsync_commandline}]} {
2502                    ui_error "Synchronization of the local ports tree failed doing rsync"
2503                    incr numfailed
2504                    continue
2505                }
2506
2507                if {$is_tarball} {
2508                    # verify signature for tarball
2509                    global macports::archivefetch_pubkeys
2510                    set rsync_commandline "$macports::autoconf::rsync_path $rsync_options $exclude_option ${source}.rmd160 $destdir"
2511                    ui_debug $rsync_commandline
2512                    if {[catch {system $rsync_commandline}]} {
2513                        ui_error "Synchronization of the ports tree signature failed doing rsync"
2514                        incr numfailed
2515                        continue
2516                    }
2517                    set tarball ${destdir}/[file tail $source]
2518                    set signature ${tarball}.rmd160
2519                    set openssl [macports::findBinary openssl $macports::autoconf::openssl_path]
2520                    set verified 0
2521                    foreach pubkey $macports::archivefetch_pubkeys {
2522                        if {![catch {exec $openssl dgst -ripemd160 -verify $pubkey -signature $signature $tarball} result]} {
2523                            set verified 1
2524                            ui_debug "successful verification with key $pubkey"
2525                            break
2526                        } else {
2527                            ui_debug "failed verification with key $pubkey"
2528                            ui_debug "openssl output: $result"
2529                        }
2530                    }
2531                    if {!$verified} {
2532                        ui_error "Failed to verify signature for ports tree!"
2533                        incr numfailed
2534                        continue
2535                    }
2536
2537                    # extract tarball and move into place
2538                    set tar [macports::findBinary tar $macports::autoconf::tar_path]
2539                    file mkdir ${destdir}/tmp
2540                    set tar_cmd "$tar -C ${destdir}/tmp -xf $tarball"
2541                    ui_debug $tar_cmd
2542                    if {[catch {system $tar_cmd}]} {
2543                        ui_error "Failed to extract ports tree from tarball!"
2544                        incr numfailed
2545                        continue
2546                    }
2547                    # save the local PortIndex data
2548                    if {[file isfile $indexfile]} {
2549                        file copy -force $indexfile ${destdir}/
2550                        file rename -force $indexfile ${destdir}/tmp/ports/
2551                        if {[file isfile ${indexfile}.quick]} {
2552                            file rename -force ${indexfile}.quick ${destdir}/tmp/ports/
2553                        }
2554                    }
2555                    file delete -force ${destdir}/ports
2556                    file rename ${destdir}/tmp/ports ${destdir}/ports
2557                    file delete -force ${destdir}/tmp
2558                }
2559
2560                set needs_portindex true
2561                # now sync the index if the local file is missing or older than a day
2562                if {![file isfile $indexfile] || [clock seconds] - [file mtime $indexfile] > 86400
2563                      || [info exists options(no_reindex)]} {
2564                    if {$is_tarball} {
2565                        # chop ports.tar off the end
2566                        set index_source [string range $source 0 end-[string length [file tail $source]]]
2567                    } else {
2568                        set index_source $source
2569                    }
2570                    set remote_indexfile "${index_source}PortIndex_${macports::os_platform}_${macports::os_major}_${macports::os_arch}/PortIndex"
2571                    set rsync_commandline "$macports::autoconf::rsync_path $rsync_options $remote_indexfile $destdir"
2572                    ui_debug $rsync_commandline
2573                    if {[catch {system $rsync_commandline}]} {
2574                        ui_debug "Synchronization of the PortIndex failed doing rsync"
2575                    } else {
2576                        set ok 1
2577                        set needs_portindex false
2578                        if {$is_tarball} {
2579                            set ok 0
2580                            set needs_portindex true
2581                            # verify signature for PortIndex
2582                            set rsync_commandline "$macports::autoconf::rsync_path $rsync_options ${remote_indexfile}.rmd160 $destdir"
2583                            ui_debug $rsync_commandline
2584                            if {![catch {system $rsync_commandline}]} {
2585                                foreach pubkey $macports::archivefetch_pubkeys {
2586                                    if {![catch {exec $openssl dgst -ripemd160 -verify $pubkey -signature ${destdir}/PortIndex.rmd160 ${destdir}/PortIndex} result]} {
2587                                        set ok 1
2588                                        set needs_portindex false
2589                                        ui_debug "successful verification with key $pubkey"
2590                                        break
2591                                    } else {
2592                                        ui_debug "failed verification with key $pubkey"
2593                                        ui_debug "openssl output: $result"
2594                                    }
2595                                }
2596                                if {$ok} {
2597                                    # move PortIndex into place
2598                                    file rename -force ${destdir}/PortIndex ${destdir}/ports/
2599                                }
2600                            }
2601                        }
2602                        if {$ok} {
2603                            mports_generate_quickindex $indexfile
2604                        }
2605                    }
2606                }
2607                if {[catch {system "chmod -R a+r \"$destdir\""}]} {
2608                    ui_warn "Setting world read permissions on parts of the ports tree failed, need root?"
2609                }
2610            }
2611            {^https?$|^ftp$} {
2612                if {![_source_is_snapshot $source filename extension]} {
2613                    ui_error "Synchronization using http, https and ftp only supported with tarballs."
2614                    ui_error "The source ${source} doesn't seem to point to a tarball."
2615                    ui_error "Please switch to a different sync protocol (e.g. rsync) in your sources.conf"
2616                    ui_error "Remove the line mentioned above from your sources.conf to silence this error."
2617                    incr numfailed
2618                    continue
2619                }
2620                # sync a daily port snapshot tarball
2621                set indexfile [macports::getindex $source]
2622                set destdir [file dirname $indexfile]
2623                set tarpath [file join [file normalize [file join $destdir ..]] $filename]
2624
2625                set updated 1
2626                if {[file isdirectory $destdir]} {
2627                    set moddate [file mtime $destdir]
2628                    if {[catch {set updated [curl isnewer $source $moddate]} error]} {
2629                        ui_warn "Cannot check if $source was updated, ($error)"
2630                    }
2631                }
2632
2633                if {(![info exists options(ports_force)] || !$options(ports_force)) && $updated <= 0} {
2634                    ui_info "No updates for $source"
2635                    continue
2636                }
2637
2638                file mkdir $destdir
2639
2640                set progressflag {}
2641                if {$macports::portverbose} {
2642                    set progressflag "--progress builtin"
2643                    set verboseflag "-v"
2644                } elseif {[info exists macports::ui_options(progress_download)]} {
2645                    set progressflag "--progress ${macports::ui_options(progress_download)}"
2646                    set verboseflag ""
2647                }
2648                try -pass_signal {
2649                    curl fetch {*}$progressflag $source $tarpath
2650                } catch {{*} eCode eMessage} {
2651                    ui_error [msgcat::mc "Fetching %s failed: %s" $source $eMessage]
2652                    incr numfailed
2653                    continue
2654                }
2655
2656                set extflag {}
2657                switch -- $extension {
2658                    {tar.gz} {
2659                        set extflag -z
2660                    }
2661                    {tar.bz2} {
2662                        set extflag -j
2663                    }
2664                }
2665
2666                set tar [macports::findBinary tar $macports::autoconf::tar_path]
2667                if {[catch {system "cd ${destdir}/.. && $tar $verboseflag $extflag -xf $filename"} error]} {
2668                    ui_error "Extracting $source failed ($error)"
2669                    incr numfailed
2670                    continue
2671                }
2672
2673                if {[catch {system "chmod -R a+r \"$destdir\""}]} {
2674                    ui_warn "Setting world read permissions on parts of the ports tree failed, need root?"
2675                }
2676
2677                set platindex "PortIndex_${macports::os_platform}_${macports::os_major}_${macports::os_arch}/PortIndex"
2678                if {[file isfile ${destdir}/$platindex] && [file isfile ${destdir}/${platindex}.quick]} {
2679                    file rename -force ${destdir}/$platindex ${destdir}/${platindex}.quick $destdir
2680                }
2681
2682                file delete $tarpath
2683            }
2684            {^mports$} {
2685                ui_error "Synchronization using the mports protocol no longer supported."
2686                ui_error "Please switch to a different sync protocol (e.g. rsync) in your sources.conf"
2687                ui_error "Remove the line starting with mports:// from your sources.conf to silence this error."
2688                incr numfailed
2689                continue
2690            }
2691            default {
2692                ui_warn "Unknown synchronization protocol for $source"
2693            }
2694        }
2695
2696        if {$needs_portindex} {
2697            set any_needed_portindex true
2698            if {![info exists options(no_reindex)]} {
2699                global macports::prefix
2700                set indexdir [file dirname [macports::getindex $source]]
2701                if {[catch {system "${macports::prefix}/bin/portindex $indexdir"}]} {
2702                    ui_error "updating PortIndex for $source failed"
2703                }
2704            }
2705        }
2706    }
2707
2708    # refresh the quick index if necessary (batch or interactive run)
2709    if {[info exists macports::ui_options(ports_commandfiles)]} {
2710        _mports_load_quickindex
2711    }
2712
2713    if {$numfailed == 1} {
2714        return -code error "Synchronization of 1 source failed"
2715    }
2716    if {$numfailed >= 2} {
2717        return -code error "Synchronization of $numfailed sources failed"
2718    }
2719}
2720
2721##
2722# Searches all configured port sources for a given pattern in a given field
2723# using a given matching style and optional case-sensitivity.
2724#
2725# @param pattern pattern to search for; will be interpreted according to the \a
2726#                matchstyle parameter
2727# @param case_sensitive "yes", if a case-sensitive search should be performed,
2728#                       "no" otherwise. Defaults to "yes".
2729# @param matchstyle One of the values \c exact, \c glob and \c regexp, where \c
2730#                   exact performs a standard string comparison, \c glob
2731#                   performs Tcl string matching using <tt>[string match]</tt>
2732#                   and \c regexp interprets \a pattern as a regular
2733#                   expression.
2734# @param field name of the field to apply \a pattern to. Must be one of the
2735#              fields available in the used portindex. The portindex currently
2736#              contains
2737#                \li \c name (the default)
2738#                \li \c homepage
2739#                \li \c description
2740#                \li \c long_description
2741#                \li \c license
2742#                \li \c categories
2743#                \li \c platforms
2744#                \li \c maintainers
2745#                \li \c variants
2746#                \li \c portdir
2747#                \li all \c depends_* values
2748#                \li \c epoch
2749#                \li \c version
2750#                \li \c revision
2751#                \li \c replaced_by
2752#                \li \c installs_libs
2753# @return a list where each even index (starting with 0) contains the name of
2754#         a matching port. Each entry at an odd index is followed by its
2755#         corresponding line from the portindex, which can be passed to
2756#         <tt>array set</tt>. The whole return value can also be passed to
2757#         <tt>array set</tt> to create an associate array where the port names
2758#         are the keys and the lines from portindex are the values.
2759proc mportsearch {pattern {case_sensitive yes} {matchstyle regexp} {field name}} {
2760    global macports::sources
2761    set matches [list]
2762    set easy [expr {$field eq "name"}]
2763
2764    set found 0
2765    foreach source $sources {
2766        set source [lindex $source 0]
2767        set protocol [macports::getprotocol $source]
2768        if {[catch {set fd [open [macports::getindex $source] r]} result]} {
2769            ui_warn "Can't open index file for source: $source"
2770        } else {
2771            try -pass_signal {
2772                incr found 1
2773                while {[gets $fd line] >= 0} {
2774                    array unset portinfo
2775                    set name [lindex $line 0]
2776                    set len  [lindex $line 1]
2777                    set line [read $fd $len]
2778
2779                    if {$easy} {
2780                        set target $name
2781                    } else {
2782                        array set portinfo $line
2783                        if {![info exists portinfo($field)]} {
2784                            continue
2785                        }
2786                        set target $portinfo($field)
2787                    }
2788
2789                    switch -- $matchstyle {
2790                        exact {
2791                            if {$case_sensitive} {
2792                                set compres [string compare $pattern $target]
2793                            } else {
2794                                set compres [string compare -nocase $pattern $target]
2795                            }
2796                            set matchres [expr {0 == $compres}]
2797                        }
2798                        glob {
2799                            if {$case_sensitive} {
2800                                set matchres [string match $pattern $target]
2801                            } else {
2802                                set matchres [string match -nocase $pattern $target]
2803                            }
2804                        }
2805                        regexp {
2806                            if {$case_sensitive} {
2807                                set matchres [regexp -- $pattern $target]
2808                            } else {
2809                                set matchres [regexp -nocase -- $pattern $target]
2810                            }
2811                        }
2812                        default {
2813                            return -code error "mportsearch: Unsupported matching style: ${matchstyle}."
2814                        }
2815                    }
2816
2817                    if {$matchres == 1} {
2818                        if {$easy} {
2819                            array set portinfo $line
2820                        }
2821                        switch -- $protocol {
2822                            rsync {
2823                                # Rsync files are local
2824                                set source_url file://[macports::getsourcepath $source]
2825                            }
2826                            https -
2827                            http -
2828                            ftp {
2829                                # daily snapshot tarball
2830                                set source_url file://[macports::getsourcepath $source]
2831                            }
2832                            default {
2833                                set source_url $source
2834                            }
2835                        }
2836                        if {[info exists portinfo(portdir)]} {
2837                            set porturl ${source_url}/$portinfo(portdir)
2838                            lappend line porturl $porturl
2839                            ui_debug "Found port in $porturl"
2840                        } else {
2841                            ui_debug "Found port info: $line"
2842                        }
2843                        lappend matches $name
2844                        lappend matches $line
2845                    }
2846                }
2847            } catch * {
2848                ui_warn "It looks like your PortIndex file for $source may be corrupt."
2849                throw
2850            } finally {
2851                close $fd
2852            }
2853        }
2854    }
2855    if {!$found} {
2856        return -code error "No index(es) found! Have you synced your port definitions? Try running 'port selfupdate'."
2857    }
2858
2859    return $matches
2860}
2861
2862##
2863# Returns the PortInfo for a single named port. The info comes from the
2864# PortIndex, and name matching is case-insensitive. Unlike mportsearch, only
2865# the first match is returned, but the return format is otherwise identical.
2866# The advantage is that mportlookup is usually much faster than mportsearch,
2867# due to the use of the quick index, which is a name-based index into the
2868# PortIndex.
2869#
2870# @param name name of the port to look up. Returns the first match while
2871#             traversing the sources in-order.
2872# @return associative array in list form where the first field is the port name
2873#         and the second field is the line from PortIndex containing the port
2874#         info. See the return value of mportsearch().
2875# @see mportsearch()
2876proc mportlookup {name} {
2877    global macports::portdbpath macports::sources macports::quick_index
2878
2879    set sourceno 0
2880    set matches [list]
2881    foreach source $sources {
2882        set source [lindex $source 0]
2883        set protocol [macports::getprotocol $source]
2884        if {![info exists quick_index(${sourceno},[string tolower $name])]} {
2885            # no entry in this source, advance to next source
2886            incr sourceno 1
2887            continue
2888        }
2889        # The quick index is keyed on the port name, and provides the offset in
2890        # the main PortIndex where the given port's PortInfo line can be found.
2891        set offset $quick_index(${sourceno},[string tolower $name])
2892        incr sourceno 1
2893        if {[catch {set fd [open [macports::getindex $source] r]} result]} {
2894            ui_warn "Can't open index file for source: $source"
2895        } else {
2896            try -pass_signal {
2897                seek $fd $offset
2898                gets $fd line
2899                set name [lindex $line 0]
2900                set len  [lindex $line 1]
2901                set line [read $fd $len]
2902
2903                array set portinfo $line
2904
2905                switch -- $protocol {
2906                    rsync {
2907                        set source_url file://[macports::getsourcepath $source]
2908                    }
2909                    https -
2910                    http -
2911                    ftp {
2912                        set source_url file://[macports::getsourcepath $source]
2913                    }
2914                    default {
2915                        set source_url $source
2916                    }
2917                }
2918                if {[info exists portinfo(portdir)]} {
2919                    lappend line porturl ${source_url}/$portinfo(portdir)
2920                }
2921                lappend matches $name
2922                lappend matches $line
2923            } catch * {
2924                ui_warn "It looks like your PortIndex file for $source may be corrupt."
2925            } finally {
2926                close $fd
2927            }
2928            if {[llength $matches] > 0} {
2929                # if we have a match, exit. If we don't, continue with the next
2930                # source.
2931                break
2932            }
2933        }
2934    }
2935
2936    return $matches
2937}
2938
2939##
2940# Returns all ports in the indices. Faster than 'mportsearch .*' because of the
2941# lack of matching.
2942#
2943# @return associative array in list form where the first field is the port name
2944#         and the second field is the line from PortIndex containing the port
2945#         info. See the return value of mportsearch().
2946# @see mportsearch()
2947proc mportlistall {} {
2948    global macports::sources
2949    set matches [list]
2950
2951    set found 0
2952    foreach source $sources {
2953        set source [lindex $source 0]
2954        set protocol [macports::getprotocol $source]
2955        if {![catch {set fd [open [macports::getindex $source] r]} result]} {
2956            try -pass_signal {
2957                incr found 1
2958                while {[gets $fd line] >= 0} {
2959                    array unset portinfo
2960                    set name [lindex $line 0]
2961                    set len  [lindex $line 1]
2962                    set line [read $fd $len]
2963
2964                    array set portinfo $line
2965
2966                    switch -- $protocol {
2967                        rsync {
2968                            set source_url file://[macports::getsourcepath $source]
2969                        }
2970                        https -
2971                        http -
2972                        ftp {
2973                            set source_url file://[macports::getsourcepath $source]
2974                        }
2975                        default {
2976                            set source_url $source
2977                        }
2978                    }
2979                    if {[info exists portinfo(portdir)]} {
2980                        lappend line porturl ${source_url}/$portinfo(portdir)
2981                    }
2982                    lappend matches $name $line
2983                }
2984            } catch * {
2985                ui_warn "It looks like your PortIndex file for $source may be corrupt."
2986                throw
2987            } finally {
2988                close $fd
2989            }
2990        } else {
2991            ui_warn "Can't open index file for source: $source"
2992        }
2993    }
2994    if {!$found} {
2995        return -code error "No index(es) found! Have you synced your port definitions? Try running 'port selfupdate'."
2996    }
2997
2998    return $matches
2999}
3000
3001##
3002# Loads PortIndex.quick from each source into the quick_index, generating it
3003# first if necessary. Private API of macports1.0, do not use this from outside
3004# macports1.0.
3005proc _mports_load_quickindex {} {
3006    global macports::sources macports::quick_index
3007
3008    unset -nocomplain macports::quick_index
3009
3010    set sourceno 0
3011    foreach source $sources {
3012        unset -nocomplain quicklist
3013        # chop off any tags
3014        set source [lindex $source 0]
3015        set index [macports::getindex $source]
3016        if {![file exists $index]} {
3017            incr sourceno
3018            continue
3019        }
3020        if {![file exists ${index}.quick]} {
3021            ui_warn "No quick index file found, attempting to generate one for source: $source"
3022            if {[catch {set quicklist [mports_generate_quickindex $index]}]} {
3023                incr sourceno
3024                continue
3025            }
3026        }
3027        # only need to read the quick index file if we didn't just update it
3028        if {![info exists quicklist]} {
3029            if {[catch {set fd [open ${index}.quick r]} result]} {
3030                ui_warn "Can't open quick index file for source: $source"
3031                incr sourceno
3032                continue
3033            } else {
3034                set quicklist [read $fd]
3035                close $fd
3036            }
3037        }
3038        foreach entry [split $quicklist \n] {
3039            set quick_index(${sourceno},[lindex $entry 0]) [lindex $entry 1]
3040        }
3041        incr sourceno 1
3042    }
3043    if {!$sourceno} {
3044        ui_warn "No index(es) found! Have you synced your port definitions? Try running 'port selfupdate'."
3045    }
3046}
3047
3048##
3049# Generates a PortIndex.quick file from a PortIndex by using the name field as
3050# key. This allows fast indexing into the PortIndex when using the port name as
3051# key.
3052#
3053# @param index the PortIndex file to create the index for. The resulting quick
3054#              index will be in a file named like \a index, but with ".quick"
3055#              appended.
3056# @return a list of entries written to the quick index file in the same format
3057#         if the file would just have been written.
3058# @throws if the given \a index cannot be opened, the output file cannot be
3059#         opened, an error occurs while using the PortIndex (e.g., because it
3060#         is corrupt), or the quick index generation failed for some other
3061#         reason.
3062proc mports_generate_quickindex {index} {
3063    if {[catch {set indexfd [open $index r]} result] || [catch {set quickfd [open ${index}.quick w]} result]} {
3064        ui_warn "Can't open index file: $index"
3065        return -code error
3066    } else {
3067        try -pass_signal {
3068            set offset [tell $indexfd]
3069            set quicklist {}
3070            while {[gets $indexfd line] >= 0} {
3071                if {[llength $line] != 2} {
3072                    continue
3073                }
3074                set name [lindex $line 0]
3075                append quicklist "[string tolower $name] $offset\n"
3076
3077                set len [lindex $line 1]
3078                read $indexfd $len
3079                set offset [tell $indexfd]
3080            }
3081            puts -nonewline $quickfd $quicklist
3082        } catch {{*} eCode eMessage} {
3083            ui_warn "It looks like your PortIndex file $index may be corrupt."
3084            throw
3085        } finally {
3086            close $indexfd
3087            close $quickfd
3088        }
3089    }
3090    if {[info exists quicklist]} {
3091        return $quicklist
3092    } else {
3093        ui_warn "Failed to generate quick index for: $index"
3094        return -code error
3095    }
3096}
3097
3098proc mportinfo {mport} {
3099    set workername [ditem_key $mport workername]
3100    return [$workername eval array get ::PortInfo]
3101}
3102
3103proc mportclose {mport} {
3104    global macports::open_mports macports::extracted_portdirs
3105    set refcnt [ditem_key $mport refcnt]
3106    incr refcnt -1
3107    ditem_key $mport refcnt $refcnt
3108    if {$refcnt == 0} {
3109        dlist_delete macports::open_mports $mport
3110        set workername [ditem_key $mport workername]
3111        # the hack in _mportexec might have already deleted the worker
3112        if {[interp exists $workername]} {
3113            interp delete $workername
3114        }
3115        set porturl [ditem_key $mport porturl]
3116        if {[info exists macports::extracted_portdirs($porturl)]} {
3117            # TODO port.tcl calls mportopen multiple times on the same port to
3118            # determine a number of attributes and will close the port after
3119            # each call. $macports::extracted_portdirs($porturl) will however
3120            # stay set, which means it will not be extracted twice. We could
3121            # (1) unset $macports::extracted_portdirs($porturl), which would
3122            # lead to downloading the port multiple times, or (2) fix the
3123            # port.tcl code to delay mportclose until the end.
3124            #ui_debug "Removing temporary port directory $macports::extracted_portdirs($porturl)"
3125            #file delete -force $macports::extracted_portdirs($porturl)
3126        }
3127        ditem_delete $mport
3128    }
3129}
3130
3131##### Private Depspec API #####
3132# This API should be considered work in progress and subject to change without notice.
3133##### "
3134
3135# _mportkey
3136# - returns a variable from the port's interpreter
3137
3138proc _mportkey {mport key} {
3139    set workername [ditem_key $mport workername]
3140    return [$workername eval [list set $key]]
3141}
3142
3143# mportdepends builds the list of mports which the given port depends on.
3144# This list is added to $mport.
3145# This list actually depends on the target.
3146# This method can optionally recurse through the dependencies, looking for
3147#   dependencies of dependencies.
3148# This method can optionally cut the search when ports are already installed or
3149#   the dependencies are satisfied.
3150#
3151# mport -> mport item
3152# target -> target to consider the dependency for
3153# recurseDeps -> if the search should be recursive
3154# skipSatisfied -> cut the search tree when encountering installed/satisfied
3155#                  dependencies ports.
3156# accDeps -> accumulator for recursive calls
3157# return 0 if everything was ok, an non zero integer otherwise.
3158proc mportdepends {mport {target {}} {recurseDeps 1} {skipSatisfied 1} {accDeps 0}} {
3159
3160    array set portinfo [mportinfo $mport]
3161    if {$accDeps} {
3162        upvar port_seen port_seen
3163    } else {
3164        array set port_seen {}
3165    }
3166
3167    # progress indicator
3168    if {![macports::ui_isset ports_debug]} {
3169        ui_info -nonewline .
3170        flush stdout
3171    }
3172
3173    if {$target in {{} install activate}} {
3174        if {[catch {_mporterrorifconflictsinstalled $mport}]} {
3175            return 1
3176        }
3177    }
3178
3179    set workername [ditem_key $mport workername]
3180    set deptypes [macports::_deptypes_for_target $target $workername]
3181
3182    set depPorts {}
3183    if {[llength $deptypes] > 0} {
3184        array set optionsarray [ditem_key $mport options]
3185        # avoid propagating requested flag from parent
3186        unset -nocomplain optionsarray(ports_requested)
3187        # subport will be different for deps
3188        unset -nocomplain optionsarray(subport)
3189        set options [array get optionsarray]
3190        set variations [ditem_key $mport variations]
3191        set required_archs [$workername eval get_canonical_archs]
3192        set depends_skip_archcheck [_mportkey $mport depends_skip_archcheck]
3193    }
3194
3195    # Process the dependencies for each of the deptypes
3196    foreach deptype $deptypes {
3197        if {![info exists portinfo($deptype)]} {
3198            continue
3199        }
3200        foreach depspec $portinfo($deptype) {
3201            # get the portname that satisfies the depspec
3202            set dep_portname [$workername eval _get_dep_port $depspec]
3203            # skip port/archs combos we've already seen, and ones with the same port but less archs than ones we've seen (or noarch)
3204            set seenkey ${dep_portname},[join $required_archs ,]
3205            set seen 0
3206            if {[info exists port_seen($seenkey)]} {
3207                set seen 1
3208            } else {
3209                set prev_seenkeys [array names port_seen ${dep_portname},*]
3210                set nrequired [llength $required_archs]
3211                foreach key $prev_seenkeys {
3212                    set key_archs [lrange [split $key ,] 1 end]
3213                    if {$key_archs eq "noarch" || $required_archs eq "noarch" || [llength $key_archs] > $nrequired} {
3214                        set seen 1
3215                        set seenkey $key
3216                        break
3217                    }
3218                }
3219            }
3220            if {$seen} {
3221                if {$port_seen($seenkey) != 0} {
3222                    # nonzero means the dep is not satisfied, so we have to record it
3223                    ditem_append_unique $mport requires $port_seen($seenkey)
3224                }
3225                continue
3226            }
3227
3228            # Is that dependency satisfied or this port installed?
3229            # If we don't skip or if it is not, add it to the list.
3230            set present [_mportispresent $mport $depspec]
3231
3232            if {!$skipSatisfied && $dep_portname eq ""} {
3233                set dep_portname [lindex [split $depspec :] end]
3234            }
3235
3236            set check_archs 0
3237            if {$dep_portname ne "" && $deptype ni {depends_fetch depends_extract}
3238                && $dep_portname ni $depends_skip_archcheck} {
3239                set check_archs 1
3240            }
3241
3242            # need to open the portfile even if the dep is installed if it doesn't have the right archs
3243            set parse 0
3244            if {!$skipSatisfied || !$present || ($check_archs && ![macports::_active_supports_archs $dep_portname $required_archs])} {
3245                set parse 1
3246            }
3247            if {$parse} {
3248                # Find the porturl
3249                if {[catch {set res [mportlookup $dep_portname]} error]} {
3250                    global errorInfo
3251                    ui_msg {}
3252                    ui_debug $errorInfo
3253                    ui_error "Internal error: port lookup failed: $error"
3254                    return 1
3255                }
3256
3257                array unset dep_portinfo
3258                array set dep_portinfo [lindex $res 1]
3259                if {![info exists dep_portinfo(porturl)]} {
3260                    if {![macports::ui_isset ports_debug]} {
3261                        ui_msg {}
3262                    }
3263                    ui_error "Dependency '$dep_portname' not found."
3264                    return 1
3265                } elseif {[info exists dep_portinfo(installs_libs)] && !$dep_portinfo(installs_libs)} {
3266                    set check_archs 0
3267                    if {$skipSatisfied && $present} {
3268                        set parse 0
3269                    }
3270                }
3271
3272                if {$parse} {
3273                    set dep_options $options
3274                    lappend dep_options subport $dep_portinfo(name)
3275                    # Figure out the depport. Check the open_mports list first, since
3276                    # we potentially leak mport references if we mportopen each time,
3277                    # because mportexec only closes each open mport once.
3278                    set depport [dlist_match_multi $macports::open_mports [list porturl $dep_portinfo(porturl) options $dep_options]]
3279
3280                    if {$depport eq ""} {
3281                        # We haven't opened this one yet.
3282                        set depport [mportopen $dep_portinfo(porturl) $dep_options $variations]
3283                    }
3284                }
3285            }
3286
3287            # check archs
3288            if {$parse && $check_archs
3289                && ![macports::_mport_supports_archs $depport $required_archs]} {
3290
3291                set supported_archs [_mportkey $depport supported_archs]
3292                array unset variation_array
3293                array set variation_array [[ditem_key $depport workername] eval "array get variations"]
3294                mportclose $depport
3295                set arch_mismatch 1
3296                set has_universal 0
3297                if {[info exists dep_portinfo(variants)] && {universal} in $dep_portinfo(variants)} {
3298                    # a universal variant is offered
3299                    set has_universal 1
3300                    if {![info exists variation_array(universal)] || $variation_array(universal) ne "+"} {
3301                        set variation_array(universal) +
3302                        # try again with +universal
3303                        set depport [mportopen $dep_portinfo(porturl) $dep_options [array get variation_array]]
3304                        if {[macports::_mport_supports_archs $depport $required_archs]} {
3305                            set arch_mismatch 0
3306                        }
3307                    }
3308                }
3309                if {$arch_mismatch} {
3310                    macports::_explain_arch_mismatch [_mportkey $mport subport] $dep_portname $required_archs $supported_archs $has_universal
3311                    return 1
3312                }
3313            }
3314
3315            if {$parse} {
3316                if {$recurseDeps} {
3317                    # Add to the list we need to recurse on.
3318                    lappend depPorts $depport
3319                }
3320
3321                # Append the sub-port's provides to the port's requirements list.
3322                set depport_provides [ditem_key $depport provides]
3323                ditem_append_unique $mport requires $depport_provides
3324                # record actual archs we ended up getting
3325                set port_seen(${dep_portname},[join [macports::_mport_archs $depport] ,]) $depport_provides
3326            } elseif {$present && $dep_portname ne ""} {
3327                # record actual installed archs
3328                set port_seen(${dep_portname},[join [macports::_active_archs $dep_portname] ,]) 0
3329            }
3330        }
3331    }
3332
3333    # Loop on the depports.
3334    if {$recurseDeps} {
3335        # Dep ports should be installed (all dependencies must be satisfied).
3336        foreach depport $depPorts {
3337            # Any of these may have been closed by a previous recursive call
3338            # and replaced by a universal version. This is fine, just skip.
3339            if {[ditem_key $depport] ne ""} {
3340                set res [mportdepends $depport {} $recurseDeps $skipSatisfied 1]
3341                if {$res != 0} {
3342                    return $res
3343                }
3344            }
3345        }
3346    }
3347
3348    return 0
3349}
3350
3351# check if the given mport can support dependents with the given archs
3352proc macports::_mport_supports_archs {mport required_archs} {
3353    if {$required_archs eq "noarch"} {
3354        return 1
3355    }
3356    set provided_archs [_mport_archs $mport]
3357    if {$provided_archs eq "noarch"} {
3358        return 1
3359    }
3360    foreach arch $required_archs {
3361        if {$arch ni $provided_archs} {
3362            return 0
3363        }
3364    }
3365    return 1
3366}
3367
3368# return the archs of the given mport
3369proc macports::_mport_archs {mport} {
3370    set workername [ditem_key $mport workername]
3371    return [$workername eval get_canonical_archs]
3372}
3373
3374# check if the active version of a port supports the given archs
3375proc macports::_active_supports_archs {portname required_archs} {
3376    if {$required_archs eq "noarch"} {
3377        return 1
3378    }
3379    if {[catch {registry::active $portname}]} {
3380        return 0
3381    }
3382    set provided_archs [_active_archs $portname]
3383    if {$provided_archs eq "noarch" || $provided_archs eq "" || $provided_archs == 0} {
3384        return 1
3385    }
3386    foreach arch $required_archs {
3387        if {$arch ni $provided_archs} {
3388            return 0
3389        }
3390    }
3391    return 1
3392}
3393
3394# get the archs for a given active port
3395proc macports::_active_archs {portname} {
3396    if {[catch {set ilist [registry::active $portname]}]} {
3397        return {}
3398    }
3399    set i [lindex $ilist 0]
3400    set regref [registry::open_entry $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
3401    return [registry::property_retrieve $regref archs]
3402}
3403
3404# print an error message explaining why a port's archs are not provided by a dependency
3405proc macports::_explain_arch_mismatch {port dep required_archs supported_archs has_universal} {
3406    global macports::universal_archs
3407    if {![macports::ui_isset ports_debug]} {
3408        ui_msg {}
3409    }
3410
3411    set s [expr {[llength $required_archs] == 1 ? "" : "s"}]
3412
3413    ui_error "Cannot install $port for the arch${s} '$required_archs' because"
3414    if {$supported_archs ne ""} {
3415        set ss [expr {[llength $supported_archs] == 1 ? "" : "s"}]
3416        foreach arch $required_archs {
3417            if {$arch ni $supported_archs} {
3418                ui_error "its dependency $dep only supports the arch${ss} '$supported_archs'."
3419                return
3420            }
3421        }
3422    }
3423    if {$has_universal} {
3424        foreach arch $required_archs {
3425            if {$arch ni $universal_archs} {
3426                ui_error "its dependency $dep does not build for the required arch${s} by default"
3427                ui_error "and the configured universal_archs '$universal_archs' are not sufficient."
3428                return
3429            }
3430        }
3431        ui_error "its dependency $dep cannot build for the required arch${s}."
3432        return
3433    }
3434    ui_error "its dependency $dep does not build for the required arch${s} by default"
3435    ui_error "and does not have a universal variant."
3436}
3437
3438# check if the given mport has any dependencies of the given types
3439proc macports::_mport_has_deptypes {mport deptypes} {
3440    array set portinfo [mportinfo $mport]
3441    foreach type $deptypes {
3442        if {[info exists portinfo($type)] && $portinfo($type) ne ""} {
3443            return 1
3444        }
3445    }
3446    return 0
3447}
3448
3449# check if the given target needs dependencies installed first
3450proc macports::_target_needs_deps {target} {
3451    # XXX: need a better way than checking this hardcoded list
3452    switch -- $target {
3453        fetch -
3454        checksum -
3455        extract -
3456        patch -
3457        configure -
3458        build -
3459        test -
3460        destroot -
3461        install -
3462        activate -
3463        dmg -
3464        mdmg -
3465        pkg -
3466        mpkg {return 1}
3467        default {return 0}
3468    }
3469}
3470
3471# Determine dependency types required for target
3472proc macports::_deptypes_for_target {target workername} {
3473    switch -- $target {
3474        fetch       -
3475        checksum    {return depends_fetch}
3476        extract     -
3477        patch       {return "depends_fetch depends_extract"}
3478        configure   -
3479        build       {return "depends_fetch depends_extract depends_build depends_lib"}
3480        test        {return "depends_fetch depends_extract depends_build depends_lib depends_run depends_test"}
3481        destroot    {return "depends_fetch depends_extract depends_build depends_lib depends_run"}
3482        dmg         -
3483        pkg         -
3484        mdmg        -
3485        mpkg        {
3486            if {[global_option_isset ports_binary_only] ||
3487                (![global_option_isset ports_source_only] && [$workername eval _archive_available])} {
3488                return "depends_lib depends_run"
3489            } else {
3490                return "depends_fetch depends_extract depends_build depends_lib depends_run"
3491            }
3492        }
3493        install     -
3494        activate    -
3495        {}          {
3496            if {[global_option_isset ports_binary_only] ||
3497                [$workername eval registry_exists \$subport \$version \$revision \$portvariants]
3498                || (![global_option_isset ports_source_only] && [$workername eval _archive_available])} {
3499                return "depends_lib depends_run"
3500            } else {
3501                return "depends_fetch depends_extract depends_build depends_lib depends_run"
3502            }
3503        }
3504    }
3505    return {}
3506}
3507
3508# selfupdate procedure
3509proc macports::selfupdate {{optionslist {}} {updatestatusvar {}}} {
3510    global macports::prefix macports::portdbpath macports::rsync_server macports::rsync_dir \
3511           macports::rsync_options macports::autoconf::macports_version \
3512           macports::autoconf::rsync_path tcl_platform macports::autoconf::openssl_path \
3513           macports::autoconf::tar_path
3514    array set options $optionslist
3515
3516    # variable that indicates whether we actually updated base
3517    if {$updatestatusvar ne ""} {
3518        upvar $updatestatusvar updatestatus
3519        set updatestatus no
3520    }
3521
3522    # are we syncing a tarball? (implies detached signature)
3523    set is_tarball 0
3524    if {[string range $rsync_dir end-3 end] eq ".tar"} {
3525        set is_tarball 1
3526        set mp_source_path [file join $portdbpath sources $rsync_server [file dirname $rsync_dir]]
3527    } else {
3528        if {[string index $rsync_dir end] ne "/"} {
3529            append rsync_dir /
3530        }
3531        set mp_source_path [file join $portdbpath sources $rsync_server $rsync_dir]
3532    }
3533    # create the path to the to be downloaded sources if it doesn't exist
3534    if {![file exists $mp_source_path]} {
3535        file mkdir $mp_source_path
3536    }
3537    ui_debug "MacPorts sources location: $mp_source_path"
3538
3539    # sync the MacPorts sources
3540    ui_msg "$macports::ui_prefix Updating MacPorts base sources using rsync"
3541    if {[catch {system "$rsync_path $rsync_options rsync://${rsync_server}/$rsync_dir $mp_source_path"} result]} {
3542       return -code error "Error synchronizing MacPorts sources: $result"
3543    }
3544
3545    if {$is_tarball} {
3546        # verify signature for tarball
3547        global macports::archivefetch_pubkeys
3548        if {[catch {system "$rsync_path $rsync_options rsync://${rsync_server}/${rsync_dir}.rmd160 $mp_source_path"} result]} {
3549            return -code error "Error synchronizing MacPorts source signature: $result"
3550        }
3551        set openssl [findBinary openssl $macports::autoconf::openssl_path]
3552        set tarball ${mp_source_path}/[file tail $rsync_dir]
3553        set signature ${tarball}.rmd160
3554        set verified 0
3555        foreach pubkey $macports::archivefetch_pubkeys {
3556            if {![catch {exec $openssl dgst -ripemd160 -verify $pubkey -signature $signature $tarball} result]} {
3557                set verified 1
3558                ui_debug "successful verification with key $pubkey"
3559                break
3560            } else {
3561                ui_debug "failed verification with key $pubkey"
3562                ui_debug "openssl output: $result"
3563            }
3564        }
3565        if {!$verified} {
3566            return -code error "Failed to verify signature for MacPorts source!"
3567        }
3568
3569        # extract tarball and move into place
3570        set tar [macports::findBinary tar $macports::autoconf::tar_path]
3571        file mkdir ${mp_source_path}/tmp
3572        set tar_cmd "$tar -C ${mp_source_path}/tmp -xf $tarball"
3573        ui_debug $tar_cmd
3574        if {[catch {system $tar_cmd}]} {
3575            return -code error "Failed to extract MacPorts sources from tarball!"
3576        }
3577        file delete -force ${mp_source_path}/base
3578        file rename ${mp_source_path}/tmp/base ${mp_source_path}/base
3579        file delete -force ${mp_source_path}/tmp
3580        # set the final extracted source path
3581        set mp_source_path ${mp_source_path}/base
3582    }
3583
3584    # echo current MacPorts version
3585    ui_msg "MacPorts base version $macports::autoconf::macports_version installed,"
3586
3587    if {[info exists options(ports_force)] && $options(ports_force)} {
3588        set use_the_force_luke yes
3589        ui_debug "Forcing a rebuild and reinstallation of MacPorts"
3590    } else {
3591        set use_the_force_luke no
3592        ui_debug "Rebuilding and reinstalling MacPorts if needed"
3593    }
3594
3595    # Choose what version file to use: old, floating point format or new, real version number format
3596    set version_file [file join $mp_source_path config macports_version]
3597    if {[file exists $version_file]} {
3598        set fd [open $version_file r]
3599        gets $fd macports_version_new
3600        close $fd
3601        # echo downloaded MacPorts version
3602        ui_msg "MacPorts base version $macports_version_new downloaded."
3603    } else {
3604        ui_warn "No version file found, please rerun selfupdate."
3605        set macports_version_new 0
3606    }
3607
3608    # check if we we need to rebuild base
3609    set comp [vercmp $macports_version_new $macports::autoconf::macports_version]
3610
3611    # syncing ports tree.
3612    if {![info exists options(ports_selfupdate_nosync)] || !$options(ports_selfupdate_nosync)} {
3613        if {$comp > 0} {
3614            # updated portfiles potentially need new base to parse - tell sync to try to
3615            # use prefabricated PortIndex files and signal if it couldn't
3616            lappend optionslist no_reindex 1 needed_portindex_var needed_portindex
3617        }
3618        if {[catch {mportsync $optionslist} result]} {
3619            return -code error "Couldn't sync the ports tree: $result"
3620        }
3621    }
3622
3623    if {$use_the_force_luke || $comp > 0} {
3624        if {[info exists options(ports_dryrun)] && $options(ports_dryrun)} {
3625            ui_msg "$macports::ui_prefix MacPorts base is outdated, selfupdate would install $macports_version_new (dry run)"
3626        } else {
3627            ui_msg "$macports::ui_prefix MacPorts base is outdated, installing new version $macports_version_new"
3628
3629            # get installation user/group and permissions
3630            set owner [file attributes $prefix -owner]
3631            set group [file attributes $prefix -group]
3632            set perms [string range [file attributes $prefix -permissions] end-3 end]
3633            if {$tcl_platform(user) ne "root" && $tcl_platform(user) ne $owner} {
3634                return -code error "User $tcl_platform(user) does not own $prefix - try using sudo"
3635            }
3636            ui_debug "Permissions OK"
3637
3638            set configure_args "--prefix=[macports::shellescape $prefix] --with-install-user=[macports::shellescape $owner] --with-install-group=[macports::shellescape $group] --with-directory-mode=[macports::shellescape $perms]"
3639            # too many users have an incompatible readline in /usr/local, see ticket #10651
3640            if {$tcl_platform(os) ne "Darwin" || $prefix eq "/usr/local"
3641                || ([glob -nocomplain /usr/local/lib/lib{readline,history}*] eq "" && [glob -nocomplain /usr/local/include/readline/*.h] eq "")} {
3642                append configure_args " --enable-readline"
3643            } else {
3644                ui_warn "Disabling readline support due to readline in /usr/local"
3645            }
3646
3647            if {$prefix eq "/usr/local" || $prefix eq "/usr"} {
3648                append configure_args " --with-unsupported-prefix"
3649            }
3650
3651            # Choose a sane compiler
3652            set cc_arg {}
3653            if {$::macports::os_platform eq "darwin"} {
3654                set cc_arg "CC=/usr/bin/cc OBJC=/usr/bin/cc "
3655            }
3656
3657            # do the actual configure, build and installation of new base
3658            ui_msg "Installing new MacPorts release in $prefix as ${owner}:${group}; permissions ${perms}\n"
3659            if {[catch {system "cd $mp_source_path && ${cc_arg}./configure $configure_args && make SELFUPDATING=1 && make install SELFUPDATING=1"} result]} {
3660                return -code error "Error installing new MacPorts base: $result"
3661            }
3662            if {[info exists updatestatus]} {
3663                set updatestatus yes
3664            }
3665        }
3666    } elseif {$comp < 0} {
3667        ui_msg "$macports::ui_prefix MacPorts base is probably trunk or a release candidate"
3668    } else {
3669        ui_msg "$macports::ui_prefix MacPorts base is already the latest version"
3670    }
3671
3672    # set the MacPorts sources to the right owner
3673    set sources_owner [file attributes [file join $portdbpath sources/] -owner]
3674    ui_debug "Setting MacPorts sources ownership to $sources_owner"
3675    if {[catch {exec [findBinary chown $macports::autoconf::chown_path] -R $sources_owner [file join $portdbpath sources/]} result]} {
3676        return -code error "Couldn't change permissions of the MacPorts sources at $mp_source_path to ${sources_owner}: $result"
3677    }
3678
3679    if {![info exists options(ports_selfupdate_nosync)] || !$options(ports_selfupdate_nosync)} {
3680        if {[info exists needed_portindex]} {
3681            ui_msg "Not all sources could be fully synced using the old version of MacPorts."
3682            ui_msg "Please run selfupdate again now that MacPorts base has been updated."
3683        } else {
3684            ui_msg "\nThe ports tree has been updated. To upgrade your installed ports, you should run"
3685            ui_msg "  port upgrade outdated"
3686        }
3687    }
3688
3689    return 0
3690}
3691
3692# upgrade API wrapper procedure
3693# return codes:
3694#   0 = success
3695#   1 = general failure
3696#   2 = port name not found in index
3697#   3 = port not installed
3698proc macports::upgrade {portname dspec variationslist optionslist {depscachename {}}} {
3699    # only installed ports can be upgraded
3700    if {![registry::entry_exists_for_name $portname]} {
3701        ui_error "$portname is not installed"
3702        return 3
3703    }
3704    if {$depscachename ne ""} {
3705        upvar $depscachename depscache
3706    } else {
3707        array set depscache {}
3708    }
3709    # stop upgrade from being called via mportexec as well
3710    set orig_nodeps yes
3711    if {![info exists macports::global_options(ports_nodeps)]} {
3712        set macports::global_options(ports_nodeps) yes
3713        set orig_nodeps no
3714    }
3715
3716    # run the actual upgrade
3717    set status [macports::_upgrade $portname $dspec $variationslist $optionslist depscache]
3718
3719    if {!$orig_nodeps} {
3720        unset -nocomplain macports::global_options(ports_nodeps)
3721    }
3722
3723    return $status
3724}
3725
3726# main internal upgrade procedure
3727proc macports::_upgrade {portname dspec variationslist optionslist {depscachename {}}} {
3728    global macports::global_variations
3729    array set options $optionslist
3730
3731    if {$depscachename ne ""} {
3732        upvar $depscachename depscache
3733    }
3734
3735    # Is this a dry run?
3736    set is_dryrun no
3737    if {[info exists options(ports_dryrun)] && $options(ports_dryrun)} {
3738        set is_dryrun yes
3739    }
3740
3741    # Is this a rev-upgrade-called run?
3742    set is_revupgrade no
3743    if {[info exists options(ports_revupgrade)] && $options(ports_revupgrade)} {
3744        set is_revupgrade yes
3745        # unset revupgrade options so we can upgrade dependencies with the same
3746        # $options without also triggering a rebuild there, see #40150
3747        unset options(ports_revupgrade)
3748    }
3749    set is_revupgrade_second_run no
3750    if {[info exists options(ports_revupgrade_second_run)] && $options(ports_revupgrade_second_run)} {
3751        set is_revupgrade_second_run yes
3752        # unset revupgrade options so we can upgrade dependencies with the same
3753        # $options without also triggering a rebuild there, see #40150
3754        unset options(ports_revupgrade_second_run)
3755    }
3756
3757    # check if the port is in tree
3758    if {[catch {mportlookup $portname} result]} {
3759        global errorInfo
3760        ui_debug $errorInfo
3761        ui_error "port lookup failed: $result"
3762        return 1
3763    }
3764    # argh! port doesnt exist!
3765    if {$result eq ""} {
3766        ui_warn "No port $portname found in the index."
3767        return 2
3768    }
3769    # fill array with information
3770    array set portinfo [lindex $result 1]
3771    # set portname again since the one we were passed may not have had the correct case
3772    set portname $portinfo(name)
3773    set options(subport) $portname
3774
3775    set ilist {}
3776    if {[catch {set ilist [registry::installed $portname {}]} result]} {
3777        if {$result eq "Registry error: $portname not registered as installed."} {
3778            ui_debug "$portname is *not* installed by MacPorts"
3779
3780            # We need to pass _mportispresent a reference to the mport that is
3781            # actually declaring the dependency on the one we're checking for.
3782            # We got here via _upgrade_dependencies, so we grab it from 2 levels up.
3783            upvar 2 mport parentmport
3784            if {![_mportispresent $parentmport $dspec]} {
3785                # open porthandle
3786                set porturl $portinfo(porturl)
3787                if {![info exists porturl]} {
3788                    set porturl file://./
3789                }
3790                # Grab the variations from the parent
3791                upvar 2 variations variations
3792
3793                if {[catch {set mport [mportopen $porturl [array get options] [array get variations]]} result]} {
3794                    global errorInfo
3795                    ui_debug $errorInfo
3796                    ui_error "Unable to open port: $result"
3797                    return 1
3798                }
3799                # While we're at it, update the portinfo
3800                array unset portinfo
3801                array set portinfo [mportinfo $mport]
3802
3803                # upgrade its dependencies first
3804                set status [_upgrade_dependencies portinfo depscache variationslist options]
3805                if {$status != 0 && $status != 2 && ![ui_isset ports_processall]} {
3806                    catch {mportclose $mport}
3807                    return $status
3808                }
3809                # now install it
3810                if {[catch {set result [mportexec $mport activate]} result]} {
3811                    global errorInfo
3812                    ui_debug $errorInfo
3813                    ui_error "Unable to exec port: $result"
3814                    catch {mportclose $mport}
3815                    return 1
3816                }
3817                if {$result > 0} {
3818                    ui_error "Problem while installing $portname"
3819                    catch {mportclose $mport}
3820                    return $result
3821                }
3822                # we just installed it, so mark it done in the cache
3823                set depscache(port:$portname) 1
3824                mportclose $mport
3825            } else {
3826                # dependency is satisfied by something other than the named port
3827                ui_debug "$portname not installed, soft dependency satisfied"
3828                # mark this depspec as satisfied in the cache
3829                set depscache($dspec) 1
3830            }
3831            # the rest of the proc doesn't matter for a port that is freshly
3832            # installed or not installed
3833            return 0
3834        } else {
3835            ui_error "Checking installed version failed: $result"
3836            return 1
3837        }
3838    } else {
3839        # we'll now take care of upgrading it, so we can add it to the cache
3840        set depscache(port:$portname) 1
3841    }
3842
3843    # set version_in_tree and revision_in_tree
3844    if {![info exists portinfo(version)]} {
3845        ui_error "Invalid port entry for ${portname}, missing version"
3846        return 1
3847    }
3848    set version_in_tree $portinfo(version)
3849    set revision_in_tree $portinfo(revision)
3850    set epoch_in_tree $portinfo(epoch)
3851
3852    # find latest version installed and active version (if any)
3853    set anyactive no
3854    set version_installed {}
3855    foreach i $ilist {
3856        set variant [lindex $i 3]
3857        set version [lindex $i 1]
3858        set revision [lindex $i 2]
3859        set epoch [lindex $i 5]
3860        if {$version_installed eq "" || ($epoch > $epoch_installed && $version ne $version_installed) ||
3861                ($epoch >= $epoch_installed && [vercmp $version $version_installed] > 0)
3862                || ($epoch >= $epoch_installed
3863                    && [vercmp $version $version_installed] == 0
3864                    && $revision > $revision_installed)} {
3865            set version_installed $version
3866            set revision_installed $revision
3867            set variant_installed $variant
3868            set epoch_installed $epoch
3869        }
3870
3871        set isactive [lindex $i 4]
3872        if {$isactive == 1} {
3873            set anyactive yes
3874            set version_active $version
3875            set revision_active $revision
3876            set variant_active $variant
3877            set epoch_active $epoch
3878        }
3879    }
3880
3881    # output version numbers
3882    ui_debug "epoch: in tree: $epoch_in_tree installed: $epoch_installed"
3883    ui_debug "$portname ${version_in_tree}_$revision_in_tree exists in the ports tree"
3884    ui_debug "$portname ${version_installed}_$revision_installed $variant_installed is the latest installed"
3885    if {$anyactive} {
3886        ui_debug "$portname ${version_active}_$revision_active $variant_active is active"
3887        # save existing variant for later use
3888        set oldvariant $variant_active
3889        set regref [registry::open_entry $portname $version_active $revision_active $variant_active $epoch_active]
3890    } else {
3891        ui_debug "no version of $portname is active"
3892        set oldvariant $variant_installed
3893        set regref [registry::open_entry $portname $version_installed $revision_installed $variant_installed $epoch_installed]
3894    }
3895    set oldnegatedvariant [registry::property_retrieve $regref negated_variants]
3896    if {$oldnegatedvariant == 0} {
3897        set oldnegatedvariant {}
3898    }
3899    set requestedflag [registry::property_retrieve $regref requested]
3900    set os_platform_installed [registry::property_retrieve $regref os_platform]
3901    set os_major_installed [registry::property_retrieve $regref os_major]
3902
3903    # Before we do
3904    # dependencies, we need to figure out the final variants,
3905    # open the port, and update the portinfo.
3906    set porturl $portinfo(porturl)
3907    if {![info exists porturl]} {
3908        set porturl file://./
3909    }
3910
3911    # Note $variationslist is left alone and so retains the original
3912    # requested variations, which should be passed to recursive calls to
3913    # upgrade; while variations gets existing variants and global variations
3914    # merged in later on, so it applies only to this port's upgrade
3915    array set variations $variationslist
3916
3917    set globalvarlist [array get macports::global_variations]
3918
3919    set minusvariant [lrange [split $oldnegatedvariant -] 1 end]
3920    set plusvariant [lrange [split $oldvariant +] 1 end]
3921    ui_debug "Merging existing variants '${oldvariant}$oldnegatedvariant' into variants"
3922    set oldvariantlist [list]
3923    foreach v $plusvariant {
3924        lappend oldvariantlist $v +
3925    }
3926    foreach v $minusvariant {
3927        lappend oldvariantlist $v -
3928    }
3929
3930    # merge in the old variants
3931    foreach {variation value} $oldvariantlist {
3932        if {![info exists variations($variation)]} {
3933            set variations($variation) $value
3934        }
3935    }
3936
3937    # Now merge in the global (i.e. variants.conf) variations.
3938    # We wait until now so that existing variants for this port
3939    # override global variations
3940    foreach {variation value} $globalvarlist {
3941        if {![info exists variations($variation)]} {
3942            set variations($variation) $value
3943        }
3944    }
3945
3946    ui_debug "new fully merged portvariants: [array get variations]"
3947
3948    # at this point we need to check if a different port will be replacing this one
3949    if {[info exists portinfo(replaced_by)] && ![info exists options(ports_upgrade_no-replace)]} {
3950        ui_msg "$macports::ui_prefix $portname is replaced by $portinfo(replaced_by)"
3951        if {[catch {mportlookup $portinfo(replaced_by)} result]} {
3952            global errorInfo
3953            ui_debug $errorInfo
3954            ui_error "port lookup failed: $result"
3955            return 1
3956        }
3957        if {$result eq ""} {
3958            ui_error "No port $portinfo(replaced_by) found."
3959            return 1
3960        }
3961        array unset portinfo
3962        array set portinfo [lindex $result 1]
3963        set newname $portinfo(name)
3964
3965        set porturl $portinfo(porturl)
3966        if {![info exists porturl]} {
3967            set porturl file://./
3968        }
3969        set depscache(port:$newname) 1
3970    } else {
3971        set newname $portname
3972    }
3973
3974    array set interp_options [array get options]
3975    set interp_options(ports_requested) $requestedflag
3976    set interp_options(subport) $newname
3977    # Mark this port to be rebuilt from source if this isn't the first time it
3978    # was flagged as broken by rev-upgrade
3979    if {$is_revupgrade_second_run} {
3980        set interp_options(ports_source_only) yes
3981    }
3982
3983    if {[catch {set mport [mportopen $porturl [array get interp_options] [array get variations]]} result]} {
3984        global errorInfo
3985        ui_debug $errorInfo
3986        ui_error "Unable to open port: $result"
3987        return 1
3988    }
3989    array unset interp_options
3990
3991    array unset portinfo
3992    array set portinfo [mportinfo $mport]
3993    set version_in_tree $portinfo(version)
3994    set revision_in_tree $portinfo(revision)
3995    set epoch_in_tree $portinfo(epoch)
3996
3997    set build_override 0
3998    set will_install yes
3999    # check installed version against version in ports
4000    if {([vercmp $version_installed $version_in_tree] > 0
4001            || ([vercmp $version_installed $version_in_tree] == 0
4002                && [vercmp $revision_installed $revision_in_tree] >= 0))
4003        && ![info exists options(ports_upgrade_force)]} {
4004        if {$portname ne $newname} {
4005            ui_debug "ignoring versions, installing replacement port"
4006        } elseif {$epoch_installed < $epoch_in_tree && $version_installed ne $version_in_tree} {
4007            set build_override 1
4008            ui_debug "epoch override ... upgrading!"
4009        } elseif {[info exists options(ports_upgrade_enforce-variants)] && $options(ports_upgrade_enforce-variants)
4010                  && [info exists portinfo(canonical_active_variants)] && $portinfo(canonical_active_variants) ne $oldvariant} {
4011            ui_debug "variant override ... upgrading!"
4012        } elseif {$os_platform_installed ne "" && $os_major_installed ne "" && $os_platform_installed != 0
4013                  && ([_mportkey $mport os.platform] ne $os_platform_installed
4014                  || [_mportkey $mport os.major] != $os_major_installed)} {
4015            ui_debug "platform mismatch ... upgrading!"
4016            set build_override 1
4017        } elseif {$is_revupgrade_second_run} {
4018            ui_debug "rev-upgrade override ... upgrading (from source)!"
4019            set build_override 1
4020        } elseif {$is_revupgrade} {
4021            ui_debug "rev-upgrade override ... upgrading!"
4022            # in the first run of rev-upgrade, only activate possibly already existing files and check for missing dependencies
4023            # do nothing, just prevent will_install being set to no below
4024        } else {
4025            if {[info exists portinfo(canonical_active_variants)] && $portinfo(canonical_active_variants) ne $oldvariant} {
4026                if {[llength $variationslist] > 0} {
4027                    ui_warn "Skipping upgrade since $portname ${version_installed}_$revision_installed >= $portname ${version_in_tree}_${revision_in_tree}, even though installed variants \"$oldvariant\" do not match \"$portinfo(canonical_active_variants)\". Use 'upgrade --enforce-variants' to switch to the requested variants."
4028                } else {
4029                    ui_debug "Skipping upgrade since $portname ${version_installed}_$revision_installed >= $portname ${version_in_tree}_${revision_in_tree}, even though installed variants \"$oldvariant\" do not match \"$portinfo(canonical_active_variants)\"."
4030                }
4031            } else {
4032                ui_debug "No need to upgrade! $portname ${version_installed}_$revision_installed >= $portname ${version_in_tree}_$revision_in_tree"
4033            }
4034            set will_install no
4035        }
4036    }
4037
4038    set will_build no
4039    set already_installed [registry::entry_exists $newname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)]
4040    # avoid building again unnecessarily
4041    if {$will_install &&
4042        ([info exists options(ports_upgrade_force)]
4043            || $build_override == 1
4044            || !$already_installed)} {
4045        set will_build yes
4046    }
4047
4048    # first upgrade dependencies
4049    if {![info exists options(ports_nodeps)]} {
4050        # the last arg is because we might have to build from source if a rebuild is being forced
4051        set status [_upgrade_dependencies portinfo depscache variationslist options [expr {$will_build && $already_installed}]]
4052        if {$status != 0 && $status != 2 && ![ui_isset ports_processall]} {
4053            catch {mportclose $mport}
4054            return $status
4055        }
4056    } else {
4057        ui_debug "Not following dependencies"
4058    }
4059
4060    if {!$will_install} {
4061        # nothing to do for this port, so just check if we have to do dependents
4062        if {[info exists options(ports_do_dependents)]} {
4063            # We do dependents ..
4064            set options(ports_nodeps) 1
4065
4066            registry::open_dep_map
4067            if {$anyactive} {
4068                set deplist [registry::list_dependents $portname $version_active $revision_active $variant_active]
4069            } else {
4070                set deplist [registry::list_dependents $portname $version_installed $revision_installed $variant_installed]
4071            }
4072
4073            if {[llength deplist] > 0} {
4074                foreach dep $deplist {
4075                    set mpname [lindex $dep 2]
4076                    if {![llength [array get depscache port:$mpname]]} {
4077                        set status [macports::_upgrade $mpname port:$mpname $variationslist [array get options] depscache]
4078                        if {$status != 0 && $status != 2 && ![ui_isset ports_processall]} {
4079                            catch {mportclose $mport}
4080                            return $status
4081                        }
4082                    }
4083                }
4084            }
4085        }
4086        mportclose $mport
4087        return 0
4088    }
4089
4090    if {$will_build} {
4091        if {$already_installed
4092            && ([info exists options(ports_upgrade_force)] || $build_override == 1)} {
4093            # Tell archivefetch/unarchive not to use the installed archive, i.e. a
4094            # fresh one will be either fetched or built locally.
4095            # Ideally this would be done in the interp_options when we mportopen,
4096            # but we don't know if we want to do this at that point.
4097            set workername [ditem_key $mport workername]
4098            $workername eval "set force_archive_refresh yes"
4099
4100            # run archivefetch and destroot for version_in_tree
4101            # doing this instead of just running install ensures that we have the
4102            # new copy ready but not yet installed, so we can safely uninstall the
4103            # existing one.
4104            if {[catch {set result [mportexec $mport archivefetch]} result] || $result != 0} {
4105                if {[info exists ::errorInfo]} {
4106                    ui_debug $::errorInfo
4107                }
4108                catch {mportclose $mport}
4109                return 1
4110            }
4111            # the following is a noop if archivefetch found an archive
4112            if {[catch {set result [mportexec $mport destroot]} result] || $result != 0} {
4113                if {[info exists ::errorInfo]} {
4114                    ui_debug $::errorInfo
4115                }
4116                catch {mportclose $mport}
4117                return 1
4118            }
4119        } else {
4120            # Normal non-forced case
4121            # install version_in_tree (but don't activate yet)
4122            if {[catch {set result [mportexec $mport install]} result] || $result != 0} {
4123                if {[info exists ::errorInfo]} {
4124                    ui_debug $::errorInfo
4125                }
4126                catch {mportclose $mport}
4127                return 1
4128            }
4129        }
4130    }
4131
4132    # are we installing an existing version due to force or epoch override?
4133    if {$already_installed
4134        && ([info exists options(ports_upgrade_force)] || $build_override == 1)} {
4135         ui_debug "Uninstalling $newname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants)"
4136        # we have to force the uninstall in case of dependents
4137        set force_cur [info exists options(ports_force)]
4138        set options(ports_force) yes
4139        set existing_epoch [lindex [registry::installed $newname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants)] 0 5]
4140        set newregref [registry::open_entry $newname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants) $existing_epoch]
4141        if {$is_dryrun} {
4142            ui_msg "Skipping uninstall $newname @${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants) (dry run)"
4143        } elseif {![registry::run_target $newregref uninstall [array get options]]
4144                  && [catch {registry_uninstall::uninstall $newname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants) [array get options]} result]} {
4145            global errorInfo
4146            ui_debug $errorInfo
4147            ui_error "Uninstall $newname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants) failed: $result"
4148            catch {mportclose $mport}
4149            return 1
4150        }
4151        if {!$force_cur} {
4152            unset options(ports_force)
4153        }
4154        if {$anyactive && $version_in_tree eq $version_active && $revision_in_tree == $revision_active
4155            && $portinfo(canonical_active_variants) eq $variant_active && $portname eq $newname} {
4156            set anyactive no
4157        }
4158    }
4159    if {$anyactive && $portname ne $newname} {
4160        # replaced_by in effect, deactivate the old port
4161        # we have to force the deactivate in case of dependents
4162        set force_cur [info exists options(ports_force)]
4163        set options(ports_force) yes
4164        if {$is_dryrun} {
4165            ui_msg "Skipping deactivate $portname @${version_active}_${revision_active}$variant_active (dry run)"
4166        } elseif {![catch {registry::active $portname}] &&
4167                  ![registry::run_target $regref deactivate [array get options]]
4168                  && [catch {portimage::deactivate $portname $version_active $revision_active $variant_active [array get options]} result]} {
4169            global errorInfo
4170            ui_debug $errorInfo
4171            ui_error "Deactivating $portname @${version_active}_${revision_active}$variant_active failed: $result"
4172            catch {mportclose $mport}
4173            return 1
4174        }
4175        if {!$force_cur} {
4176            unset options(ports_force)
4177        }
4178        set anyactive no
4179    }
4180    if {[info exists options(port_uninstall_old)] && $portname eq $newname} {
4181        # uninstalling now could fail due to dependents when not forced,
4182        # because the new version is not installed
4183        set uninstall_later yes
4184    }
4185
4186    if {$is_dryrun} {
4187        if {$anyactive} {
4188            ui_msg "Skipping deactivate $portname @${version_active}_${revision_active}$variant_active (dry run)"
4189        }
4190        ui_msg "Skipping activate $newname @${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants) (dry run)"
4191    } elseif {[catch {set result [mportexec $mport activate]} result]} {
4192        global errorInfo
4193        ui_debug $errorInfo
4194        ui_error "Couldn't activate $newname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants): $result"
4195        catch {mportclose $mport}
4196        return 1
4197    }
4198
4199    # Check if we have to do dependents
4200    if {[info exists options(ports_do_dependents)]} {
4201        # We do dependents ..
4202        set options(ports_nodeps) 1
4203
4204        registry::open_dep_map
4205        if {$portname ne $newname} {
4206            set deplist [registry::list_dependents $newname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)]
4207        } else {
4208            set deplist [list]
4209        }
4210        if {$anyactive} {
4211            set deplist [concat $deplist [registry::list_dependents $portname $version_active $revision_active $variant_active]]
4212        } else {
4213            set deplist [concat $deplist [registry::list_dependents $portname $version_installed $revision_installed $variant_installed]]
4214        }
4215
4216        if {[llength deplist] > 0} {
4217            foreach dep $deplist {
4218                set mpname [lindex $dep 2]
4219                if {![llength [array get depscache port:$mpname]]} {
4220                    set status [macports::_upgrade $mpname port:$mpname $variationslist [array get options] depscache]
4221                    if {$status != 0 && $status != 2 && ![ui_isset ports_processall]} {
4222                        catch {mportclose $mport}
4223                        return $status
4224                    }
4225                }
4226            }
4227        }
4228    }
4229
4230    if {[info exists uninstall_later] && $uninstall_later} {
4231        foreach i $ilist {
4232            set version [lindex $i 1]
4233            set revision [lindex $i 2]
4234            set variant [lindex $i 3]
4235            if {$version eq $version_in_tree && $revision == $revision_in_tree && $variant eq $portinfo(canonical_active_variants) && $portname eq $newname} {
4236                continue
4237            }
4238            set epoch [lindex $i 5]
4239            ui_debug "Uninstalling $portname ${version}_${revision}$variant"
4240            set regref [registry::open_entry $portname $version $revision $variant $epoch]
4241            if {$is_dryrun} {
4242                ui_msg "Skipping uninstall $portname @${version}_${revision}$variant (dry run)"
4243            } elseif {![registry::run_target $regref uninstall $optionslist]
4244                      && [catch {registry_uninstall::uninstall $portname $version $revision $variant $optionslist} result]} {
4245                global errorInfo
4246                ui_debug $errorInfo
4247                # replaced_by can mean that we try to uninstall all versions of the old port, so handle errors due to dependents
4248                if {$result ne "Please uninstall the ports that depend on $portname first." && ![ui_isset ports_processall]} {
4249                    ui_error "Uninstall $portname @${version}_${revision}$variant failed: $result"
4250                    catch {mportclose $mport}
4251                    return 1
4252                }
4253            }
4254        }
4255    }
4256
4257    # close the port handle
4258    mportclose $mport
4259    return 0
4260}
4261
4262# upgrade_dependencies: helper proc for upgrade
4263# Calls upgrade on each dependency listed in the PortInfo.
4264# Uses upvar to access the variables.
4265proc macports::_upgrade_dependencies {portinfoname depscachename variationslistname optionsname {build_needed no}} {
4266    upvar $portinfoname portinfo $depscachename depscache \
4267          $variationslistname variationslist \
4268          $optionsname options
4269    upvar mport parentmport
4270
4271    # If we're following dependents, we only want to follow this port's
4272    # dependents, not those of all its dependencies. Otherwise, we would
4273    # end up processing this port's dependents n+1 times (recursively!),
4274    # where n is the number of dependencies this port has, since this port
4275    # is of course a dependent of each of its dependencies. Plus the
4276    # dependencies could have any number of unrelated dependents.
4277
4278    # So we save whether we're following dependents, unset the option
4279    # while doing the dependencies, and restore it afterwards.
4280    set saved_do_dependents [info exists options(ports_do_dependents)]
4281    unset -nocomplain options(ports_do_dependents)
4282
4283    set parentworker [ditem_key $parentmport workername]
4284    # each required dep type is upgraded
4285    if {$build_needed && ![global_option_isset ports_binary_only]} {
4286        set dtypes [_deptypes_for_target destroot $parentworker]
4287    } else {
4288        set dtypes [_deptypes_for_target install $parentworker]
4289    }
4290
4291    set status 0
4292    foreach dtype $dtypes {
4293        if {[info exists portinfo($dtype)]} {
4294            foreach i $portinfo($dtype) {
4295                set d [$parentworker eval _get_dep_port $i]
4296                if {![llength [array get depscache port:$d]] && ![llength [array get depscache $i]]} {
4297                    if {$d ne ""} {
4298                        set dspec port:$d
4299                    } else {
4300                        set dspec $i
4301                        set d [lindex [split $i :] end]
4302                    }
4303                    set status [macports::_upgrade $d $dspec $variationslist [array get options] depscache]
4304                    if {$status != 0 && $status != 2 && ![ui_isset ports_processall]} break
4305                }
4306            }
4307        }
4308        if {$status != 0 && $status != 2 && ![ui_isset ports_processall]} break
4309    }
4310    # restore dependent-following to its former value
4311    if {$saved_do_dependents} {
4312        set options(ports_do_dependents) yes
4313    }
4314    return $status
4315}
4316
4317# mportselect
4318#   * command: The only valid commands are list, set, show and summary
4319#   * group: This argument should correspond to a directory under
4320#            ${macports::prefix}/etc/select.
4321#   * version: This argument is only used by the 'set' command.
4322# On error mportselect returns with the code 'error'.
4323proc mportselect {command {group ""} {version {}}} {
4324    ui_debug "mportselect \[$command] \[$group] \[$version]"
4325
4326    set conf_path ${macports::prefix}/etc/select/$group
4327    if {![file isdirectory $conf_path]} {
4328        return -code error "The specified group '$group' does not exist."
4329    }
4330
4331    switch -- $command {
4332        list {
4333            if {[catch {set versions [glob -directory $conf_path *]} result]} {
4334                global errorInfo
4335                ui_debug "${result}: $errorInfo"
4336                return -code error [concat "No configurations associated" \
4337                                           "with '$group' were found."]
4338            }
4339
4340            # Return the sorted list of versions (excluding base and current).
4341            set lversions {}
4342            foreach v $versions {
4343                # Only the file name corresponds to the version name.
4344                set v [file tail $v]
4345                if {$v eq "base" || $v eq "current"} {
4346                    continue
4347                }
4348                lappend lversions [file tail $v]
4349            }
4350            return [lsort $lversions]
4351        }
4352        summary {
4353            # Return the list of portgroups in ${macports::prefix}/etc/select
4354            if {[catch {set lportgroups [glob -directory $conf_path -tails *]} result]} {
4355                global errorInfo
4356                ui_debug "${result}: $errorInfo"
4357                return -code error [concat "No ports with the select" \
4358                                           "option were found."]
4359            }
4360            return [lsort $lportgroups]
4361        }
4362        set {
4363            # Use ${conf_path}/$version to read in sources.
4364            if {$version eq "" || $version eq "base" || $version eq "current"
4365                    || [catch {set src_file [open "${conf_path}/$version"]} result]} {
4366                global errorInfo
4367                ui_debug "${result}: $errorInfo"
4368                return -code error "The specified version '$version' is not valid."
4369            }
4370            set srcs [split [read -nonewline $src_file] \n]
4371            close $src_file
4372
4373            # Use ${conf_path}/base to read in targets.
4374            if {[catch {set tgt_file [open ${conf_path}/base]} result]} {
4375                global errorInfo
4376                ui_debug "${result}: $errorInfo"
4377                return -code error [concat "The configuration file" \
4378                                           "'${conf_path}/base' could not be" \
4379                                           "opened."]
4380            }
4381            set tgts [split [read -nonewline $tgt_file] \n]
4382            close $tgt_file
4383
4384            # Iterate through the configuration files executing the specified
4385            # actions.
4386            set i 0
4387            foreach tgt $tgts {
4388                set src [lindex $srcs $i]
4389
4390                switch -glob -- $src {
4391                    - {
4392                        # The source is unavailable for this file.
4393                        set tgt [file join $macports::prefix $tgt]
4394                        file delete $tgt
4395                        ui_debug "rm -f $tgt"
4396                    }
4397                    /* {
4398                        # The source is an absolute path.
4399                        set tgt [file join $macports::prefix $tgt]
4400                        file delete $tgt
4401                        file link -symbolic $tgt $src
4402                        ui_debug "ln -sf $src $tgt"
4403                    }
4404                    default {
4405                        # The source is a relative path.
4406                        set src [file join $macports::prefix $src]
4407                        set tgt [file join $macports::prefix $tgt]
4408                        file delete $tgt
4409                        file link -symbolic $tgt $src
4410                        ui_debug "ln -sf $src $tgt"
4411                    }
4412                }
4413                incr i
4414            }
4415
4416            # Update the selected version.
4417            set selected_version ${conf_path}/current
4418            if {[file exists $selected_version]} {
4419                file delete $selected_version
4420            }
4421            symlink $version $selected_version
4422            return
4423        }
4424        show {
4425            set selected_version ${conf_path}/current
4426
4427            if {[catch {file type $selected_version} err]} {
4428                # this might be okay if nothing was selected yet,
4429                # just log the error for debugging purposes
4430                ui_debug "cannot determine selected version for $group: $err"
4431                return none
4432            } else {
4433                return [file readlink $selected_version]
4434            }
4435        }
4436    }
4437    return
4438}
4439
4440# Return a good temporary directory to use; /tmp if TMPDIR is not set
4441# in the environment
4442proc macports::gettmpdir {args} {
4443    global env
4444
4445    if {[info exists env(TMPDIR)]} {
4446        return $env(TMPDIR)
4447    } else {
4448        return /tmp
4449    }
4450}
4451
4452# check if the system we're on can run code of the given architecture
4453proc macports::arch_runnable {arch} {
4454    global macports::os_major macports::os_arch macports::os_platform
4455    if {$macports::os_platform eq "darwin"} {
4456        if {$macports::os_major >= 11 && [string first ppc $arch] == 0} {
4457            return no
4458        } elseif {$macports::os_arch eq "i386" && $arch eq "ppc64"} {
4459            return no
4460        } elseif {$macports::os_major <= 8 && $arch eq "x86_64"} {
4461            return no
4462        }
4463    }
4464    return yes
4465}
4466
4467proc macports::diagnose_main {opts} {
4468   
4469    # Calls the main function for the 'port diagnose' command.
4470    #
4471    # Args:
4472    #           None
4473    # Returns:
4474    #           0 on successful execution.
4475
4476    diagnose::main $opts
4477    return 0
4478}
4479
4480proc macports::reclaim_main {} {
4481
4482    # Calls the main function for the 'port reclaim' command.
4483    #
4484    # Args:
4485    #           None
4486    # Returns:
4487    #           None
4488
4489    reclaim::main
4490    return 0
4491}
4492
4493##
4494# Execute the rev-upgrade scan and attempt to rebuild all ports found to be
4495# broken. Depends on the revupgrade_mode setting from macports.conf.
4496#
4497# @param opts
4498#        A Tcl array serialized into a list using array get containing options
4499#        for MacPorts. Options used exclusively by rev-upgrade are
4500#        ports_rev-upgrade_id-loadcmd-check, a boolean indicating whether the
4501#        ID load command of binaries should be check for sanity. This is mostly
4502#        useful for maintainers.
4503# @return 0 if report-only mode is enabled, no ports are broken, or the
4504#         rebuilds finished successfully. 1 if an exception occured during the
4505#         execution of rev-upgrade, 2 if the execution was aborted on user
4506#         request.
4507proc macports::revupgrade {opts} {
4508    set run_loop 1
4509    array set broken_port_counts {}
4510    try {
4511        while {$run_loop == 1} {
4512            set run_loop [revupgrade_scanandrebuild broken_port_counts $opts]
4513        }
4514        return 0
4515    } catch {{POSIX SIG SIGINT} eCode eMessage} {
4516        ui_debug "rev-upgrade failed: $::errorInfo"
4517        ui_error [msgcat::mc "rev-upgrade aborted: SIGINT received."]
4518        return 2
4519    } catch {{POSIX SIG SIGTERM} eCode eMessage} {
4520        ui_error [msgcat::mc "rev-upgrade aborted: SIGTERM received."]
4521        return 2
4522    } catch {{*} eCode eMessage} {
4523        ui_debug "rev-upgrade failed: $::errorInfo"
4524        ui_error [msgcat::mc "rev-upgrade failed: %s" $eMessage]
4525        return 1
4526    }
4527}
4528
4529##
4530# Helper function for rev-upgrade. Do not consider this to be part of public
4531# API. Use macports::revupgrade instead.
4532#
4533# @param broken_port_counts_name
4534#        The name of a Tcl array that's being used to store the number of times
4535#        a port has been rebuilt so far.
4536# @param opts
4537#        A serialized version of a Tcl array that contains options for
4538#        MacPorts. Options used by this method are
4539#        ports_rev-upgrade_id-loadcmd-check, a boolean indicating whether the
4540#        ID loadcommand of binaries should also be checked during rev-upgrade
4541#        and ports_dryrun, a boolean indicating whether no action should be
4542#        taken.
4543# @return 1 if ports were rebuilt and this function should be called again,
4544#         0 otherwise.
4545proc macports::revupgrade_scanandrebuild {broken_port_counts_name opts} {
4546    upvar $broken_port_counts_name broken_port_counts
4547    array set options $opts
4548
4549    set files [registry::file search active 1 binary -null]
4550    set files_count [llength $files]
4551    set fancy_output [expr {![macports::ui_isset ports_debug] && [info exists macports::ui_options(progress_generic)]}]
4552    if {$fancy_output} {
4553        set revupgrade_progress $macports::ui_options(progress_generic)
4554    }
4555    if {$files_count > 0} {
4556        registry::write {
4557            try {
4558                ui_msg "$macports::ui_prefix Updating database of binaries"
4559                set i 1
4560                if {$fancy_output} {
4561                    $revupgrade_progress start
4562                }
4563                foreach f $files {
4564                    if {$fancy_output} {
4565                        if {$files_count < 10000 || $i % 100 == 1} {
4566                            $revupgrade_progress update $i $files_count
4567                        }
4568                    }
4569                    set fpath [$f actual_path]
4570                    ui_debug "Updating binary flag for file $i of ${files_count}: $fpath"
4571                    incr i
4572
4573                    try {
4574                        $f binary [fileIsBinary $fpath]
4575                    } catch {{POSIX SIG SIGINT} eCode eMessage} {
4576                        if {$fancy_output} {
4577                            $revupgrade_progress intermission
4578                        }
4579                        ui_debug [msgcat::mc "Aborted: SIGINT signal received"]
4580                        throw
4581                    } catch {{POSIX SIG SIGTERM} eCode eMessage} {
4582                        if {$fancy_output} {
4583                            $revupgrade_progress intermission
4584                        }
4585                        ui_debug [msgcat::mc "Aborted: SIGTERM signal received"]
4586                        throw
4587                    } catch {{*} eCode eMessage} {
4588                        if {$fancy_output} {
4589                            $revupgrade_progress intermission
4590                        }
4591                        # handle errors (e.g. file not found, permission denied) gracefully
4592                        ui_warn "Error determining file type of `$fpath': $eMessage"
4593                        ui_warn "A file belonging to the `[[registry::entry owner $fpath] name]' port is missing or unreadable. Consider reinstalling it."
4594                    }
4595                }
4596            } catch {*} {
4597                if {${fancy_output}} {
4598                    $revupgrade_progress intermission
4599                }
4600                ui_error "Updating database of binaries failed"
4601                throw
4602            }
4603        }
4604        if {$fancy_output} {
4605            $revupgrade_progress finish
4606        }
4607    }
4608
4609    set broken_files {};
4610    set binaries [registry::file search active 1 binary 1]
4611    set binary_count [llength $binaries]
4612    if {$binary_count > 0} {
4613        ui_msg "$macports::ui_prefix Scanning binaries for linking errors"
4614        set handle [machista::create_handle]
4615        if {$handle eq "NULL"} {
4616            error "Error creating libmachista handle"
4617        }
4618        array unset files_warned_about
4619        array set files_warned_about [list]
4620
4621        if {$fancy_output} {
4622            $revupgrade_progress start
4623        }
4624
4625        try {
4626            set i 1
4627            foreach b $binaries {
4628                if {$fancy_output} {
4629                    if {$binary_count < 10000 || $i % 10 == 1} {
4630                        $revupgrade_progress update $i $binary_count
4631                    }
4632                }
4633                set bpath [$b actual_path]
4634                #ui_debug "${i}/${binary_count}: $bpath"
4635                incr i
4636
4637                set resultlist [machista::parse_file $handle $bpath]
4638                set returncode [lindex $resultlist 0]
4639                set result     [lindex $resultlist 1]
4640
4641                if {$returncode != $machista::SUCCESS} {
4642                    if {$returncode == $machista::EMAGIC} {
4643                        # not a Mach-O file
4644                        # ignore silently, these are only static libs anyway
4645                        #ui_debug "Error parsing file ${bpath}: [machista::strerror $returncode]"
4646                    } else {
4647                        if {$fancy_output} {
4648                            $revupgrade_progress intermission
4649                        }
4650                        ui_warn "Error parsing file ${bpath}: [machista::strerror $returncode]"
4651                    }
4652                    continue;
4653                }
4654
4655                set architecture [$result cget -mt_archs]
4656                while {$architecture ne "NULL"} {
4657                    if {[info exists options(ports_rev-upgrade_id-loadcmd-check)] && $options(ports_rev-upgrade_id-loadcmd-check)} {
4658                        if {[$architecture cget -mat_install_name] ne "NULL" && [$architecture cget -mat_install_name] ne ""} {
4659                            # check if this lib's install name actually refers to this file itself
4660                            # if this is not the case software linking against this library might have erroneous load commands
4661
4662                            try {
4663                                set idloadcmdpath [revupgrade_handle_special_paths $bpath [$architecture cget -mat_install_name]]
4664                                if {[string index $idloadcmdpath 0] ne "/"} {
4665                                    set port [registry::entry owner $bpath]
4666                                    if {$port ne ""} {
4667                                        set portname [$port name]
4668                                    } else {
4669                                        set portname <unknown-port>
4670                                    }
4671                                    if {$fancy_output} {
4672                                        $revupgrade_progress intermission
4673                                    }
4674                                    ui_warn "ID load command in ${bpath}, arch [machista::get_arch_name [$architecture cget -mat_arch]] (belonging to port $portname) contains relative path"
4675                                } elseif {![file exists $idloadcmdpath]} {
4676                                    set port [registry::entry owner $bpath]
4677                                    if {$port ne ""} {
4678                                        set portname [$port name]
4679                                    } else {
4680                                        set portname <unknown-port>
4681                                    }
4682                                    if {$fancy_output} {
4683                                        $revupgrade_progress intermission
4684                                    }
4685                                    ui_warn "ID load command in ${bpath}, arch [machista::get_arch_name [$architecture cget -mat_arch]] refers to non-existent file $idloadcmdpath"
4686                                    ui_warn "This is probably a bug in the $portname port and might cause problems in libraries linking against this file"
4687                                } else {
4688                                    set hash_this [sha256 file $bpath]
4689                                    set hash_idloadcmd [sha256 file $idloadcmdpath]
4690
4691                                    if {$hash_this ne $hash_idloadcmd} {
4692                                        set port [registry::entry owner $bpath]
4693                                        if {$port ne ""} {
4694                                            set portname [$port name]
4695                                        } else {
4696                                            set portname <unknown-port>
4697                                        }
4698                                        if {$fancy_output} {
4699                                            $revupgrade_progress intermission
4700                                        }
4701                                        ui_warn "ID load command in ${bpath}, arch [machista::get_arch_name [$architecture cget -mat_arch]] refers to file ${idloadcmdpath}, which is a different file"
4702                                        ui_warn "This is probably a bug in the $portname port and might cause problems in libraries linking against this file"
4703                                    }
4704                                }
4705                            } catch {{POSIX SIG SIGINT} eCode eMessage} {
4706                                if {$fancy_output} {
4707                                    $revupgrade_progress intermission
4708                                }
4709                                ui_debug [msgcat::mc "Aborted: SIGINT signal received"]
4710                                throw
4711                            } catch {{POSIX SIG SIGTERM} eCode eMessage} {
4712                                if {$fancy_output} {
4713                                    $revupgrade_progress intermission
4714                                }
4715                                ui_debug [msgcat::mc "Aborted: SIGTERM signal received"]
4716                                throw
4717                            } catch {*} {}
4718                        }
4719                    }
4720
4721                    set archname [machista::get_arch_name [$architecture cget -mat_arch]]
4722                    if {![arch_runnable $archname]} {
4723                        ui_debug "skipping $archname in $bpath since this system can't run it anyway"
4724                        set architecture [$architecture cget -next]
4725                        continue
4726                    }
4727
4728                    set loadcommand [$architecture cget -mat_loadcmds]
4729
4730                    while {$loadcommand ne "NULL"} {
4731                        try {
4732                            set filepath [revupgrade_handle_special_paths $bpath [$loadcommand cget -mlt_install_name]]
4733                        } catch {{POSIX SIG SIGINT} eCode eMessage} {
4734                            if {$fancy_output} {
4735                                $revupgrade_progress intermission
4736                            }
4737                            ui_debug [msgcat::mc "Aborted: SIGINT signal received"]
4738                            throw
4739                        } catch {{POSIX SIG SIGTERM} eCode eMessage} {
4740                            if {$fancy_output} {
4741                                $revupgrade_progress intermission
4742                            }
4743                            ui_debug [msgcat::mc "Aborted: SIGTERM signal received"]
4744                            throw
4745                        } catch {*} {
4746                            set loadcommand [$loadcommand cget -next]
4747                            continue;
4748                        }
4749
4750                        set libresultlist [machista::parse_file $handle $filepath]
4751                        set libreturncode [lindex $libresultlist 0]
4752                        set libresult     [lindex $libresultlist 1]
4753
4754                        if {$libreturncode != $machista::SUCCESS} {
4755                            if {![info exists files_warned_about($filepath)]} {
4756                                if {$fancy_output} {
4757                                    $revupgrade_progress intermission
4758                                }
4759                                ui_info "Could not open ${filepath}: [machista::strerror $libreturncode] (referenced from $bpath)"
4760                                if {[string first [file separator] $filepath] == -1} {
4761                                    ui_info "${filepath} seems to be referenced using a relative path. This may be a problem with its canonical library name and require the use of install_name_tool(1) to fix."
4762                                }
4763                                set files_warned_about($filepath) yes
4764                            }
4765                            if {$libreturncode == $machista::EFILE} {
4766                                ui_debug "Marking $bpath as broken"
4767                                lappend broken_files $bpath
4768                            }
4769                            set loadcommand [$loadcommand cget -next]
4770                            continue;
4771                        }
4772
4773                        set libarchitecture [$libresult cget -mt_archs]
4774                        set libarch_found false;
4775                        while {$libarchitecture ne "NULL"} {
4776                            if {[$architecture cget -mat_arch] ne [$libarchitecture cget -mat_arch]} {
4777                                set libarchitecture [$libarchitecture cget -next]
4778                                continue;
4779                            }
4780
4781                            if {[$loadcommand cget -mlt_version] ne [$libarchitecture cget -mat_version] && [$loadcommand cget -mlt_comp_version] > [$libarchitecture cget -mat_comp_version]} {
4782                                if {$fancy_output} {
4783                                    $revupgrade_progress intermission
4784                                }
4785                                ui_info "Incompatible library version: $bpath requires version [machista::format_dylib_version [$loadcommand cget -mlt_comp_version]] or later, but $filepath provides version [machista::format_dylib_version [$libarchitecture cget -mat_comp_version]]"
4786                                ui_debug "Marking $bpath as broken"
4787                                lappend broken_files $bpath
4788                            }
4789
4790                            set libarch_found true;
4791                            break;
4792                        }
4793
4794                        if {!$libarch_found} {
4795                            ui_debug "Missing architecture [machista::get_arch_name [$architecture cget -mat_arch]] in file $filepath"
4796                            if {[path_is_in_prefix $filepath]} {
4797                                ui_debug "Marking $bpath as broken"
4798                                lappend broken_files $bpath
4799                            } else {
4800                                ui_debug "Missing architecture [machista::get_arch_name [$architecture cget -mat_arch]] in file outside prefix referenced from $bpath"
4801                                # ui_debug "   How did you get that compiled anyway?"
4802                            }
4803                        }
4804                        set loadcommand [$loadcommand cget -next]
4805                    }
4806
4807                    set architecture [$architecture cget -next]
4808                }
4809            }
4810        } catch {*} {
4811            if {$fancy_output} {
4812                $revupgrade_progress intermission
4813            }
4814            throw
4815        }
4816        if {$fancy_output} {
4817            $revupgrade_progress finish
4818        }
4819
4820        machista::destroy_handle $handle
4821
4822        set num_broken_files [llength $broken_files]
4823        set s [expr {$num_broken_files == 1 ? "" : "s"}]
4824
4825        if {$num_broken_files == 0} {
4826            ui_msg "$macports::ui_prefix No broken files found."
4827            return 0
4828        }
4829        ui_msg "$macports::ui_prefix Found $num_broken_files broken file${s}, matching files to ports"
4830        set broken_ports {}
4831        set broken_files [lsort -unique $broken_files]
4832        foreach file $broken_files {
4833            set port [registry::entry owner $file]
4834            if {$port ne ""} {
4835                lappend broken_ports $port
4836                lappend broken_files_by_port($port) $file
4837            } else {
4838                ui_error "Broken file $file doesn't belong to any port."
4839            }
4840        }
4841        set broken_ports [lsort -unique $broken_ports]
4842
4843        if {$macports::revupgrade_mode eq "rebuild"} {
4844            # don't try to rebuild ports that don't exist in the tree
4845            set temp_broken_ports {}
4846            foreach port $broken_ports {
4847                set portname [$port name]
4848                if {[catch {mportlookup $portname} result]} {
4849                    ui_debug $::errorInfo
4850                    error "lookup of portname $portname failed: $result"
4851                }
4852                if {[llength $result] >= 2} {
4853                    lappend temp_broken_ports $port
4854                } else {
4855                    ui_warn "No port $portname found in the index; can't rebuild"
4856                }
4857            }
4858
4859            if {[llength $temp_broken_ports] == 0} {
4860                ui_msg "$macports::ui_prefix Broken files found, but all associated ports are not in the index and so cannot be rebuilt."
4861                return 0
4862            }
4863        } else {
4864            set temp_broken_ports $broken_ports
4865        }
4866
4867        set broken_ports {}
4868
4869        foreach port $temp_broken_ports {
4870            set portname [$port name]
4871
4872            if {![info exists broken_port_counts($portname)]} {
4873                set broken_port_counts($portname) 0
4874            }
4875            incr broken_port_counts($portname)
4876            if {$broken_port_counts($portname) > 3} {
4877                ui_error "Port $portname is still broken after rebuilding it more than 3 times."
4878                if {$fancy_output} {
4879                    ui_error "Please run port -d -y rev-upgrade and use the output to report a bug."
4880                }
4881                set rebuild_tries [expr {$broken_port_counts($portname) - 1}]
4882                set s [expr {$rebuild_tries == 1 ? "" : "s"}]
4883                error "Port $portname still broken after rebuilding $rebuild_tries time${s}"
4884            } elseif {$broken_port_counts($portname) > 1 && [global_option_isset ports_binary_only]} {
4885                error "Port $portname still broken after reinstalling -- can't rebuild due to binary-only mode"
4886            }
4887            lappend broken_ports $port
4888        }
4889        unset temp_broken_ports
4890
4891        set num_broken_ports [llength $broken_ports]
4892        set s [expr {$num_broken_ports == 1 ? "" : "s"}]
4893
4894        if {$macports::revupgrade_mode ne "rebuild"} {
4895            ui_msg "$macports::ui_prefix Found $num_broken_ports broken port${s}:"
4896            foreach port $broken_ports {
4897                ui_msg "     [$port name] @[$port version] [$port variants][$port negated_variants]"
4898                foreach f $broken_files_by_port($port) {
4899                    ui_msg "         $f"
4900                }
4901            }
4902            return 0
4903        }
4904
4905        ui_msg "$macports::ui_prefix Found $num_broken_ports broken port${s}, determining rebuild order"
4906        # broken_ports are the nodes in our graph
4907        # now we need adjacents
4908        foreach port $broken_ports {
4909            # initialize with empty list
4910            set adjlist($port) {}
4911            set revadjlist($port) {}
4912            ui_debug "Broken: [$port name]"
4913        }
4914
4915        array set visited {}
4916        foreach port $broken_ports {
4917            # stack of broken nodes we've come across
4918            set stack {}
4919            lappend stack $port
4920
4921            # build graph
4922            if {![info exists visited($port)]} {
4923                revupgrade_buildgraph $port stack adjlist revadjlist visited
4924            }
4925        }
4926
4927        set unsorted_ports $broken_ports
4928        set topsort_ports {}
4929        while {[llength $unsorted_ports] > 0} {
4930            set lowest_adj_number [llength $adjlist([lindex $unsorted_ports 0])]
4931            set lowest_adj_port [lindex $unsorted_ports 0]
4932
4933            foreach port $unsorted_ports {
4934                set len [llength $adjlist($port)]
4935                if {$len < $lowest_adj_number} {
4936                    set lowest_adj_port $port
4937                    set lowest_adj_number $len
4938                }
4939                if {$len == 0} {
4940                    # this node has no further dependencies
4941                    # add it to topsorted list
4942                    lappend topsort_ports $port
4943                    # remove from unsorted list
4944                    set index [lsearch -exact $unsorted_ports $port]
4945                    set unsorted_ports [lreplace $unsorted_ports $index $index]
4946
4947                    # remove edges
4948                    foreach target $revadjlist($port) {
4949                        set index [lsearch -exact $adjlist($target) $port]
4950                        set adjlist($target) [lreplace $adjlist($target) $index $index]
4951                    }
4952
4953                    break;
4954                }
4955            }
4956
4957            # if we arrive here and lowest_adj_number is larger than 0, then we
4958            # have a loop in the graph and need to break it somehow
4959            if {$lowest_adj_number > 0} {
4960                ui_debug "Breaking loop in dependency graph by starting with [$lowest_adj_port name], which has $lowest_adj_number dependencies"
4961                lappend topsort_ports $lowest_adj_port
4962
4963                set index [lsearch -exact $unsorted_ports $lowest_adj_port]
4964                set unsorted_ports [lreplace $unsorted_ports $index $index]
4965
4966                foreach target $revadjlist($port) {
4967                    set index [lsearch -exact $adjlist($target) $lowest_adj_port]
4968                    set adjlist($target) [lreplace $adjlist($target) $index $index]
4969                }
4970            }
4971        }
4972
4973        set broken_portnames {}
4974        if {![info exists macports::ui_options(questions_yesno)]} {
4975            ui_msg "$macports::ui_prefix Rebuilding in order"
4976        }
4977        foreach port $topsort_ports {
4978            lappend broken_portnames [$port name]@[$port version][$port variants]
4979            if {![info exists macports::ui_options(questions_yesno)]} {
4980                ui_msg "     [$port name] @[$port version] [$port variants][$port negated_variants]"
4981            }
4982        }
4983
4984        ##
4985        # User Interaction Question
4986        # Asking before rebuilding in rev-upgrade
4987        if {[info exists macports::ui_options(questions_yesno)]} {
4988            ui_msg "You can always run 'port rev-upgrade' again to fix errors."
4989            set retvalue [$macports::ui_options(questions_yesno) "The following ports will be rebuilt:" "TestCase#1" $broken_portnames {y} 0]
4990            if {$retvalue == 1} {
4991                # quit as user answered 'no'
4992                return 0
4993            }
4994            unset macports::ui_options(questions_yesno)
4995        }
4996
4997        # shared depscache for all ports that are going to be rebuilt
4998        array set depscache {}
4999        set status 0
5000        array set my_options [array get macports::global_options]
5001        set my_options(ports_revupgrade) yes
5002        foreach port $topsort_ports {
5003            set portname [$port name]
5004            if {![info exists depscache(port:$portname)]} {
5005                unset -nocomplain my_options(ports_revupgrade_second_run) \
5006                                  my_options(ports_nodeps)
5007                if {$broken_port_counts($portname) > 1} {
5008                    set my_options(ports_revupgrade_second_run) yes
5009
5010                    if {$broken_port_counts($portname) > 2} {
5011                        # runtime deps are upgraded the first time, build deps
5012                        # the second, so none left to do the third time
5013                        set my_options(ports_nodeps) yes
5014                    }
5015                }
5016
5017                # call macports::upgrade with ports_revupgrade option to rebuild the port
5018                set status [macports::upgrade $portname port:$portname \
5019                    {} [array get my_options] depscache]
5020                ui_debug "Rebuilding port $portname finished with status $status"
5021                if {$status != 0} {
5022                    error "Error rebuilding $portname"
5023                }
5024            }
5025        }
5026
5027        if {[info exists options(ports_dryrun)] && $options(ports_dryrun)} {
5028            ui_warn "If this was no dry run, rev-upgrade would now run the checks again to find unresolved and newly created problems"
5029            return 0
5030        }
5031        return 1
5032    }
5033
5034    return 0
5035}
5036
5037# Return whether a path is in the macports prefix
5038# Usage: path_is_in_prefix path_to_test
5039# Returns true if the path is in the prefix, false otherwise
5040proc macports::path_is_in_prefix {path} {
5041    global macports::prefix macports::applications_dir
5042    if {[string first $macports::prefix $path] == 0} {
5043        return yes
5044    }
5045    if {[string first $macports::applications_dir $path] == 0} {
5046        return yes
5047    }
5048    return no
5049}
5050
5051# Function to replace macros in loadcommand paths with their proper values (which are usually determined at load time)
5052# Usage: revupgrade_handle_special_paths name_of_file path_from_loadcommand
5053# Returns the corrected path on success or an error in case of failure.
5054# Note that we can't reliably replace @executable_path, because it's only clear when executing a file where it was executed from.
5055# Replacing @rpath does not work yet, but it might be possible to get it working using the rpath attribute in the file containing the
5056# loadcommand
5057proc macports::revupgrade_handle_special_paths {fname path} {
5058    set corrected_path $path
5059
5060    set loaderpath_idx [string first @loader_path $corrected_path]
5061    if {$loaderpath_idx != -1} {
5062        set corrected_path [string replace $corrected_path $loaderpath_idx ${loaderpath_idx}+11 [file dirname $fname]]
5063    }
5064
5065    set executablepath_idx [string first @executable_path $corrected_path]
5066    if {$executablepath_idx != -1} {
5067        ui_debug "Ignoring loadcommand containing @executable_path in $fname"
5068        error "@executable_path in loadcommand"
5069    }
5070
5071    set rpath_idx [string first @rpath $corrected_path]
5072    if {$rpath_idx != -1} {
5073        ui_debug "Ignoring loadcommand containing @rpath in $fname"
5074        error "@rpath in loadcommand"
5075    }
5076
5077    return $corrected_path
5078}
5079
5080# Recursively build the dependency graph between broken ports
5081# Usage: revupgrade_buildgraph start_port name_of_stack name_of_adjacency_list name_of_reverse_adjacency_list name_of_visited_map
5082proc macports::revupgrade_buildgraph {port stackname adjlistname revadjlistname visitedname} {
5083    upvar $stackname stack
5084    upvar $adjlistname adjlist
5085    upvar $revadjlistname revadjlist
5086    upvar $visitedname visited
5087
5088    set visited($port) true
5089
5090    ui_debug "Processing port [$port name] @[$port epoch]:[$port version]_[$port revision] [$port variants] [$port negated_variants]"
5091    set dependent_ports [$port dependents]
5092    foreach dep $dependent_ports {
5093        set is_broken_port false
5094
5095        if {[info exists adjlist($dep)]} {
5096            ui_debug "Dependent [$dep name] is broken, adding edge from [$dep name] to [[lindex $stack 0] name]"
5097            ui_debug "Making [$dep name] new head of stack"
5098            # $dep is one of the broken ports
5099            # add an edge to the last broken port in the DFS
5100            lappend revadjlist([lindex $stack 0]) $dep
5101            lappend adjlist($dep) [lindex $stack 0]
5102            # make this port the new last broken port by prepending it to the stack
5103            set stack [linsert $stack 0 $dep]
5104
5105            set is_broken_port true
5106        }
5107        if {![info exists visited($dep)]} {
5108            revupgrade_buildgraph $dep stack adjlist revadjlist visited
5109        }
5110        if {$is_broken_port} {
5111            ui_debug "Removing [$dep name] from stack"
5112            # remove $dep from the stack
5113            set stack [lrange $stack 1 end]
5114        }
5115    }
5116}
5117
5118# get cached ping time for host, modified by blacklist and preferred list
5119proc macports::get_pingtime {host} {
5120    global macports::ping_cache macports::host_blacklisted macports::host_preferred
5121    if {[info exists host_blacklisted($host)]} {
5122        return -1
5123    } elseif {[info exists host_preferred($host)]} {
5124        return 1
5125    } elseif {[info exists ping_cache($host)]} {
5126        # expire entries after 1 day
5127        if {[clock seconds] - [lindex $ping_cache($host) 1] <= 86400} {
5128            return [lindex $ping_cache($host) 0]
5129        }
5130    }
5131    return {}
5132}
5133
5134# cache a ping time of ms for host
5135proc macports::set_pingtime {host ms} {
5136    global macports::ping_cache
5137    set ping_cache($host) [list $ms [clock seconds]]
5138}
5139
5140# read and cache archive_sites.conf (called from port1.0 code)
5141proc macports::get_archive_sites_conf_values {} {
5142    global macports::archive_sites_conf_values macports::autoconf::macports_conf_path
5143    if {![info exists archive_sites_conf_values]} {
5144        set archive_sites_conf_values {}
5145        set all_names {}
5146        array set defaults {applications_dir /Applications/MacPorts prefix /opt/local type tbz2}
5147        set conf_file ${macports_conf_path}/archive_sites.conf
5148        set conf_options {applications_dir frameworks_dir name prefix type urls}
5149        if {[file isfile $conf_file]} {
5150            set fd [open $conf_file r]
5151            while {[gets $fd line] >= 0} {
5152                if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
5153                    if {$option in $conf_options} {
5154                        if {$option eq "name"} {
5155                            set cur_name $val
5156                            lappend all_names $val
5157                        } elseif {[info exists cur_name]} {
5158                            set trimmedval [string trim $val]
5159                            if {$option eq "urls"} {
5160                                set processed_urls {}
5161                                foreach url $trimmedval {
5162                                    lappend processed_urls ${url}:nosubdir
5163                                }
5164                                lappend archive_sites_conf_values portfetch::mirror_sites::sites($cur_name) $processed_urls
5165                                set sites($cur_name) $processed_urls
5166                            } else {
5167                                lappend archive_sites_conf_values portfetch::mirror_sites::archive_${option}($cur_name) $trimmedval
5168                                set archive_${option}($cur_name) $trimmedval
5169                            }
5170                        } else {
5171                            ui_warn "archive_sites.conf: ignoring '$option' occurring before name"
5172                        }
5173                    } else {
5174                        ui_warn "archive_sites.conf: ignoring unknown key '$option'"
5175                    }
5176                }
5177            }
5178            close $fd
5179
5180            # check for unspecified values and set to defaults
5181            foreach cur_name $all_names {
5182                foreach key [array names defaults] {
5183                    if {![info exists archive_${key}($cur_name)]} {
5184                        set archive_${key}($cur_name) $defaults($key)
5185                        lappend archive_sites_conf_values portfetch::mirror_sites::archive_${key}($cur_name) $defaults($key)
5186                    }
5187                }
5188                if {![info exists archive_frameworks_dir($cur_name)]} {
5189                    set archive_frameworks_dir($cur_name) $archive_prefix($cur_name)/Library/Frameworks
5190                    lappend archive_sites_conf_values portfetch::mirror_sites::archive_frameworks_dir($cur_name) $archive_frameworks_dir($cur_name)
5191                }
5192                if {![info exists sites($cur_name)]} {
5193                    ui_warn "archive_sites.conf: no urls set for $cur_name"
5194                    set sites($cur_name) {}
5195                    lappend archive_sites_conf_values portfetch::mirror_sites::sites($cur_name) {}
5196                }
5197            }
5198        }
5199    }
5200    return $archive_sites_conf_values
5201}
5202
5203##
5204# Escape a string for use in a POSIX shell, e.g., when passing it to the \c system Pextlib extension. This is necessary
5205# to handle cases such as group names with backslashes correctly. See #43875 for an example of a problem caused by
5206# missing quotes.
5207#
5208# @param arg The argument that should be escaped for use in a POSIX shell
5209# @return A quoted version of the argument
5210proc macports::shellescape {arg} {
5211    set mapping {}
5212    # Replace each backslash by a double backslash. Apparently Bash treats Backslashes in single-quoted strings
5213    # differently depending on whether is was invoked as sh or bash: echo 'using \backslashes' preserves the backslash
5214    # in bash mode, but interprets it in sh mode. Since the `system' command uses sh, escape backslashes.
5215    lappend mapping "\\" "\\\\"
5216    # Replace each single quote with a single quote (closing the currently open string), an escaped single quote \'
5217    # (additional backslash needed to escape the backslash in Tcl), and another single quote (opening a new quoted
5218    # string).
5219    lappend mapping "'" "'\\''"
5220
5221    # Add a single quote at the start, escape all single quotes in the argument, and add a single quote at the end
5222    return "'[string map $mapping $arg]'"
5223}
Note: See TracBrowser for help on using the repository browser.