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

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

Revert part of r43375, as my understanding of the floating point to x.y.z transition was indeed a bit flawed.
@MP_VERSION@ and base/config/mp_version being in the old floating point format, and @MACPORTS_VERSION@ and
base/config/macports_version being their x.y.z counterparts, the correct analysis goes as follows:

  1. 1.700 and previous clients need to read the floating point version number in newer releases, as otherwise they'll be comparing, e.g., 1.700 vs. 1.8.0, which will fail to trigger any upgrade. Therefore, revive the base/config/mp_version file for it to exist in svn && rsync, which is all that's needed to get selfupdate working for old clients again (given that they prefer that file over config/base/macports_version).
  1. Remove the special-case hack in macports::selfupdate, since base/config/mp_version @ 1.800 is enough to upgrade all 1.700 and previous clients to 1.8.x, while those in turn have no need for the hack at all (they'll only read base/config/macports_version while selfupdating and thus rpm-vercomp its contents successfully against their internal version number, i.e. @MACPORTS_VERSION@).
  1. Proposal: freeze base/config/mp_version @ 1.800, since point 1 above takes care of all pre 1.8.0 clients across the transition and point 2 of all post 1.8.0 clients going forward (they record @MACPORTS_VERSION@, rather than @MP_VERSION@, as their version number and compare that against base/config/macports_version when selfupdating, so there will be no need to update base/config/mp_version beyond anything greater than the last floating point release, i.e. 1.700).

So, from this analysis I conclude that the only thing necessary to get pre 1.8.0 clients across to 1.8.x,
added to what was done up until r43375, is the existence of base/config/mp_version in svn, and as soon as
we remove it we break selfupdate backwards compatibility with them, at which point we'll need to instruct
stragglers to either force the selfupdate or install from the dmg.

PS: I've thought all this out rather extensively, so I believe this approach is functional, but don't be shy to pull
my ear if I again got it wrong!

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