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

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

macports1.0: macportselect:

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