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

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

base:
Inheritance of macports.conf, patch by Adam Byrtek
Closes #16329

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