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

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

Merged revisions 34469,34852,34854-34855,34900,36952-36956,37507-37508,37511-37512,41040,41042-41046,41138-41139,41142-41143,41145,41151,41403,41458,41462-41463,42575,42626,42640-42641,42659 via svnmerge from
https://svn.macosforge.org/repository/macports/branches/variant-descs-14482/base

........

r34469 | raimue@… | 2008-02-26 07:08:09 +0100 (Tue, 26 Feb 2008) | 3 lines


port/port.tcl:
Reading from .config/variant_descriptions actually works

........

r34852 | raimue@… | 2008-03-09 02:45:22 +0100 (Sun, 09 Mar 2008) | 4 lines


macports1.0/macports.tcl:
New API: macports::getsourceconfigdir
Returns the path to .config for a porturl.

........

r34854 | raimue@… | 2008-03-09 03:11:27 +0100 (Sun, 09 Mar 2008) | 3 lines


port/port.tcl:
Use new API macports::getsourceconfigdir

........

r34855 | raimue@… | 2008-03-09 03:12:54 +0100 (Sun, 09 Mar 2008) | 3 lines


port/port.tcl:
Treat variant descriptions as strings to avoid problems with braces

........

r34900 | raimue@… | 2008-03-10 16:54:25 +0100 (Mon, 10 Mar 2008) | 3 lines


port/port.tcl:
Rename variable

........

r36952 | raimue@… | 2008-05-21 04:20:27 +0200 (Wed, 21 May 2008) | 3 lines


port/port.tcl:
Remove get_variant_desc, this will now be done in port1.0/portutil.tcl instead

........

r36953 | raimue@… | 2008-05-21 04:22:04 +0200 (Wed, 21 May 2008) | 3 lines


macports1.0/macports.tcl:
Give the worker access to variable porturl and proc getsourceconfigdir

........

r36954 | raimue@… | 2008-05-21 04:23:37 +0200 (Wed, 21 May 2008) | 3 lines


port1.0/tests:
Fix the portutil test after r36953

........

r36955 | raimue@… | 2008-05-21 05:01:11 +0200 (Wed, 21 May 2008) | 3 lines


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

........

r36956 | raimue@… | 2008-05-21 05:02:23 +0200 (Wed, 21 May 2008) | 3 lines


port1.0/portutil.tcl:
New proc variant_desc, reads global variant description file

........

r37507 | raimue@… | 2008-06-10 16:04:54 +0200 (Tue, 10 Jun 2008) | 4 lines


port1.0/portutil.tcl:
Don't warn about a missing description if it is set global,
but warn if the variant overrides the global description

........

r37508 | raimue@… | 2008-06-10 16:14:03 +0200 (Tue, 10 Jun 2008) | 3 lines


macports1.0/macports.tcl:
Use .resources instead of .config as it is a bit clearer, see #14553

........

r37511 | raimue@… | 2008-06-10 17:22:12 +0200 (Tue, 10 Jun 2008) | 5 lines


port1.0/portutil.tcl:
Switch back to this format:
name {description}
So this could be easily extended if ever needed.

........

r37512 | raimue@… | 2008-06-10 17:27:48 +0200 (Tue, 10 Jun 2008) | 3 lines


port1.0/portutil.tcl:
Add a warning if global variant description file could not be opened

........

r41040 | raimue@… | 2008-10-21 13:06:39 +0200 (Tue, 21 Oct 2008) | 4 lines


macports/macport.tcl:

  • New flag "default" for sources to indicate fallback for resources (group)
  • Add parameter to getsourceconfigdir to get path for a requested file

........

r41042 | raimue@… | 2008-10-21 13:11:44 +0200 (Tue, 21 Oct 2008) | 3 lines


macports1.0/macports.tcl:
Rename getsourceconfigdir to getportresourcepath

........

r41043 | raimue@… | 2008-10-21 13:15:16 +0200 (Tue, 21 Oct 2008) | 3 lines


port1.0/portutil.tcl:
Use getportresourcepath for the group files

........

r41044 | raimue@… | 2008-10-21 13:19:47 +0200 (Tue, 21 Oct 2008) | 3 lines


port1.0/portlint.tcl:
Use getresourcepath for group files

........

r41045 | raimue@… | 2008-10-21 13:20:36 +0200 (Tue, 21 Oct 2008) | 3 lines


port1.0/portmain.tcl:
Add a note that we should get rid of $portresourcepath in favor of [getportresourcepath]

........

r41046 | raimue@… | 2008-10-21 13:40:29 +0200 (Tue, 21 Oct 2008) | 3 lines


port1.0/portutil.tcl:
Missed one instance of getsourceconfigdir

........

r41138 | raimue@… | 2008-10-25 20:52:50 +0200 (Sat, 25 Oct 2008) | 3 lines


port1.0/portutil.tcl:
Use getportresourcepath for global variant descriptions

........

r41139 | raimue@… | 2008-10-25 21:23:15 +0200 (Sat, 25 Oct 2008) | 3 lines


port1.0/portmain.tcl:
Correct XXX tag

........

r41142 | raimue@… | 2008-10-25 23:11:30 +0200 (Sat, 25 Oct 2008) | 3 lines


port1.0/portfetch.tcl:
Use getportresourcepath

........

r41143 | raimue@… | 2008-10-25 23:12:04 +0200 (Sat, 25 Oct 2008) | 3 lines


port1.0/portdestroot.tcl:
Use getportresourcepath

........

r41145 | raimue@… | 2008-10-26 00:04:15 +0200 (Sun, 26 Oct 2008) | 3 lines


macports1.0/macports.tcl:
Fix a problem with URLs not using the file protocol

........

r41151 | raimue@… | 2008-10-26 03:09:54 +0100 (Sun, 26 Oct 2008) | 3 lines


macports1.0/macports.tcl:
Fix issues introduced in r41145, the file exists check was wrong

........

r41403 | raimue@… | 2008-11-01 22:59:21 +0100 (Sat, 01 Nov 2008) | 3 lines


port1.0/portutil.tcl:
Add a debug output which group files are used

........

r41458 | blb@… | 2008-11-03 22:58:28 +0100 (Mon, 03 Nov 2008) | 2 lines


Add [default] tag and description to sources.conf

........

r41462 | blb@… | 2008-11-04 02:12:28 +0100 (Tue, 04 Nov 2008) | 2 lines


No longer need to install resources with base

........

r41463 | blb@… | 2008-11-04 02:14:49 +0100 (Tue, 04 Nov 2008) | 4 lines


Move the install/ subdir (containing the mtree files) into .../share/macports
from the resources dir (the mtree contains a bit of install-time info, so it
shouldn't be with the resources stuff in the port tree)

........

r42575 | blb@… | 2008-11-25 01:53:05 +0100 (Tue, 25 Nov 2008) | 3 lines


Add script to handle upgrades through configure/make/make install and
the package, so [default] is added as appropriate to sources.conf

........

r42626 | raimue@… | 2008-11-27 02:21:15 +0100 (Thu, 27 Nov 2008) | 3 lines


package1.0/portpkg.tcl, package1.0/portmpkg.tcl:
Remove portresourcepath and use [getportresourcepath] instead

........

r42640 | raimue@… | 2008-11-27 11:49:32 +0100 (Thu, 27 Nov 2008) | 3 lines


package1.0/portrpm.tcl, package1.0/portsrpm.tcl:
Remove reference to portresurcepath which is not used at all

........

r42641 | raimue@… | 2008-11-27 11:52:12 +0100 (Thu, 27 Nov 2008) | 3 lines


port1.0/portmain.tcl:
Remove definition of portresourcepath as it is not used any more

........

r42659 | raimue@… | 2008-11-28 16:44:30 +0100 (Fri, 28 Nov 2008) | 3 lines


macports1.0/macports.tcl:
Rename portresourcepath from .resources to _resources

........

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