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

Last change on this file since 17033 was 17033, checked in by jberry, 15 years ago

Patch bug #7756 by dluke: rely on current path for rsync.
The hardcoded path wasn't very good, and this isn't too much better either, though it does allow the user to easilly replace rsync. We should probably find it during autoconf. Oh well for now.
Fix a minor spelling mistake.

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