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

Last change on this file since 47034 was 47034, checked in by blb@…, 9 years ago

macports1.0/macports.tcl - trim whitespace from option values when setting
so errant whitespace at the end of the line doesn't muck things up;
ticket #18460

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