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

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

Rename 'rpmpackage' target to plain 'rpm' (which is not only shorter, but also more consistent with other packaging target names).

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