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

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

Add a global switch in ports.conf which controls what kind of startupitem
will be generated by default. This may be overridden in particular portfiles
by the startupitem.type key. Legal values are "default", "systemstarter", or "launchd".
In the event of "default", a type appropriate to the platform will be chosen.

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