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

Last change on this file since 7156 was 7156, checked in by jkh, 16 years ago

Add another (optional) argument to dportopen so that we can defeat the cache in cases where we need to open an existing instance
but set different options for it.
Reviewed by: kvv

  • Property svn:eol-style set to native
File size: 27.1 KB
Line 
1# darwinports.tcl
2#
3# Copyright (c) 2002 Apple Computer, Inc.
4# All rights reserved.
5#
6# Redistribution and use in source and binary forms, with or without
7# modification, are permitted provided that the following conditions
8# are met:
9# 1. Redistributions of source code must retain the above copyright
10#    notice, this list of conditions and the following disclaimer.
11# 2. Redistributions in binary form must reproduce the above copyright
12#    notice, this list of conditions and the following disclaimer in the
13#    documentation and/or other materials provided with the distribution.
14# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
15#    may be used to endorse or promote products derived from this software
16#    without specific prior written permission.
17#
18# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
19# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
20# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
21# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
22# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
23# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
24# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
26# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
27# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
28# POSSIBILITY OF SUCH DAMAGE.
29#
30package provide darwinports 1.0
31package require darwinports_dlist 1.0
32package require darwinports_index 1.0
33
34namespace eval darwinports {
35    namespace export bootstrap_options portinterp_options open_dports
36    variable bootstrap_options "portdbpath libpath binpath master_site_local auto_path sources_conf prefix"
37    variable portinterp_options "portdbpath portpath auto_path prefix portsharepath registry.path"
38       
39    variable open_dports {}
40}
41
42# Provided UI instantiations
43# For standard messages, the following priorities are defined
44#     debug, info, msg, warn, error
45# Clients of the library are expected to provide ui_puts with the following prototype.
46#     proc ui_puts {message}
47# message is a tcl list of array element pairs, defined as such:
48#     version   - ui protocol version
49#     priority  - message priority
50#     data      - message data
51# ui_puts should handle the above defined priorities
52
53foreach priority "debug info msg error warn" {
54    eval "proc ui_$priority {str} \{ \n\
55        set message(priority) $priority \n\
56        set message(data) \$str \n\
57        ui_puts \[array get message\] \n\
58    \}"
59}
60
61proc darwinports::ui_event {context message} {
62    array set postmessage $message
63    set postmessage(context) $context
64    ui_puts [array get postmessage]
65}
66
67proc dportinit {args} {
68    global auto_path env darwinports::portdbpath darwinports::bootstrap_options darwinports::portinterp_options darwinports::portconf darwinports::sources darwinports::sources_conf darwinports::portsharepath darwinports::registry.path darwinports::autoconf::dports_conf_path
69
70    # first look at PORTSRC for testing/debugging
71    if {[llength [array names env PORTSRC]] > 0} {
72        set PORTSRC [lindex [array get env PORTSRC] 1]
73        if {[file isfile ${PORTSRC}]} {
74            set portconf ${PORTSRC}
75            lappend conf_files ${portconf}
76        }
77    }
78
79    # then look in ~/.portsrc
80    if {![info exists portconf]} {
81        if {[llength [array names env HOME]] > 0} {
82            set HOME [lindex [array get env HOME] 1]
83            if {[file isfile [file join ${HOME} .portsrc]]} {
84                set portconf [file join ${HOME} .portsrc]
85                lappend conf_files ${portconf}
86            }
87        }
88    }
89
90    # finally /etc/ports/ports.conf, or whatever path was configured
91    if {![info exists portconf]} {
92        if {[file isfile $dports_conf_path/ports.conf]} {
93            set portconf $dports_conf_path/ports.conf
94            lappend conf_files $dports_conf_path/ports.conf
95        }
96    }
97    if {[info exists conf_files]} {
98        foreach file $conf_files {
99            set fd [open $file r]
100            while {[gets $fd line] >= 0} {
101                foreach option $bootstrap_options {
102                    if {[regexp "^$option\[ \t\]+(\[A-Za-z0-9_:\./\]+$)" $line match val] == 1} {
103                        set darwinports::$option $val
104                        global darwinports::$option
105                    }
106                }
107            }
108        }
109    }
110
111    if {![info exists sources_conf]} {
112        return -code error "sources_conf must be set in $dports_conf_path/ports.conf or in your ~/.portsrc"
113    }
114    if {[catch {set fd [open $sources_conf r]} result]} {
115        return -code error "$result"
116    }
117    while {[gets $fd line] >= 0} {
118        set line [string trimright $line]
119        if {![regexp {[\ \t]*#.*|^$} $line]} {
120            lappend sources $line
121        }
122    }
123    if {![info exists sources]} {
124        if {[file isdirectory dports]} {
125            set sources "file://[pwd]/dports"
126        } else {
127            return -code error "No sources defined in $sources_conf"
128        }
129    }
130
131    if {![info exists portdbpath]} {
132        return -code error "portdbpath must be set in $dports_conf_path/ports.conf or in your ~/.portsrc"
133    }
134    if {![file isdirectory $portdbpath]} {
135        if {![file exists $portdbpath]} {
136            if {[catch {file mkdir $portdbpath} result]} {
137                return -code error "portdbpath $portdbpath does not exist and could not be created: $result"
138            }
139        }
140    }
141    if {![file isdirectory $portdbpath]} {
142        return -code error "$portdbpath is not a directory. Please create the directory $portdbpath and try again"
143    }
144
145    set registry.path [file join $portdbpath receipts]
146    if {![file isdirectory ${registry.path}]} {
147        if {![file exists ${registry.path}]} {
148            if {[catch {file mkdir ${registry.path}} result]} {
149                return -code error "portdbpath ${registry.path} does not exist and could not be created: $result"
150            }
151        }
152    }
153    if {![file isdirectory ${darwinports::registry.path}]} {
154        return -code error "${darwinports::registry.path} is not a directory. Please create the directory $portdbpath and try again"
155    }
156
157    set portsharepath ${prefix}/share/darwinports
158    if {![file isdirectory $portsharepath]} {
159        return -code error "Data files directory '$portsharepath' must exist"
160    }
161   
162    if {![info exists libpath]} {
163        set libpath "${prefix}/share/darwinports/Tcl"
164    }
165
166    if {![info exists binpath]} {
167        global env
168        set env(PATH) "${prefix}/bin:${prefix}/sbin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/X11R6/bin"
169    } else {
170        global env
171        set env(PATH) "$binpath"
172    }
173
174    if {[info exists master_site_local] && ![info exists env(MASTER_SITE_LOCAL)]} {
175        global env
176        set env(MASTER_SITE_LOCAL) "$master_site_local"
177    }
178
179    if {[file isdirectory $libpath]} {
180                lappend auto_path $libpath
181                set darwinports::auto_path $auto_path
182
183                # XXX: not sure if this the best place, but it needs to happen
184                # early, and after auto_path has been set.  Or maybe Pextlib
185                # should ship with darwinports1.0 API?
186                package require Pextlib 1.0
187    } else {
188                return -code error "Library directory '$libpath' must exist"
189    }
190}
191
192proc darwinports::worker_init {workername portpath options variations} {
193    global darwinports::portinterp_options auto_path
194
195    # Create package require abstraction procedure
196    $workername eval "proc PortSystem \{version\} \{ \n\
197                        package require port \$version \}"
198
199    foreach proc {dportexec dportopen dportclose dportsearch} {
200        $workername alias $proc $proc
201    }
202
203    # instantiate the UI call-back
204    $workername alias ui_event darwinports::ui_event $workername
205
206        # xxx: find a better home for this registry cruft--like six feet under.
207        $workername alias registry_new dportregistry::new $workername
208        $workername alias registry_store dportregistry::store
209        $workername alias registry_delete dportregistry::delete
210        $workername alias registry_exists dportregistry::exists
211        $workername alias registry_close dportregistry::close
212        $workername alias fileinfo_for_index dportregistry::fileinfo_for_index
213        $workername alias fileinfo_for_file dportregistry::fileinfo_for_file
214        $workername alias fileinfo_for_entry dportregistry::fileinfo_for_entry
215
216    foreach opt $portinterp_options {
217        if {![info exists $opt]} {
218            global darwinports::$opt
219        }
220        if {[info exists $opt]} {
221            $workername eval set system_options($opt) \"[set $opt]\"
222            $workername eval set $opt \"[set $opt]\"
223        } #"
224    }
225
226    foreach {opt val} $options {
227        $workername eval set user_options($opt) $val
228        $workername eval set $opt $val
229    }
230
231    foreach {var val} $variations {
232        $workername eval set variations($var) $val
233    }
234}
235
236proc darwinports::fetch_port {url} {
237    global darwinports::portdbpath tcl_platform
238    set fetchdir [file join $portdbpath portdirs]
239    set fetchfile [file tail $url]
240    if {[catch {file mkdir $fetchdir} result]} {
241        return -code error $result
242    }
243    if {![file writable $fetchdir]} {
244        return -code error "Port remote fetch failed: You do not have permission to write to $fetchdir"
245    }
246    if {[catch {exec curl -L -s -S -o [file join $fetchdir $fetchfile] $url} result]} {
247        return -code error "Port remote fetch failed: $result"
248    }
249    if {[catch {cd $fetchdir} result]} {
250        return -code error $result
251    }
252    if {[catch {exec tar -zxf $fetchfile} result]} {
253        return -code error "Port extract failed: $result"
254    }
255    if {[regexp {(.+).tgz} $fetchfile match portdir] != 1} {
256        return -code error "Can't decipher portdir from $fetchfile"
257    }
258
259    return [file join $fetchdir $portdir]
260}
261
262proc darwinports::getprotocol {url} {
263    if {[regexp {(?x)([^:]+)://.+} $url match protocol] == 1} {
264        return ${protocol}
265    } else {
266        return -code error "Can't parse url $url"
267    }
268}
269
270proc darwinports::getportdir {url} {
271    if {[regexp {(?x)([^:]+)://(.+)} $url match protocol string] == 1} {
272        switch -regexp -- ${protocol} {
273            {^file$} { return $string}
274        {dports} { return [darwinports::index::fetch_port $url] }
275            {http|ftp} { return [darwinports::fetch_port $url] }
276            default { return -code error "Unsupported protocol $protocol" }
277        }
278    } else {
279        return -code error "Can't parse url $url"
280    }
281}
282
283# dportopen
284# Opens a DarwinPorts portfile specified by a URL.  The portfile is
285# opened with the given list of options and variations.  The result
286# of this function should be treated as an opaque handle to a
287# DarwinPorts Portfile.
288
289proc dportopen {porturl {options ""} {variations ""} {nocache ""}} {
290    global darwinports::portinterp_options darwinports::portdbpath darwinports::portconf darwinports::open_dports auto_path
291
292        # Look for an already-open DPort with the same URL.
293        # XXX: should compare options and variations here too.
294        # if found, return the existing reference and bump the refcount.
295        if {$nocache != ""} {
296                set dport {}
297        } else {
298                set dport [dlist_search $darwinports::open_dports porturl $porturl]
299        }
300        if {$dport != {}} {
301                set refcnt [ditem_key $dport refcnt]
302                incr refcnt
303                ditem_key $dport refcnt $refcnt
304                return $dport
305        }
306
307        set portdir [darwinports::getportdir $porturl]
308        cd $portdir
309        set portpath [pwd]
310        set workername [interp create]
311
312        set dport [ditem_create]
313        lappend darwinports::open_dports $dport
314        ditem_key $dport porturl $porturl
315        ditem_key $dport portpath $portpath
316        ditem_key $dport workername $workername
317        ditem_key $dport options $options
318        ditem_key $dport variations $variations
319        ditem_key $dport refcnt 1
320
321    darwinports::worker_init $workername $portpath $options $variations
322    if {![file isfile Portfile]} {
323        return -code error "Could not find Portfile in $portdir"
324    }
325
326    $workername eval source Portfile
327       
328    ditem_key $dport provides [$workername eval return \$portname]
329
330    return $dport
331}
332
333### _dportsearchpath is private; subject to change without notice
334
335proc _dportsearchpath {depregex search_path} {
336    set found 0
337    foreach path $search_path {
338        if {![file isdirectory $path]} {
339            continue
340        }
341
342        if {[catch {set filelist [readdir $path]} result]} {
343                return -code error "$result ($path)"
344                set filelist ""
345        }
346
347        foreach filename $filelist {
348            if {[regexp $depregex $filename] == 1} {
349                ui_debug "Found Dependency: path: $path filename: $filename regex: $depregex"
350                set found 1
351                break
352            }
353        }
354    }
355
356    return $found
357}
358
359### _libtest is private; subject to change without notice
360# XXX - Architecture specific
361# XXX - Rely on information from internal defines in cctools/dyld:
362# define DEFAULT_FALLBACK_FRAMEWORK_PATH
363# /Library/Frameworks:/Library/Frameworks:/Network/Library/Frameworks:/System/Library/Frameworks
364# define DEFAULT_FALLBACK_LIBRARY_PATH /lib:/usr/local/lib:/lib:/usr/lib
365#   -- Since /usr/local is bad, using /lib:/usr/lib only.
366# Environment variables DYLD_FRAMEWORK_PATH, DYLD_LIBRARY_PATH,
367# DYLD_FALLBACK_FRAMEWORK_PATH, and DYLD_FALLBACK_LIBRARY_PATH take precedence
368
369proc _libtest {dport depspec} {
370    global env tcl_platform
371        set depline [lindex [split $depspec :] 1]
372        set prefix [_dportkey $dport prefix]
373       
374        if {[info exists env(DYLD_FRAMEWORK_PATH)]} {
375            lappend search_path $env(DYLD_FRAMEWORK_PATH)
376        } else {
377            lappend search_path /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks
378        }
379        if {[info exists env(DYLD_FALLBACK_FRAMEWORK_PATH)]} {
380            lappend search_path $env(DYLD_FALLBACK_FRAMEWORK_PATH)
381        }
382        if {[info exists env(DYLD_LIBRARY_PATH)]} {
383            lappend search_path $env(DYLD_LIBRARY_PATH)
384        }
385        lappend search_path /lib /usr/lib /usr/X11R6/lib ${prefix}/lib
386        if {[info exists env(DYLD_FALLBACK_LIBRARY_PATH)]} {
387            lappend search_path $env(DYLD_LIBRARY_PATH)
388        }
389
390        set i [string first . $depline]
391        set depname [string range $depline 0 [expr $i - 1]]
392        set depversion [string range $depline $i end]
393        regsub {\.} $depversion {\.} depversion
394        if {$tcl_platform(os) == "Darwin"} {
395                set depregex \^${depname}${depversion}\\.dylib\$
396        } else {
397                set depregex \^${depname}\\.so${depversion}\$
398        }
399
400        return [_dportsearchpath $depregex $search_path]
401}
402
403### _bintest is private; subject to change without notice
404
405proc _bintest {dport depspec} {
406    global env
407        set depregex [lindex [split $depspec :] 1]
408        set prefix [_dportkey $dport prefix] 
409       
410        set search_path [split $env(PATH) :]
411       
412        set depregex \^$depregex\$
413       
414        return [_dportsearchpath $depregex $search_path]
415}
416
417### _pathtest is private; subject to change without notice
418
419proc _pathtest {dport depspec} {
420    global env
421        set depregex [lindex [split $depspec :] 1]
422        set prefix [_dportkey $dport prefix] 
423   
424        # separate directory from regex
425        set fullname $depregex
426
427        regexp {^(.*)/(.*?)$} "$fullname" match search_path depregex
428
429        if {[string index $search_path 0] != "/"} {
430                # Prepend prefix if not an absolute path
431                set search_path "${prefix}/${search_path}"
432        }
433
434        set depregex \^$depregex\$
435
436        return [_dportsearchpath $depregex $search_path]
437}
438
439### _dportinstalled is private; may change without notice
440
441# Determine if a port is already *installed*, as in "in the registry".
442proc _dportinstalled {dport} {
443        # Check for the presense of the port in the registry
444        set workername [ditem_key $dport workername]
445        set res [$workername eval registry_exists \${portname} \${portversion}]
446        if {$res != ""} {
447                ui_debug "Found Dependency: receipt: $res"
448                return 1
449        } else {
450                return 0
451        }
452}
453
454### _dporispresent is private; may change without notice
455
456# Determine if some depspec is satisfied or if the given port is installed.
457# We actually start with the registry (faster?)
458#
459# dport         the port to test (to figure out if it's present)
460# depspec       the dependency test specification (path, bin, lib, etc.)
461proc _dportispresent {dport depspec} {
462        # Check for the presense of the port in the registry
463        set workername [ditem_key $dport workername]
464        set res [$workername eval registry_exists \${portname} \${portversion}]
465        if {$res != ""} {
466                ui_debug "Found Dependency: receipt: $res"
467                return 1
468        } else {
469                # The receipt test failed, use one of the depspec regex mechanisms
470                set type [lindex [split $depspec :] 0]
471                switch $type {
472                        lib { return [_libtest $dport $depspec] }
473                        bin { return [_bintest $dport $depspec] }
474                        path { return [_pathtest $dport $depspec] }
475                        default {return -code error "unknown depspec type: $type"}
476                }
477                return 0
478        }
479}
480
481### _dportexec is private; may change without notice
482
483proc _dportexec {target dport} {
484        # xxx: set the work path?
485        set workername [ditem_key $dport workername]
486        if {![catch {$workername eval eval_variants variations $target} result] && $result == 0 &&
487                ![catch {$workername eval eval_targets $target} result] && $result == 0} {
488                # xxx: clean after installing?
489                #$workername eval eval_targets clean
490                return 0
491        } else {
492                # An error occurred.
493                return 1
494        }
495}
496
497# dportexec
498# Execute the specified target of the given dport.
499
500proc dportexec {dport target} {
501    global darwinports::portinterp_options
502
503        set workername [ditem_key $dport workername]
504
505        # XXX: move this into dportopen?
506        if {[$workername eval eval_variants variations $target] != 0} {
507                return 1
508        }
509       
510        # Before we build the port, we must build its dependencies.
511        # XXX: need a more general way of comparing against targets
512        set dlist {}
513        if {$target == "package"} {
514                ui_warn "package target replaced by pkg target, please use the pkg target in the future."
515                set target "pkg"
516        }
517        if {$target == "configure" || $target == "build"
518                || $target == "destroot" || $target == "install"
519                || $target == "pkg" || $target == "mpkg"
520                || $target == "rpmpackage" || $target == "dpkg" } {
521
522                if {[dportdepends $dport 1 1] != 0} {
523                        return 1
524                }
525               
526                # Select out the dependents along the critical path,
527                # but exclude this dport, we might not be installing it.
528                set dlist [dlist_append_dependents $darwinports::open_dports $dport {}]
529               
530                dlist_delete dlist $dport
531
532                # install them
533                set result [dlist_eval $dlist _dportinstalled [list _dportexec "install"]]
534               
535                if {$result != {}} {
536                        set errstring "The following dependencies failed to build:"
537                        foreach ditem $result {
538                                append errstring " [ditem_key $ditem provides]"
539                        }
540                        ui_error $errstring
541                        return 1
542                }
543               
544                # Close the dependencies, we're done installing them
545                foreach ditem $dlist {
546                    dportclose $ditem
547                }
548        }
549       
550        # Build this port with the specified target
551        return [$workername eval eval_targets $target]
552       
553        return 0
554}
555
556proc darwinports::getindex {source} {
557    global darwinports::portdbpath
558    # Special case file:// sources
559    if {[darwinports::getprotocol $source] == "file"} {
560        return [file join [darwinports::getportdir $source] PortIndex]
561    }
562    regsub {://} $source {.} source_dir
563    regsub -all {/} $source_dir {_} source_dir
564    return [file join $portdbpath sources $source_dir PortIndex]
565}
566
567proc dportsync {args} {
568    global darwinports::sources darwinports::portdbpath tcl_platform
569
570    foreach source $sources {
571        # Special case file:// sources
572        if {[darwinports::getprotocol $source] == "file"} {
573            continue
574        } elseif {[darwinports::getprotocol $source] == "dports"} {
575                        darwinports::index::sync $darwinports::portdbpath $source
576        } else {
577                        set indexfile [darwinports::getindex $source]
578                        if {[catch {file mkdir [file dirname $indexfile]} result]} {
579                                return -code error $result
580                        }
581                        if {![file writable [file dirname $indexfile]]} {
582                                return -code error "You do not have permission to write to [file dirname $indexfile]"
583                        }
584                        exec curl -L -s -S -o $indexfile $source/PortIndex
585                }
586    }
587}
588
589proc dportsearch {regexp} {
590    global darwinports::portdbpath darwinports::sources
591    set matches [list]
592
593    foreach source $sources {
594        if {[darwinports::getprotocol $source] == "dports"} {
595                array set attrs [list name $regexp]
596                        set res [darwinports::index::search $darwinports::portdbpath $source [array get attrs]]
597                        eval lappend matches $res
598                } else {
599        if {[catch {set fd [open [darwinports::getindex $source] r]} result]} {
600            return -code error "Can't open index file for source $source. Have you synced your source indexes?"
601        }
602        while {[gets $fd line] >= 0} {
603            set name [lindex $line 0]
604            if {[regexp -- $regexp $name] == 1} {
605                gets $fd line
606                array set portinfo $line
607                if {[info exists portinfo(portarchive)]} {
608                    lappend line porturl ${source}/$portinfo(portarchive)
609                } elseif {[info exists portinfo(portdir)]} {
610                    lappend line porturl ${source}/$portinfo(portdir)
611                }
612                lappend matches $name
613                lappend matches $line
614            } else {
615                set len [lindex $line 1]
616                seek $fd $len current
617            }
618        }
619        close $fd
620        }
621    }
622
623    return $matches
624}
625
626proc dportinfo {dport} {
627        set workername [ditem_key $dport workername]
628    return [$workername eval array get PortInfo]
629}
630
631proc dportclose {dport} {
632        global darwinports::open_dports
633        set refcnt [ditem_key $dport refcnt]
634        incr refcnt -1
635        ditem_key $dport refcnt $refcnt
636        if {$refcnt == 0} {
637                dlist_delete darwinports::open_dports $dport
638                set workername [ditem_key $dport workername]
639                interp delete $workername
640        }
641}
642
643##### Private Depspec API #####
644# This API should be considered work in progress and subject to change without notice.
645##### "
646
647# _dportkey
648# - returns a variable from the port's interpreter
649
650proc _dportkey {dport key} {
651        set workername [ditem_key $dport workername]
652        return [$workername eval "return \$${key}"]
653}
654
655# dportdepends builds the list of dports which the given port depends on.
656# This list is added to $dport.
657# - optionally includes the build dependencies in the list.
658# - optionally recurses through the dependencies, looking for dependencies
659#       of dependencies.
660
661proc dportdepends {dport includeBuildDeps recurseDeps {accDeps {}}} {
662        array set portinfo [dportinfo $dport]
663        set depends {}
664        if {[info exists portinfo(depends_run)]} { eval "lappend depends $portinfo(depends_run)" }
665        if {[info exists portinfo(depends_lib)]} { eval "lappend depends $portinfo(depends_lib)" }
666        if {$includeBuildDeps != "" && [info exists portinfo(depends_build)]} {
667                eval "lappend depends $portinfo(depends_build)"
668        }
669
670        set subPorts {}
671       
672        foreach depspec $depends {
673                # grab the portname portion of the depspec
674                set portname [lindex [split $depspec :] 2]
675               
676                # Find the porturl
677                if {[catch {set res [dportsearch "^$portname\$"]} error]} {
678                        ui_error "Internal error: port search failed: $error"
679                        return 1
680                }
681                foreach {name array} $res {
682                        array set portinfo $array
683                        if {[info exists portinfo(porturl)]} {
684                                set porturl $portinfo(porturl)
685                                break
686                        }
687                }
688
689                if {![info exists porturl]} {
690                        ui_error "Dependency '$portname' not found."
691                        return 1
692                }
693
694                set options [ditem_key $dport options]
695                set variations [ditem_key $dport variations]
696
697                # Figure out the subport.       
698                set subport [dportopen $porturl $options $variations]
699
700                # Is that dependency satisfied or this port installed?
701                # If not, add it to the list. Otherwise, don't.
702                if {![_dportispresent $subport $depspec]} {
703                        # Append the sub-port's provides to the port's requirements list.
704                        ditem_append_unique $dport requires "[ditem_key $subport provides]"
705       
706                        if {$recurseDeps != ""} {
707                                # Skip the port if it's already in the accumulated list.
708                                if {[lsearch $accDeps $portname] == -1} {
709                                        # Add it to the list
710                                        lappend accDeps $portname
711                               
712                                        # We'll recursively iterate on it.
713                                        lappend subPorts $subport
714                                }
715                        }
716                }
717        }
718
719        # Loop on the subports.
720        if {$recurseDeps != ""} {
721                foreach subport $subPorts {
722                        set res [dportdepends $subport $includeBuildDeps $recurseDeps $accDeps]
723                        if {$res != 0} {
724                                return $res
725                        }
726                }
727        }
728       
729        return 0
730}
731
732# Snarfed from portregistry.tcl
733# For now, just write stuff to a file for debugging.
734
735namespace eval dportregistry {}
736
737proc dportregistry::new {workername portname {portversion 1.0}} {
738    global _registry_name darwinports::registry.path
739
740    file mkdir ${darwinports::registry.path}
741    set _registry_name [file join ${darwinports::registry.path} $portname-$portversion]
742    system "rm -f ${_registry_name}.tmp"
743    set rhandle [open ${_registry_name}.tmp w 0644]
744    puts $rhandle "\# Format: var value ... {contents {filename uid gid mode size {md5}} ... }"
745        #interp share {} $rhandle $workername
746    return $rhandle
747}
748
749proc dportregistry::exists {portname {portversion 0}} {
750    global darwinports::registry.path
751
752    # regex match case
753    if {$portversion == 0} {
754        set x [glob -nocomplain [file join ${darwinports::registry.path} ${portname}-*]]
755        if {[string length $x]} {
756            set matchfile [lindex $x 0]
757        } else {
758            set matchfile ""
759        }
760    } else {
761        set matchfile [file join ${darwinports::registry.path} ${portname}-${portversion}]
762    }
763
764    # Might as well bail out early if no file to match
765    if {![string length $matchfile]} {
766        return ""
767    }
768
769    if {[file exists $matchfile]} {
770        return $matchfile
771    }
772    if {[file exists ${matchfile}.bz2]} {
773        return ${matchfile}.bz2
774    }
775    return ""
776}
777
778proc dportregistry::store {rhandle data} {
779    puts $rhandle $data
780}
781
782proc dportregistry::fetch {rhandle} {
783    return -1
784}
785
786proc dportregistry::traverse {func} {
787    return -1
788}
789
790proc dportregistry::close {rhandle} {
791    global _registry_name
792    global registry.nobzip
793
794    ::close $rhandle
795    system "mv ${_registry_name}.tmp ${_registry_name}"
796    if {[file exists ${_registry_name}] && [file exists /usr/bin/bzip2] && ![info exists registry.nobzip]} {
797        system "/usr/bin/bzip2 -f ${_registry_name}"
798    }
799}
800
801proc dportregistry::delete {portname {portversion 0}} {
802    global darwinports::registry.path
803
804    # regex match case, as in exists
805    if {$portversion == 0} {
806                set x [glob -nocomplain [file join ${darwinports::registry.path} ${portname}-*]]
807                if {[string length $x]} {
808                    exec rm -f [lindex $x 0]
809                }
810        } else {
811                # Remove the file (with or without .bz2 suffix)
812                set filename [file join ${darwinports::registry.path} ${portname}-${portversion}]
813                if { [file exists $filename] } {
814                        exec rm -rf $filename
815                } elseif { [file exists ${filename}.bz2] } {
816                        exec rm -rf ${filename}.bz2
817                }
818        }
819}
820
821proc dportregistry::fileinfo_for_file {fname} {
822    if {![catch {file stat $fname statvar}]} {
823        if {[file isfile $fname]} {
824            if {[catch {md5 file $fname} md5sum] == 0} {
825                # Create a line that matches md5(1)'s output
826                # for backwards compatibility
827                set line "MD5 ($fname) = $md5sum"
828                return [list $fname $statvar(uid) $statvar(gid) $statvar(mode) $statvar(size) $line]
829            }
830        } else {
831            return  [list $fname $statvar(uid) $statvar(gid) $statvar(mode) $statvar(size) "MD5 ($fname) NONE"]
832        }
833    }
834    return {}
835}
836
837proc dportregistry::fileinfo_for_entry {rval dir entry} {
838    upvar $rval myrval
839    set path [file join $dir $entry]
840    lappend myrval [dportregistry::fileinfo_for_file $path]
841    return $myrval
842}
843
844proc dportregistry::fileinfo_for_index {flist} {
845    global prefix
846
847    set rval {}
848    foreach file $flist {
849        if {[string match /* $file]} {
850            set fname $file
851            set dir /
852        } else {
853            set fname [file join $prefix $file]
854            set dir $prefix
855        }
856        dportregistry::fileinfo_for_entry rval $dir $file
857    }
858    return $rval
859}
860
861proc dportregistry::listinstalled {args} {
862    global darwinports::registry.path
863
864    set receiptglob [glob -nocomplain ${darwinports::registry.path}/*]
865
866    if {$receiptglob == ""} {
867        puts "No ports installed."
868    } else {
869        puts "The following ports are installed:"
870        foreach receipt $receiptglob {
871            if {[file extension $receipt] == ".bz2"} {
872                puts "\t[file rootname [file tail $receipt]]"
873            } else {
874                puts "\t[file tail $receipt]"
875            }
876        }
877    }
878}
879
Note: See TracBrowser for help on using the repository browser.