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

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