source: trunk/base/src/darwinports1.0/darwinports.tcl @ 25980

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

Wrap dportsearch inner block in a try-finally clause to ensure PortIndex file is always closed even if an error occurs

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