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

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

Add some http proxy variables to those not to sanitize from the DP environment.
Also add a new ports.conf variable, extra_env, which can be used to specify
additional environment to not sanitize.

Bug: 5648
Submitted by: Kogule Ryo
Reviewed by: jberry@
Approved by: jberry@
Obtained from:

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