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

Last change on this file since 19066 was 19066, checked in by jberry, 14 years ago

Update some UI strings and docs to use the MacPorts name, rather than darwinports.

  • Property svn:eol-style set to native
File size: 54.7 KB
Line 
1# darwinports.tcl
2# $Id: darwinports.tcl,v 1.220 2006/08/10 02:54:25 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 DYLD_INSERT_LIBRARIES
431                          HOME JAVA_HOME LD_PREBIND
432                          LD_PREBIND_ALLOW_OVERLAP MASTER_SITE_LOCAL
433                          PATCH_SITE_LOCAL PATH PORTSRC RSYNC_PROXY TMP TMPDIR
434                          USER GROUP
435                          http_proxy HTTPS_PROXY FTP_PROXY ALL_PROXY NO_PROXY
436                                        }
437    if {[info exists extra_env]} {
438        set keepenvkeys [concat ${keepenvkeys} ${extra_env}]
439    }
440       
441        foreach envkey [array names env] {
442                if {[lsearch $keepenvkeys $envkey] == -1} {
443                        array unset env $envkey
444                }
445        }
446
447        if {![info exists xcodeversion] || ![info exists xcodebuildcmd]} {
448                # We'll resolve these later (if needed)
449                trace add variable darwinports::xcodeversion read darwinports::setxcodeinfo
450                trace add variable darwinports::xcodebuildcmd read darwinports::setxcodeinfo
451        }
452
453    # Set the default umask
454    if {![info exists destroot_umask]} {
455        set destroot_umask 022
456    }
457
458    if {[info exists master_site_local] && ![info exists env(MASTER_SITE_LOCAL)]} {
459        set env(MASTER_SITE_LOCAL) "$master_site_local"
460    }
461
462        # Prebinding. useful with MacOS X's ld, harmless elsewhere.
463        # With both variables, prebinding will always succeed but we might need
464        # to redo it.
465    if {![info exists env(LD_PREBIND)] && ![info exists env(LD_PREBIND_ALLOW_OVERLAP)]} {
466        set env(LD_PREBIND) "1"
467        set env(LD_PREBIND_ALLOW_OVERLAP) "1"
468    }
469
470    if {[file isdirectory $libpath]} {
471                lappend auto_path $libpath
472                set darwinports::auto_path $auto_path
473
474                # XXX: not sure if this the best place, but it needs to happen
475                # early, and after auto_path has been set.  Or maybe Pextlib
476                # should ship with darwinports1.0 API?
477                package require Pextlib 1.0
478                package require registry 1.0
479    } else {
480                return -code error "Library directory '$libpath' must exist"
481    }
482}
483
484proc darwinports::worker_init {workername portpath portbuildpath options variations} {
485    global darwinports::portinterp_options darwinports::portinterp_deferred_options registry.installtype
486
487        # Tell the sub interpreter about all the Tcl packages we already
488        # know about so it won't glob for packages.
489        foreach pkgName [package names] {
490                foreach pkgVers [package versions $pkgName] {
491                        set pkgLoadScript [package ifneeded $pkgName $pkgVers]
492                        $workername eval "package ifneeded $pkgName $pkgVers {$pkgLoadScript}"
493                }
494        }
495
496    # Create package require abstraction procedure
497    $workername eval "proc PortSystem \{version\} \{ \n\
498                        package require port \$version \}"
499
500    # Clearly separate slave interpreters and the master interpreter.
501        $workername alias dport_exec dportexec
502        $workername alias dport_open dportopen
503        $workername alias dport_close dportclose
504        $workername alias dport_search dportsearch
505
506    # instantiate the UI call-backs
507        foreach priority ${darwinports::ui_priorities} {
508                $workername alias ui_$priority ui_$priority
509        }
510        $workername alias ui_prefix ui_prefix
511        $workername alias ui_channels ui_channels
512   
513    # Export some utility functions defined here.
514    $workername alias darwinports_create_thread darwinports::create_thread
515
516        # New Registry/Receipts stuff
517        $workername alias registry_new registry::new_entry
518        $workername alias registry_open registry::open_entry
519        $workername alias registry_write registry::write_entry
520        $workername alias registry_prop_store registry::property_store
521        $workername alias registry_prop_retr registry::property_retrieve
522        $workername alias registry_delete registry::delete_entry
523        $workername alias registry_exists registry::entry_exists
524        $workername alias registry_activate portimage::activate
525        $workername alias registry_deactivate portimage::deactivate
526        $workername alias registry_register_deps registry::register_dependencies
527        $workername alias registry_fileinfo_for_index registry::fileinfo_for_index
528        $workername alias registry_bulk_register_files registry::register_bulk_files
529        $workername alias registry_installed registry::installed
530
531        # deferred options processing.
532        $workername alias getoption darwinports::getoption
533
534    foreach opt $portinterp_options {
535                if {![info exists $opt]} {
536                    global darwinports::$opt
537                }
538        if {[info exists $opt]} {
539            $workername eval set system_options($opt) \"[set $opt]\"
540            $workername eval set $opt \"[set $opt]\"
541        }
542    }
543   
544        foreach opt $portinterp_deferred_options {
545                global darwinports::$opt
546                # define the trace hook.
547                $workername eval \
548                        "proc trace_$opt {name1 name2 op} { \n\
549                                trace remove variable ::$opt read ::trace_$opt \n\
550                                global $opt \n\
551                                set $opt \[getoption $opt\] \n\
552                        }"
553                # next access will actually define the variable.
554                $workername eval "trace add variable ::$opt read ::trace_$opt"
555                # define some value now
556                $workername eval set $opt "?"
557        }               
558
559    foreach {opt val} $options {
560        $workername eval set user_options($opt) $val
561        $workername eval set $opt $val
562    }
563
564    foreach {var val} $variations {
565        $workername eval set variations($var) $val
566    }
567
568    if { [info exists registry.installtype] } {
569            $workername eval set installtype ${registry.installtype}
570    }
571}
572
573# Create a thread with most configuration options set.
574# The newly created thread is sent portinterp_options vars and knows where to
575# find all packages we know.
576proc darwinports::create_thread {} {
577    package require Thread
578
579    global darwinports::portinterp_options
580
581        # Create the thread.
582        set result [thread::create -preserved {thread::wait}]
583
584        # Tell the thread about all the Tcl packages we already
585        # know about so it won't glob for packages.
586        foreach pkgName [package names] {
587                foreach pkgVers [package versions $pkgName] {
588                        set pkgLoadScript [package ifneeded $pkgName $pkgVers]
589                        thread::send -async $result "package ifneeded $pkgName $pkgVers {$pkgLoadScript}"
590                }
591        }
592
593        # inherit configuration variables.
594        thread::send -async $result "namespace eval darwinports {}"
595        foreach opt $portinterp_options {
596                if {![info exists $opt]} {
597                        global darwinports::$opt
598                }
599        if {[info exists $opt]} {
600                        thread::send -async $result "global darwinports::$opt"
601                        set val [set darwinports::$opt]
602                        thread::send -async $result "set darwinports::$opt \"$val\""
603                }
604        }
605       
606        return $result
607}
608
609proc darwinports::fetch_port {url} {
610    global darwinports::portdbpath tcl_platform
611    set fetchdir [file join $portdbpath portdirs]
612    set fetchfile [file tail $url]
613    if {[catch {file mkdir $fetchdir} result]} {
614        return -code error $result
615    }
616    if {![file writable $fetchdir]} {
617        return -code error "Port remote fetch failed: You do not have permission to write to $fetchdir"
618    }
619    if {[catch {exec curl -L -s -S -o [file join $fetchdir $fetchfile] $url} result]} {
620        return -code error "Port remote fetch failed: $result"
621    }
622    if {[catch {cd $fetchdir} result]} {
623        return -code error $result
624    }
625    if {[catch {exec tar -zxf $fetchfile} result]} {
626        return -code error "Port extract failed: $result"
627    }
628    if {[regexp {(.+).tgz} $fetchfile match portdir] != 1} {
629        return -code error "Can't decipher portdir from $fetchfile"
630    }
631    return [file join $fetchdir $portdir]
632}
633
634proc darwinports::getprotocol {url} {
635    if {[regexp {(?x)([^:]+)://.+} $url match protocol] == 1} {
636        return ${protocol}
637    } else {
638        return -code error "Can't parse url $url"
639    }
640}
641
642# XXX: this really needs to be rethought in light of the remote index
643# I've added the destdir parameter.  This is the location a remotely
644# fetched port will be downloaded to (currently only applies to
645# dports:// sources).
646proc darwinports::getportdir {url {destdir "."}} {
647        if {[regexp {(?x)([^:]+)://(.+)} $url match protocol string] == 1} {
648                switch -regexp -- ${protocol} {
649                        {^file$} {
650                                return $string
651                        }
652                        {^dports$} {
653                                return [darwinports::index::fetch_port $url $destdir]
654                        }
655                        {^https?$|^ftp$} {
656                                return [darwinports::fetch_port $url]
657                        }
658                        default {
659                                return -code error "Unsupported protocol $protocol"
660                        }
661                }
662        } else {
663                return -code error "Can't parse url $url"
664        }
665}
666
667# dportopen
668# Opens a DarwinPorts portfile specified by a URL.  The portfile is
669# opened with the given list of options and variations.  The result
670# of this function should be treated as an opaque handle to a
671# DarwinPorts Portfile.
672
673proc dportopen {porturl {options ""} {variations ""} {nocache ""}} {
674    global darwinports::portdbpath darwinports::portconf darwinports::open_dports auto_path
675
676        # Look for an already-open DPort with the same URL.
677        # XXX: should compare options and variations here too.
678        # if found, return the existing reference and bump the refcount.
679        if {$nocache != ""} {
680                set dport {}
681        } else {
682                set dport [dlist_search $darwinports::open_dports porturl $porturl]
683        }
684        if {$dport != {}} {
685                set refcnt [ditem_key $dport refcnt]
686                incr refcnt
687                ditem_key $dport refcnt $refcnt
688                return $dport
689        }
690
691        array set options_array $options
692        if {[info exists options_array(portdir)]} {
693                set portdir $options_array(portdir)
694        } else {
695                set portdir ""
696        }
697
698        set portdir [darwinports::getportdir $porturl $portdir]
699        ui_debug "Changing to port directory: $portdir"
700        cd $portdir
701        set portpath [pwd]
702    if {![file isfile Portfile]} {
703        return -code error "Could not find Portfile in $portdir"
704    }
705
706        set workername [interp create]
707
708        set dport [ditem_create]
709        lappend darwinports::open_dports $dport
710        ditem_key $dport porturl $porturl
711        ditem_key $dport portpath $portpath
712        ditem_key $dport workername $workername
713        ditem_key $dport options $options
714        ditem_key $dport variations $variations
715        ditem_key $dport refcnt 1
716       
717    darwinports::worker_init $workername $portpath [darwinports::getportbuildpath $portpath] $options $variations
718
719    $workername eval source Portfile
720
721    ditem_key $dport provides [$workername eval return \$portname]
722
723    return $dport
724}
725
726# Traverse a directory with ports, calling a function on the path of ports
727# (at the second depth).
728# I.e. the structure of dir shall be:
729# category/port/
730# with a Portfile file in category/port/
731#
732# func:         function to call on every port directory (it is passed
733#                       category/port/ as its parameter)
734# root:         the directory with all the categories directories.
735proc dporttraverse {func {root .}} {
736        # Save the current directory
737        set pwd [pwd]
738       
739        # Join the root.
740        set pathToRoot [file join $pwd $root]
741
742        # Go to root because some callers expects us to be there.
743        cd $pathToRoot
744
745    foreach category [lsort -increasing -unique [readdir $root]] {
746        set pathToCategory [file join $root $category]
747        if {[file isdirectory $pathToCategory]} {
748                # Iterate on port directories.
749                        foreach port [lsort -increasing -unique [readdir $pathToCategory]] {
750                                set pathToPort [file join $pathToCategory $port]
751                                if {[file isdirectory $pathToPort] &&
752                                        [file exists [file join $pathToPort "Portfile"]]} {
753                                        # Call the function.
754                                        $func [file join $category $port]
755                                       
756                                        # Restore the current directory because some
757                                        # functions changes it.
758                                        cd $pathToRoot
759                                }
760                        }
761        }
762        }
763       
764        # Restore the current directory.
765        cd $pwd
766}
767
768### _dportsearchpath is private; subject to change without notice
769
770# depregex -> regex on the filename to find.
771# search_path -> directories to search
772# executable -> whether we want to check that the file is executable by current
773#                               user or not.
774proc _dportsearchpath {depregex search_path {executable 0}} {
775    set found 0
776    foreach path $search_path {
777        if {![file isdirectory $path]} {
778            continue
779        }
780
781        if {[catch {set filelist [readdir $path]} result]} {
782                return -code error "$result ($path)"
783                set filelist ""
784        }
785
786        foreach filename $filelist {
787            if {[regexp $depregex $filename] &&
788                (($executable == 0) || [file executable [file join $path $filename]])} {
789                ui_debug "Found Dependency: path: $path filename: $filename regex: $depregex"
790                set found 1
791                break
792            }
793        }
794    }
795    return $found
796}
797
798### _libtest is private; subject to change without notice
799# XXX - Architecture specific
800# XXX - Rely on information from internal defines in cctools/dyld:
801# define DEFAULT_FALLBACK_FRAMEWORK_PATH
802# /Library/Frameworks:/Library/Frameworks:/Network/Library/Frameworks:/System/Library/Frameworks
803# define DEFAULT_FALLBACK_LIBRARY_PATH /lib:/usr/local/lib:/lib:/usr/lib
804#   -- Since /usr/local is bad, using /lib:/usr/lib only.
805# Environment variables DYLD_FRAMEWORK_PATH, DYLD_LIBRARY_PATH,
806# DYLD_FALLBACK_FRAMEWORK_PATH, and DYLD_FALLBACK_LIBRARY_PATH take precedence
807
808proc _libtest {dport depspec} {
809    global env tcl_platform
810        set depline [lindex [split $depspec :] 1]
811        set prefix [_dportkey $dport prefix]
812       
813        if {[info exists env(DYLD_FRAMEWORK_PATH)]} {
814            lappend search_path $env(DYLD_FRAMEWORK_PATH)
815        } else {
816            lappend search_path /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks
817        }
818        if {[info exists env(DYLD_FALLBACK_FRAMEWORK_PATH)]} {
819            lappend search_path $env(DYLD_FALLBACK_FRAMEWORK_PATH)
820        }
821        if {[info exists env(DYLD_LIBRARY_PATH)]} {
822            lappend search_path $env(DYLD_LIBRARY_PATH)
823        }
824        lappend search_path /lib /usr/lib /usr/X11R6/lib ${prefix}/lib
825        if {[info exists env(DYLD_FALLBACK_LIBRARY_PATH)]} {
826            lappend search_path $env(DYLD_FALLBACK_LIBRARY_PATH)
827        }
828
829        set i [string first . $depline]
830        if {$i < 0} {set i [string length $depline]}
831        set depname [string range $depline 0 [expr $i - 1]]
832        set depversion [string range $depline $i end]
833        regsub {\.} $depversion {\.} depversion
834        if {$tcl_platform(os) == "Darwin"} {
835                set depregex \^${depname}${depversion}\\.dylib\$
836        } else {
837                set depregex \^${depname}\\.so${depversion}\$
838        }
839
840        return [_dportsearchpath $depregex $search_path]
841}
842
843### _bintest is private; subject to change without notice
844
845proc _bintest {dport depspec} {
846    global env
847        set depregex [lindex [split $depspec :] 1]
848        set prefix [_dportkey $dport prefix] 
849       
850        set search_path [split $env(PATH) :]
851       
852        set depregex \^$depregex\$
853       
854        return [_dportsearchpath $depregex $search_path 1]
855}
856
857### _pathtest is private; subject to change without notice
858
859proc _pathtest {dport depspec} {
860    global env
861        set depregex [lindex [split $depspec :] 1]
862        set prefix [_dportkey $dport prefix] 
863   
864        # separate directory from regex
865        set fullname $depregex
866
867        regexp {^(.*)/(.*?)$} "$fullname" match search_path depregex
868
869        if {[string index $search_path 0] != "/"} {
870                # Prepend prefix if not an absolute path
871                set search_path "${prefix}/${search_path}"
872        }
873
874        set depregex \^$depregex\$
875
876        return [_dportsearchpath $depregex $search_path]
877}
878
879### _porttest is private; subject to change without notice
880
881proc _porttest {dport depspec} {
882        # We don't actually look for the port, but just return false
883        # in order to let the dportdepends handle the dependency
884        return 0
885}
886
887### _dportinstalled is private; may change without notice
888
889# Determine if a port is already *installed*, as in "in the registry".
890proc _dportinstalled {dport} {
891        # Check for the presense of the port in the registry
892        set workername [ditem_key $dport workername]
893        set res [$workername eval registry_exists \${portname} \${portversion}]
894        if {$res != 0} {
895                ui_debug "[ditem_key $dport provides] is installed"
896                return 1
897        } else {
898                return 0
899        }
900}
901
902### _dportispresent is private; may change without notice
903
904# Determine if some depspec is satisfied or if the given port is installed.
905# We actually start with the registry (faster?)
906#
907# dport         the port to test (to figure out if it's present)
908# depspec       the dependency test specification (path, bin, lib, etc.)
909proc _dportispresent {dport depspec} {
910        # Check for the presense of the port in the registry
911        set workername [ditem_key $dport workername]
912        ui_debug "Searching for dependency: [ditem_key $dport provides]"
913        if {[catch {set reslist [$workername eval registry_installed \${portname}]} res]} {
914                set res 0
915        } else {
916                set res [llength $reslist]
917        }
918        if {$res != 0} {
919                ui_debug "Found Dependency: receipt exists for [ditem_key $dport provides]"
920                return 1
921        } else {
922                # The receipt test failed, use one of the depspec regex mechanisms
923                ui_debug "Didn't find receipt, going to depspec regex for: [ditem_key $dport provides]"
924                set type [lindex [split $depspec :] 0]
925                switch $type {
926                        lib { return [_libtest $dport $depspec] }
927                        bin { return [_bintest $dport $depspec] }
928                        path { return [_pathtest $dport $depspec] }
929                        port { return [_porttest $dport $depspec] }
930                        default {return -code error "unknown depspec type: $type"}
931                }
932                return 0
933        }
934}
935
936### _dportexec is private; may change without notice
937
938proc _dportexec {target dport} {
939        # xxx: set the work path?
940        set workername [ditem_key $dport workername]
941        if {![catch {$workername eval eval_variants variations $target} result] && $result == 0 &&
942                ![catch {$workername eval eval_targets $target} result] && $result == 0} {
943                # If auto-clean mode, clean-up after dependency install
944                if {[string equal ${darwinports::portautoclean} "yes"]} {
945                        # Make sure we are back in the port path before clean
946                        # otherwise if the current directory had been changed to
947                        # inside the port,  the next port may fail when trying to
948                        # install because [pwd] will return a "no file or directory"
949                        # error since the directory it was in is now gone.
950                        set portpath [ditem_key $dport portpath]
951                        catch {cd $portpath}
952                        $workername eval eval_targets clean
953                }
954                return 0
955        } else {
956                # An error occurred.
957                return 1
958        }
959}
960
961# dportexec
962# Execute the specified target of the given dport.
963
964proc dportexec {dport target} {
965    global darwinports::registry.installtype
966
967        set workername [ditem_key $dport workername]
968
969        # XXX: move this into dportopen?
970        if {[$workername eval eval_variants variations $target] != 0} {
971                return 1
972        }
973       
974        # Before we build the port, we must build its dependencies.
975        # XXX: need a more general way of comparing against targets
976        set dlist {}
977        if {$target == "package"} {
978                ui_warn "package target replaced by pkg target, please use the pkg target in the future."
979                set target "pkg"
980        }
981        if {$target == "configure" || $target == "build"
982                || $target == "destroot" || $target == "install"
983                || $target == "archive"
984                || $target == "pkg" || $target == "mpkg"
985                || $target == "rpmpackage" || $target == "dpkg" } {
986
987                if {[dportdepends $dport $target] != 0} {
988                        return 1
989                }
990               
991                # Select out the dependents along the critical path,
992                # but exclude this dport, we might not be installing it.
993                set dlist [dlist_append_dependents $darwinports::open_dports $dport {}]
994               
995                dlist_delete dlist $dport
996
997                # install them
998                # xxx: as with below, this is ugly.  and deps need to be fixed to
999                # understand Port Images before this can get prettier
1000                if { [string equal ${darwinports::registry.installtype} "image"] } {
1001                        set result [dlist_eval $dlist _dportinstalled [list _dportexec "activate"]]
1002                } else {
1003                        set result [dlist_eval $dlist _dportinstalled [list _dportexec "install"]]
1004                }
1005               
1006                if {$result != {}} {
1007                        set errstring "The following dependencies failed to build:"
1008                        foreach ditem $result {
1009                                append errstring " [ditem_key $ditem provides]"
1010                        }
1011                        ui_error $errstring
1012                        return 1
1013                }
1014               
1015                # Close the dependencies, we're done installing them.
1016                foreach ditem $dlist {
1017                        dportclose $ditem
1018                }
1019        }
1020
1021        # If we're doing an install, check if we should clean after
1022        set clean 0
1023        if {[string equal ${darwinports::portautoclean} "yes"] && [string equal $target "install"] } {
1024                set clean 1
1025        }
1026
1027        # If we're doing image installs, then we should activate after install
1028        # xxx: This isn't pretty
1029        if { [string equal ${darwinports::registry.installtype} "image"] && [string equal $target "install"] } {
1030                set target activate
1031        }
1032       
1033        # Build this port with the specified target
1034        set result [$workername eval eval_targets $target]
1035
1036        # If auto-clean mode and successful install, clean-up after install
1037        if {$result == 0 && $clean == 1} {
1038                # Make sure we are back in the port path, just in case
1039                set portpath [ditem_key $dport portpath]
1040                catch {cd $portpath}
1041                $workername eval eval_targets clean
1042        }
1043
1044        return $result
1045}
1046
1047proc darwinports::getsourcepath {url} {
1048        global darwinports::portdbpath
1049        regsub {://} $url {.} source_path
1050        regsub -all {/} $source_path {_} source_path
1051        return [file join $portdbpath sources $source_path]
1052}
1053
1054proc darwinports::getportbuildpath {id} {
1055        global darwinports::portdbpath
1056        regsub {://} $id {.} port_path
1057        regsub -all {/} $port_path {_} port_path
1058        return [file join $portdbpath build $port_path]
1059}
1060
1061proc darwinports::getindex {source} {
1062        # Special case file:// sources
1063        if {[darwinports::getprotocol $source] == "file"} {
1064                return [file join [darwinports::getportdir $source] PortIndex]
1065        }
1066
1067        return [file join [darwinports::getsourcepath $source] PortIndex]
1068}
1069
1070proc dportsync {args} {
1071        global darwinports::sources darwinports::portdbpath tcl_platform
1072        global darwinports::autoconf::rsync_path
1073
1074        foreach source $sources {
1075                ui_info "Synchronizing from $source"
1076                switch -regexp -- [darwinports::getprotocol $source] {
1077                        {^file$} {
1078                                continue
1079                        }
1080                        {^dports$} {
1081                                darwinports::index::sync $darwinports::portdbpath $source
1082                        }
1083                        {^rsync$} {
1084                                # Where to, boss?
1085                                set destdir [file dirname [darwinports::getindex $source]]
1086
1087                                if {[catch {file mkdir $destdir} result]} {
1088                                        return -code error $result
1089                                }
1090
1091                                # Keep rsync happy with a trailing slash
1092                                if {[string index $source end] != "/"} {
1093                                        set source "${source}/"
1094                                }
1095
1096                                # Do rsync fetch
1097                                if {[catch {system "${darwinports::autoconf::rsync_path} -rtzv --delete-after --delete \"$source\" \"$destdir\""}]} {
1098                                        return -code error "sync failed doing rsync"
1099                                }
1100                                if {[catch {system "chmod -R a+r \"$destdir\""}]} {
1101                                    ui_warn "Setting world read permissions on parts of the ports tree failed, need root?"
1102                                }
1103                        }
1104                        {^https?$|^ftp$} {
1105                                set indexfile [darwinports::getindex $source]
1106                                if {[catch {file mkdir [file dirname $indexfile]} result]} {
1107                                        return -code error $result
1108                                }
1109                                exec curl -L -s -S -o $indexfile $source/PortIndex
1110                        }
1111                }
1112        }
1113}
1114
1115proc dportsearch {pattern {case_sensitive yes} {matchstyle regexp} {field name}} {
1116        global darwinports::portdbpath darwinports::sources
1117        set matches [list]
1118        set easy [expr { $field == "name" }]
1119       
1120        set found 0
1121        foreach source $sources {
1122                if {[darwinports::getprotocol $source] == "dports"} {
1123                        array set attrs [list name $pattern]
1124                        set res [darwinports::index::search $darwinports::portdbpath $source [array get attrs]]
1125                        eval lappend matches $res
1126                } else {
1127                        if {[catch {set fd [open [darwinports::getindex $source] r]} result]} {
1128                                ui_warn "Can't open index file for source: $source"
1129                        } else {
1130                                incr found 1
1131                                while {[gets $fd line] >= 0} {
1132                                        array unset portinfo
1133                                        set name [lindex $line 0]
1134                                        gets $fd line
1135                                       
1136                                        if {$easy} {
1137                                                set target $name
1138                                        } else {
1139                                                array set portinfo $line
1140                                                if {![info exists portinfo($field)]} continue
1141                                                set target $portinfo($field)
1142                                        }
1143                                       
1144                                        switch $matchstyle {
1145                                                exact   { set matchres [expr 0 == ( {$case_sensitive == "yes"} ? [string compare $pattern $target] : [string compare -nocase $pattern $target] )] }
1146                                                glob    { set matchres [expr {$case_sensitive == "yes"} ? [string match $pattern $target] : [string match -nocase $pattern $target]] }
1147                                                regexp  -
1148                                                default { set matchres [expr {$case_sensitive == "yes"} ? [regexp -- $pattern $target] : [regexp -nocase -- $pattern $target]] }
1149                                        }
1150                                       
1151                                        if {$matchres == 1} {
1152                                                if {$easy} {
1153                                                        array set portinfo $line
1154                                                }
1155                                                switch -regexp -- [darwinports::getprotocol ${source}] {
1156                                                        {^rsync$} {
1157                                                                # Rsync files are local
1158                                                                set source_url "file://[darwinports::getsourcepath $source]"
1159                                                        }
1160                                                        default {
1161                                                                set source_url $source
1162                                                        }
1163                                                }
1164                                                if {[info exists portinfo(portarchive)]} {
1165                                                        set porturl ${source_url}/$portinfo(portarchive)
1166                                                } elseif {[info exists portinfo(portdir)]} {
1167                                                        set porturl ${source_url}/$portinfo(portdir)
1168                                                }
1169                                                if {[info exists porturl]} {
1170                                                        lappend line porturl $porturl
1171                                                        ui_debug "Found port in $porturl"
1172                                                } else {
1173                                                        ui_debug "Found port info: $line"
1174                                                }
1175                                                lappend matches $name
1176                                                lappend matches $line
1177                                        }
1178                                }
1179                                close $fd
1180                        }
1181                }
1182        }
1183        if {!$found} {
1184                return -code error "No index(es) found! Have you synced your source indexes?"
1185        }
1186
1187        return $matches
1188}
1189
1190proc dportinfo {dport} {
1191        set workername [ditem_key $dport workername]
1192    return [$workername eval array get PortInfo]
1193}
1194
1195proc dportclose {dport} {
1196        global darwinports::open_dports
1197        set refcnt [ditem_key $dport refcnt]
1198        incr refcnt -1
1199        ditem_key $dport refcnt $refcnt
1200        if {$refcnt == 0} {
1201                dlist_delete darwinports::open_dports $dport
1202                set workername [ditem_key $dport workername]
1203                interp delete $workername
1204        }
1205}
1206
1207##### Private Depspec API #####
1208# This API should be considered work in progress and subject to change without notice.
1209##### "
1210
1211# _dportkey
1212# - returns a variable from the port's interpreter
1213
1214proc _dportkey {dport key} {
1215        set workername [ditem_key $dport workername]
1216        return [$workername eval "return \$${key}"]
1217}
1218
1219# dportdepends builds the list of dports which the given port depends on.
1220# This list is added to $dport.
1221# This list actually depends on the target.
1222# This method can optionally recurse through the dependencies, looking for
1223#   dependencies of dependencies.
1224# This method can optionally cut the search when ports are already installed or
1225#   the dependencies are satisfied.
1226#
1227# dport -> dport item
1228# target -> target to consider the dependency for
1229# recurseDeps -> if the search should be recursive
1230# skipSatisfied -> cut the search tree when encountering installed/satisfied
1231#                  dependencies ports.
1232# accDeps -> accumulator for recursive calls
1233# return 0 if everything was ok, an non zero integer otherwise.
1234proc dportdepends {dport {target ""} {recurseDeps 1} {skipSatisfied 1} {accDeps {}}} {
1235
1236        array set portinfo [dportinfo $dport]
1237        set depends {}
1238        set deptypes {}
1239       
1240        # Determine deptypes to look for based on target
1241        switch $target {
1242                configure       { set deptypes "depends_lib" }
1243               
1244                build           { set deptypes "depends_lib depends_build" }
1245               
1246                destroot        -
1247                install         -
1248                archive         -
1249                pkg                     -
1250                mpkg            -
1251                rpmpackage      -
1252                dpkg            -
1253                ""                      { set deptypes "depends_lib depends_build depends_run" }
1254        }
1255       
1256        # Gather the dependencies for deptypes
1257        foreach deptype $deptypes {
1258                # Add to the list of dependencies if the option exists and isn't empty.
1259                if {[info exists portinfo($deptype)] && $portinfo($deptype) != ""} {
1260                        set depends [concat $depends $portinfo($deptype)]
1261                }
1262        }
1263
1264        set subPorts {}
1265       
1266        foreach depspec $depends {
1267                # grab the portname portion of the depspec
1268                set dep_portname [lindex [split $depspec :] end]
1269               
1270                # Find the porturl
1271                if {[catch {set res [dportsearch $dep_portname false exact]} error]} {
1272                        global errorInfo
1273                        ui_debug "$errorInfo"
1274                        ui_error "Internal error: port search failed: $error"
1275                        return 1
1276                }
1277                foreach {name array} $res {
1278                        array set portinfo $array
1279                        if {[info exists portinfo(porturl)]} {
1280                                set porturl $portinfo(porturl)
1281                                break
1282                        }
1283                }
1284
1285                if {![info exists porturl]} {
1286                        ui_error "Dependency '$dep_portname' not found."
1287                        return 1
1288                }
1289
1290                set options [ditem_key $dport options]
1291                set variations [ditem_key $dport variations]
1292
1293                # Figure out the subport.       
1294                set subport [dportopen $porturl $options $variations]
1295
1296                # Is that dependency satisfied or this port installed?
1297                # If we don't skip or if it is not, add it to the list.
1298                if {!$skipSatisfied || ![_dportispresent $subport $depspec]} {
1299                        # Append the sub-port's provides to the port's requirements list.
1300                        ditem_append_unique $dport requires "[ditem_key $subport provides]"
1301       
1302                        if {$recurseDeps} {
1303                                # Skip the port if it's already in the accumulated list.
1304                                if {[lsearch $accDeps $dep_portname] == -1} {
1305                                        # Add it to the list
1306                                        lappend accDeps $dep_portname
1307                               
1308                                        # We'll recursively iterate on it.
1309                                        lappend subPorts $subport
1310                                }
1311                        }
1312                }
1313        }
1314
1315        # Loop on the subports.
1316        if {$recurseDeps} {
1317                foreach subport $subPorts {
1318                        # Sub ports should be installed (all dependencies must be satisfied).
1319                        set res [dportdepends $subport "" $recurseDeps $skipSatisfied $accDeps]
1320                        if {$res != 0} {
1321                                return $res
1322                        }
1323                }
1324        }
1325       
1326        return 0
1327}
1328
1329# selfupdate procedure
1330proc darwinports::selfupdate {optionslist} {
1331        global darwinports::prefix darwinports::rsync_server darwinports::rsync_dir darwinports::rsync_options
1332        global darwinports::autoconf::rsync_path
1333        array set options $optionslist
1334       
1335        if { [info exists options(ports_force)] && $options(ports_force) == "yes" } {
1336                set use_the_force_luke yes
1337                ui_debug "Forcing a rebuild of the MacPorts base system."
1338        } else {
1339                set use_the_force_luke no
1340                ui_debug "Rebuilding the MacPorts base system if needed."
1341        }
1342        # syncing ports tree. We expect the user have rsync:// in the sources.conf
1343        if {[catch {dportsync} result]} {
1344                return -code error "Couldn't sync dports tree: $result"
1345        }
1346
1347        set dp_base_path [file join $prefix var/db/dports/sources/rsync.${rsync_server}_${rsync_dir}/]
1348        if {![file exists $dp_base_path]} {
1349                file mkdir $dp_base_path
1350        }
1351        ui_debug "MacPorts base dir: $dp_base_path"
1352
1353        # get user of the darwinports system
1354        set user [file attributes [file join $prefix var/db/dports/sources/] -owner]
1355        ui_debug "Setting user: $user"
1356
1357        # get darwinports version
1358        set dp_version_path [file join ${prefix}/etc/ports/ dp_version]
1359        if { [file exists $dp_version_path]} {
1360                set fd [open $dp_version_path r]
1361                gets $fd dp_version_old
1362                close $fd
1363        } else {
1364                set dp_version_old 0
1365        }
1366        ui_msg "DarwinPorts base version $dp_version_old installed"
1367
1368        ui_debug "Updating using rsync"
1369        if { [catch { system "${darwinports::autoconf::rsync_path} $rsync_options rsync://${rsync_server}/${rsync_dir} $dp_base_path" } ] } {
1370                return -code error "Error: rsync failed in selfupdate"
1371        }
1372
1373        # get downloaded darwinports version and write the old version back
1374        set fd [open [file join $dp_base_path config/dp_version] r]
1375        gets $fd dp_version_new
1376        close $fd
1377        ui_msg "Downloaded MacPorts base version $dp_version_new"
1378
1379        # check if we we need to rebuild base
1380        if {$dp_version_new > $dp_version_old || $use_the_force_luke == "yes"} {
1381                ui_msg "Configuring, Building and Installing new MacPorts base"
1382                # check if $prefix/bin/port is writable, if so we go !
1383                # get installation user / group
1384                set owner root
1385                set group admin
1386                if {[file exists [file join $prefix bin/port] ]} {
1387                        # set owner
1388                        set owner [file attributes [file join $prefix bin/port] -owner]
1389                        # set group
1390                        set group [file attributes [file join $prefix bin/port] -group]
1391                }
1392                set p_user [exec /usr/bin/whoami]
1393                if {[file writable ${prefix}/bin/port] || [string equal $p_user $owner] } {
1394                        ui_debug "permissions OK"
1395                } else {
1396                        return -code error "Error: $p_user cannot write to ${prefix}/bin - try using sudo"
1397                }
1398                ui_debug "Setting owner: $owner group: $group"
1399
1400                set dp_tclpackage_path [file join $prefix var/db/dports/ .tclpackage]
1401                if { [file exists $dp_tclpackage_path]} {
1402                        set fd [open $dp_tclpackage_path r]
1403                        gets $fd tclpackage
1404                        close $fd
1405                } else {
1406                        set tclpackage [file join ${prefix} share/darwinports/Tcl]
1407                }
1408                # do the actual installation of new base
1409                ui_debug "Install in: $prefix as $owner : $group - TCL-PACKAGE in $tclpackage"
1410                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] } {
1411                        return -code error "Error installing new MacPorts base: $result"
1412                }
1413        } else {
1414                ui_msg "The MacPorts installation is not outdated and so was not updated"
1415        }
1416
1417        # set the darwinports system to the right owner
1418        ui_debug "Setting ownership to $user"
1419        if { [catch { exec chown -R $user [file join $prefix var/db/dports/sources/] } result] } {
1420                return -code error "Couldn't change permissions: $result"
1421        }
1422
1423        # set the right version
1424        ui_msg "selfupdate done!"
1425
1426        return 0
1427}
1428
1429proc darwinports::version {} {
1430        global darwinports::prefix darwinports::rsync_server darwinports::rsync_dir
1431       
1432        set dp_version_path [file join $prefix etc/ports/ dp_version]
1433
1434        if [file exists $dp_version_path] {
1435                set fd [open $dp_version_path r]
1436                gets $fd retval
1437                return $retval
1438        } else {
1439                return -1
1440        }
1441}
1442
1443# upgrade procedure
1444proc darwinports::upgrade {portname dspec variationslist optionslist {depscachename ""}} {
1445        global darwinports::registry.installtype
1446        global darwinports::portarchivemode
1447        array set options $optionslist
1448        array set variations $variationslist
1449        if {![string match "" $depscachename]} {
1450                upvar $depscachename depscache
1451        } 
1452
1453        # set to no-zero is epoch overrides version
1454        set epoch_override 0
1455
1456        # check if the port is in tree
1457        if {[catch {dportsearch $portname false exact} result]} {
1458                global errorInfo
1459                ui_debug "$errorInfo"
1460                ui_error "port search failed: $result"
1461                return 1
1462        }
1463        # argh! port doesnt exist!
1464        if {$result == ""} {
1465                ui_error "No port $portname found."
1466                return 1
1467        }
1468        # fill array with information
1469        array set portinfo [lindex $result 1]
1470
1471        # set version_in_tree
1472        if {![info exists portinfo(version)]} {
1473                ui_error "Invalid port entry for $portname, missing version"
1474                return 1
1475        }
1476        set version_in_tree "$portinfo(version)_$portinfo(revision)"
1477        set epoch_in_tree "$portinfo(epoch)"
1478
1479        # the depflag tells us if we should follow deps (this is for stuff installed outside DP)
1480        # if this is set (not 0) we dont follow the deps
1481        set depflag 0
1482
1483        # set version_installed
1484        set ilist {}
1485        if { [catch {set ilist [registry::installed $portname ""]} result] } {
1486                if {$result == "Registry error: $portname not registered as installed." } {
1487                        ui_debug "$portname is *not* installed by DarwinPorts"
1488                        # open porthandle   
1489                        set porturl $portinfo(porturl)
1490                    if {![info exists porturl]} {
1491                        set porturl file://./   
1492                        }   
1493                        if {[catch {set workername [dportopen $porturl [array get options] ]} result]} {
1494                                        global errorInfo
1495                                        ui_debug "$errorInfo"
1496                                ui_error "Unable to open port: $result"       
1497                                        return 1
1498                    }
1499
1500                        if {![_dportispresent $workername $dspec ] } {
1501                                # port in not installed - install it!
1502                                if {[catch {set result [dportexec $workername install]} result]} {
1503                                        global errorInfo
1504                                        ui_debug "$errorInfo"
1505                                        ui_error "Unable to exec port: $result"
1506                                        return 1
1507                                }
1508                        } else {
1509                                # port installed outside DP
1510                                ui_debug "$portname installed outside the MacPorts system"
1511                                set depflag 1
1512                        }
1513
1514                } else {
1515                        ui_error "Checking installed version failed: $result"
1516                        exit 1
1517                }
1518        }
1519        set anyactive 0
1520        set version_installed 0
1521        set epoch_installed 0
1522        if {$ilist == ""} {
1523                # XXX  this sets $version_installed to $version_in_tree even if not installed!!
1524                set version_installed $version_in_tree
1525                # That was a very dirty hack showing how ugly our depencendy and upgrade code is.
1526                # To get it working when user provides -f, we also need to set the variant to
1527                # avoid a future failure.
1528                set variant ""
1529        } else {
1530                # a port could be installed but not activated
1531                # so, deactivate all and save newest for activation later
1532                set num 0
1533                set variant ""
1534                foreach i $ilist {
1535                        set variant [lindex $i 3]
1536                        set version "[lindex $i 1]_[lindex $i 2]"
1537                        if { [rpm-vercomp $version $version_installed] > 0} {
1538                                set version_installed $version
1539                                set epoch_installed [registry::property_retrieve [registry::open_entry $portname [lindex $i 1] [lindex $i 2] $variant] epoch]
1540                                set num $i
1541                        }
1542
1543                        set isactive [lindex $i 4]
1544                        if {$isactive == 1 && [rpm-vercomp $version_installed $version] < 0 } {
1545                                # deactivate version
1546                        if {[catch {portimage::deactivate $portname $version $optionslist} result]} {
1547                                        global errorInfo
1548                                        ui_debug "$errorInfo"
1549                        ui_error "Deactivating $portname $version_installed failed: $result"
1550                        return 1
1551                        }
1552                        }
1553                }
1554        if { [lindex $num 4] == 0 && 0 == [string compare "image" ${darwinports::registry.installtype}] } {
1555                        # activate the latest installed version
1556                        if {[catch {portimage::activate $portname $version_installed$variant $optionslist} result]} {
1557                                global errorInfo
1558                                ui_debug "$errorInfo"
1559                        ui_error "Activating $portname $version_installed failed: $result"
1560                                return 1
1561                        }
1562                }
1563        }
1564
1565        # output version numbers
1566        ui_debug "epoch: in tree: $epoch_in_tree installed: $epoch_installed"
1567        ui_debug "$portname $version_in_tree exists in the ports tree"
1568        ui_debug "$portname $version_installed is installed"
1569
1570        # set the nodeps option 
1571        if {![info exists options(ports_nodeps)]} {
1572                set nodeps no
1573        } else {       
1574                set nodeps yes
1575        }
1576
1577        if {$nodeps == "yes" || $depflag == 1} {
1578                ui_debug "Not following dependencies"
1579                set depflag 0
1580        } else {
1581                # build depends is upgraded
1582                if {[info exists portinfo(depends_build)]} {
1583                        foreach i $portinfo(depends_build) {
1584                                if {![llength [array get depscache $i]]} {
1585                                set d [lindex [split $i :] end]
1586                                        set depscache($i) 1
1587                                        upgrade $d $i $variationslist $optionslist depscache
1588                                } 
1589                        }
1590                }
1591                # library depends is upgraded
1592                if {[info exists portinfo(depends_lib)]} {
1593                        foreach i $portinfo(depends_lib) {
1594                                if {![llength [array get depscache $i]]} {
1595                                set d [lindex [split $i :] end]
1596                                        set depscache($i) 1
1597                                        upgrade $d $i $variationslist $optionslist depscache
1598                                } 
1599                        }
1600                }
1601                # runtime depends is upgraded
1602                if {[info exists portinfo(depends_run)]} {
1603                        foreach i $portinfo(depends_run) {
1604                                if {![llength [array get depscache $i]]} {
1605                                set d [lindex [split $i :] end]
1606                                        set depscache($i) 1
1607                                        upgrade $d $i $variationslist $optionslist depscache
1608                                } 
1609                        }
1610                }
1611        }
1612
1613        # check installed version against version in ports
1614        if { [rpm-vercomp $version_installed $version_in_tree] >= 0 && ![info exists options(ports_force)] } {
1615                ui_debug "No need to upgrade! $portname $version_installed >= $portname $version_in_tree"
1616                if { $epoch_installed >= $epoch_in_tree } {
1617                        # Check if we have to do dependents
1618                        if {[info exists options(ports_do_dependents)]} {
1619                                # We do dependents ..
1620                                set options(ports_nodeps) 1
1621
1622                                registry::open_dep_map
1623                                set deplist [registry::list_dependents $portname]
1624
1625                                if { [llength deplist] > 0 } {
1626                                        foreach dep $deplist {
1627                                                set dpname [lindex $dep 2] 
1628                                                darwinports::upgrade $dpname "port:$dpname" [array get variations] [array get options]
1629                                        }
1630                                }
1631                        }
1632
1633                        return 0
1634                } else {
1635                        ui_debug "epoch override ... upgrading!"
1636                        set epoch_override 1
1637                }
1638        }
1639
1640        # open porthandle
1641        set porturl $portinfo(porturl)
1642        if {![info exists porturl]} {
1643                set porturl file://./
1644        }
1645
1646        # check if the variants is present in $version_in_tree
1647        set oldvariant $variant
1648        set variant [split $variant +]
1649        ui_debug "variants to install $variant"
1650        if {[info exists portinfo(variants)]} {
1651                set avariants $portinfo(variants)
1652        } else {
1653                set avariants {}
1654        }
1655        ui_debug "available variants are : $avariants"
1656        foreach v $variant {
1657                if {[lsearch $avariants $v] == -1} {
1658                } else {
1659                        ui_debug "variant $v is present in $portname $version_in_tree"
1660                        set variations($v) "+"
1661                }
1662        }
1663        ui_debug "new portvariants: [array get variations]"
1664       
1665        if {[catch {set workername [dportopen $porturl [array get options] [array get variations]]} result]} {
1666                global errorInfo
1667                ui_debug "$errorInfo"
1668                ui_error "Unable to open port: $result"
1669                return 1
1670        }
1671
1672        # install version_in_tree
1673        if {0 == [string compare "yes" ${darwinports::portarchivemode}]} {
1674                set upgrade_action "unarchive"
1675        } else {
1676                set upgrade_action "destroot"
1677        }
1678
1679        if {[catch {set result [dportexec $workername $upgrade_action]} result] || $result != 0} {
1680                global errorInfo
1681                ui_debug "$errorInfo"
1682                ui_error "Unable to upgrade port: $result"
1683                return 1
1684        }
1685
1686        # uninstall old ports
1687    if {[info exists options(port_uninstall_old)] || $epoch_override == 1 || [info exists options(ports_force)] || 0 != [string compare "image" ${darwinports::registry.installtype}] } {
1688                # uninstall old
1689                ui_debug "Uninstalling $portname $version_installed$oldvariant"
1690                if {[catch {portuninstall::uninstall $portname $version_installed$oldvariant $optionslist} result]} {
1691                        global errorInfo
1692                        ui_debug "$errorInfo"
1693                ui_error "Uninstall $portname $version_installed$oldvariant failed: $result"
1694                return 1
1695        }
1696        } else {
1697                # XXX deactivate version_installed
1698                if {[catch {portimage::deactivate $portname $version_installed$oldvariant $optionslist} result]} {
1699                        global errorInfo
1700                        ui_debug "$errorInfo"
1701                        ui_error "Deactivating $portname $version_installed failed: $result"
1702                        return 1
1703                }
1704        }
1705
1706        if {[catch {set result [dportexec $workername install]} result]} {
1707                global errorInfo
1708                ui_debug "$errorInfo"
1709                ui_error "Couldn't activate $portname $version_in_tree$oldvariant: $result"
1710                return 1
1711        }
1712
1713        # Check if we have to do dependents
1714        if {[info exists options(ports_do_dependents)]} {
1715                # We do dependents ..
1716                set options(ports_nodeps) 1
1717
1718                registry::open_dep_map
1719                set deplist [registry::list_dependents $portname]
1720
1721                if { [llength deplist] > 0 } {
1722                        foreach dep $deplist {
1723                                set dpname [lindex $dep 2] 
1724                                darwinports::upgrade $dpname "port:$dpname" [array get variations] [array get options]
1725                        }
1726                }
1727        }
1728
1729       
1730        # close the port handle
1731        dportclose $workername
1732}
Note: See TracBrowser for help on using the repository browser.