source: tags/release_1_6_0/base/src/macports1.0/macports.tcl

Last change on this file was 31945, checked in by jmpp@…, 11 years ago

Merged revisions 31414,31416-31426,31428,31430-31441,31443-31454,31456-31482,31484-31485,31488-31490,31493-31494,31497-31499,31501-31518,31523-31561,31563-31564,31566-31599,31601-31617,31619-31639,31643-31668,31670,31672-31678,31682-31770,31772-31775,31777-31793,31795-31906,31909-31944 via svnmerge from
http://svn.macports.org/repository/macports/trunk/base

........

r31786 | mww@… | 2007-12-07 08:13:53 -0400 (Fri, 07 Dec 2007) | 2 lines


remove LD_PREBIND, LD_PREBIND_ALLOW_OVERLAP: prebinding is useless for 10.4+ and even is futile for some builds on 10.5 (e.g. postgresql8x) -- #13436

........

r31804 | wsiegrist@… | 2007-12-07 23:14:52 -0400 (Fri, 07 Dec 2007) | 1 line


added explicit paths to rm and tclsh in order to run without a PATH. PortIndex2MySQL.tcl now relies on tclsh being in /opt/local/bin

........

r31805 | jmpp@… | 2007-12-08 00:25:07 -0400 (Sat, 08 Dec 2007) | 1 line


Massive whitespace cleanups to the portutil.tcl file, add modeline.

........

r31807 | jmpp@… | 2007-12-08 02:13:59 -0400 (Sat, 08 Dec 2007) | 1 line


Whitespace cleanup to portbuilt.tcl, add modeline.

........

r31821 | wsiegrist@… | 2007-12-08 21:13:22 -0400 (Sat, 08 Dec 2007) | 1 line


added pathed variables for mkdir, echo, and ln to complete the removal of any PATH assumptions.

........

r31823 | jmpp@… | 2007-12-08 22:12:14 -0400 (Sat, 08 Dec 2007) | 8 lines



Don't provide a path for echo, so that we can use the built in.


Next improvement to this script should be proper error detection and reporting,
in case any of the svn or rsync or other commands fail, which we wouldn't catch
now if they do until the repos become horribly stale. New item for my TODO list!

........

r31891 | mww@… | 2007-12-11 05:55:17 -0400 (Tue, 11 Dec 2007) | 2 lines


add option 'gcc-4.2' for configure.compiler

........

r31925 | jmpp@… | 2007-12-12 02:40:20 -0400 (Wed, 12 Dec 2007) | 1 line


Improve some feedback messages for the sync & selfupdate actions.

........

r31941 | jmpp@… | 2007-12-12 11:45:32 -0400 (Wed, 12 Dec 2007) | 6 lines



Include the quotes to guard against possible embedded whitespace in the $HOME variable fix for the dp2mp-move
upgrade code into the pkg's preflight script, meant to take care of such upgrade on behalf of the binary installer.
Refs #13145.

........

r31943 | jmpp@… | 2007-12-12 12:30:18 -0400 (Wed, 12 Dec 2007) | 1 line


Whitespace fix.

........

r31944 | jmpp@… | 2007-12-12 12:37:42 -0400 (Wed, 12 Dec 2007) | 1 line


Bring our warnings about outdated Mac OS X & Xcode Tools releases up to date.

........

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