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

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

upgrade: simplify check for whether we have to uninstall an installed version

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