source: trunk/base/src/registry2.0/registry.tcl @ 64641

Last change on this file since 64641 was 64641, checked in by jmr@…, 11 years ago

fix multiple portuninstall namespace confusion

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 15.3 KB
Line 
1# registry.tcl
2#
3# Copyright (c) 2004 Will Barton <wbb4@opendarwin.org>
4# Copyright (c) 2002 Apple Computer, Inc.
5# All rights reserved.
6#
7# Redistribution and use in source and binary forms, with or without
8# modification, are permitted provided that the following conditions
9# are met:
10# 1. Redistributions of source code must retain the above copyright
11#    notice, this list of conditions and the following disclaimer.
12# 2. Redistributions in binary form must reproduce the above copyright
13#    notice, this list of conditions and the following disclaimer in the
14#    documentation and/or other materials provided with the distribution.
15# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
16#    may be used to endorse or promote products derived from this software
17#    without specific prior written permission.
18#
19# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
20# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
21# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
22# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
23# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
24# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
25# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
26# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
27# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
28# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
29# POSSIBILITY OF SUCH DAMAGE.
30#
31
32package provide registry 1.0
33
34package require macports 1.0
35package require receipt_flat 1.0
36package require receipt_sqlite 1.0
37package require portimage 2.0
38package require registry_uninstall 2.0
39package require msgcat
40
41namespace eval registry {
42
43# Begin creating a new registry entry for the port version_revision+variant
44# This process assembles the directory name and creates a receipt dlist
45proc new_entry {name version {revision 0} {variants ""} {epoch 0} } {
46        global macports::registry.path macports::registry.format macports::registry.installtype macports::prefix
47
48       
49        # Make sure we don't already have an entry in the Registry for this
50        # port version_revision+variants
51        if {![entry_exists $name $version $revision $variants] } {
52
53                set ref [${macports::registry.format}::new_entry]
54
55                property_store $ref name $name
56                property_store $ref version $version
57                property_store $ref revision $revision
58                property_store $ref variants $variants
59                property_store $ref epoch $epoch
60                # Trick to have a portable GMT-POSIX epoch-based time.
61                # (because we'll compare this with a file mtime).
62                property_store $ref date [expr [clock scan now -gmt true] - [clock scan "1970-1-1 00:00:00" -gmt true]]
63                property_store $ref installtype ${macports::registry.installtype}
64                property_store $ref receipt_f ${macports::registry.format}
65                if { ${macports::registry.installtype} == "image" } {
66                        set imagedir [file join ${macports::registry.path} software ${name} ${version}_${revision}${variants}]
67                        property_store $ref imagedir $imagedir
68                        property_store $ref active 0
69                }
70
71                return $ref
72        } else {
73                return -code error "Registry error: ${name} @${version}_${revision}${variants} already registered as installed.  Please uninstall it first."
74        }
75}
76
77# Check to see if an entry exists in the registry.  This is passed straight
78# through to the receipts system
79proc entry_exists {name version {revision 0} {variants ""}} {
80        global macports::registry.format
81        return [${macports::registry.format}::entry_exists $name $version $revision $variants] 
82}
83
84# Check to see if any entry exists in the registry for the given port name.
85proc entry_exists_for_name {name} {
86        global macports::registry.format
87        return [${macports::registry.format}::entry_exists_for_name $name]
88}
89
90# Close the registry... basically wrap the receipts systems's write process
91proc write_entry {ref} {
92        global macports::registry.format
93       
94        set name [property_retrieve $ref name]
95        set version [property_retrieve $ref version]
96        set revision [property_retrieve $ref revision]
97        set variants [property_retrieve $ref variants]
98        set epoch [property_retrieve $ref epoch]
99        set contents [property_retrieve $ref contents]
100
101        ${macports::registry.format}::write_entry $ref $name $version $revision $variants
102
103}
104
105# Delete an entry from the registry.
106proc delete_entry {ref} {
107        global macports::registry.format
108       
109        set name [property_retrieve $ref name]
110        set version [property_retrieve $ref version]
111        set revision [property_retrieve $ref revision]
112        set variants [property_retrieve $ref variants]
113       
114        ${macports::registry.format}::delete_entry $name $version $revision $variants
115       
116}
117
118# Open a registry entry.
119proc open_entry {name {version ""} {revision 0} {variants ""} {epoch ""}} {
120        global macports::registry.format
121
122        return [${macports::registry.format}::open_entry $name $version $revision $variants $epoch]
123
124}
125
126# Store a property with the open registry entry.
127proc property_store {ref property value} {
128        global macports::registry.format
129        ${macports::registry.format}::property_store $ref $property $value
130}
131
132# Retrieve a property from the open registry entry.
133proc property_retrieve {ref property} {
134        global macports::registry.format
135        return [${macports::registry.format}::property_retrieve $ref $property]
136}
137
138# If only one version of the port is installed, this process returns that
139# version's parts.  Otherwise, it lists the versions installed and exists.
140proc installed {{name ""} {version ""}} {
141        global macports::registry.format
142
143    if {${macports::registry.format} == "receipt_flat"} {
144        set ilist [${macports::registry.format}::installed $name $version]
145        set rlist [list]
146   
147        foreach installed $ilist {
148            set iname [lindex $installed 0]
149            set iversion [lindex $installed 1]
150            set irevision [lindex $installed 2]
151            set ivariants [lindex $installed 3]
152            set iref [open_entry $iname $iversion $irevision $ivariants]
153            set iactive [property_retrieve $iref active]
154            set iepoch [property_retrieve $iref epoch]
155            lappend rlist [list $iname $iversion $irevision $ivariants $iactive $iepoch]
156        }
157    } else {
158        set rlist [${macports::registry.format}::installed $name $version]
159    }
160   
161    if { [llength $rlist] < 1 } {
162        if { $name == "" } {
163            return -code error "Registry error: No ports registered as installed."
164        } else {
165            if { $version == "" } {
166                return -code error "Registry error: $name not registered as installed."
167            } else {
168                return -code error "Registry error: $name $version not registered as installed."
169            }
170        }
171    }
172   
173        return $rlist
174}
175
176# Return a list with the active version of a port (or the active versions of
177# all ports if name is "").
178proc active {{name ""}} {
179        global macports::registry.format
180   
181    if {${macports::registry.format} == "receipt_flat"} {
182        set rlist [list]
183        set ilist [${macports::registry.format}::installed $name]
184   
185        foreach installed $ilist {
186            set iname [lindex $installed 0]
187            set iversion [lindex $installed 1]
188            set irevision [lindex $installed 2]
189            set ivariants [lindex $installed 3]
190            set iref [open_entry $iname $iversion $irevision $ivariants]
191            set iactive [property_retrieve $iref active]
192            set iepoch [property_retrieve $iref epoch]
193            if {$iactive} {
194                lappend rlist [list $iname $iversion $irevision $ivariants $iactive $iepoch]
195            }
196        }
197    } else {
198        set rlist [${macports::registry.format}::active $name]
199    }
200       
201        if { [llength $rlist] < 1 } {
202                if { $name == "" } {
203                        return -code error "Registry error: No ports registered as active."
204                } else {
205                        return -code error "Registry error: $name not registered as installed & active."
206                }
207        }
208        return $rlist
209}
210
211proc location {portname portversion} {
212        set ilist [registry::installed $portname $portversion]
213
214        if { [llength $ilist] > 1 } {
215                puts "The following versions of $portname are currently installed:"
216                foreach i $ilist { 
217                        set iname [lindex $i 0]
218                        set iversion [lindex $i 1]
219                        set irevision [lindex $i 2]
220                        set ivariants [lindex $i 3]
221                        set iactive [lindex $i 4]
222                        if { $iactive == 0 } {
223                                puts "  $iname @${iversion}_${irevision}${ivariants}"
224                        } elseif { $iactive == 1 } {
225                                puts "  $iname @${iversion}_${irevision}${ivariants} (active)"
226                        }
227                }
228                return -1
229        } else {
230                return [lindex $ilist 0]
231        }
232}       
233
234
235# File Map Code
236proc open_file_map {args} {
237        global macports::registry.format
238        return [${macports::registry.format}::open_file_map $args]
239}
240
241proc file_registered {file} {
242        global macports::registry.format
243        return [${macports::registry.format}::file_registered $file]
244}
245
246proc port_registered {name} {
247        global macports::registry.format
248        return [${macports::registry.format}::port_registered $name]
249}
250
251proc register_file {file port} {
252        global macports::registry.format
253        return [${macports::registry.format}::register_file $file $port]
254}
255
256proc register_bulk_files {files port} {
257        global macports::registry.format
258        open_file_map
259        set r [${macports::registry.format}::register_bulk_files $files $port]
260        write_file_map
261        close_file_map
262        return $r
263}
264
265proc unregister_file {file} {
266        global macports::registry.format
267        return [${macports::registry.format}::unregister_file $file]
268}
269
270proc write_file_map {args} {
271        global macports::registry.format
272        return [${macports::registry.format}::write_file_map $args]
273}
274
275proc close_file_map {args} {
276        global macports::registry.format
277        return [${macports::registry.format}::close_file_map $args]
278}
279
280# Dependency Map Code
281proc register_dependencies {deps name} {
282
283        open_dep_map
284        foreach dep $deps {
285                # We expect the form type:regexp:port to come in, but we don't need to
286                # store it that way in the dep map.
287                set type [lindex [split $dep :] 0]
288                set depport [lindex [split $dep :] end]
289                register_dep $depport $type $name
290        }
291        write_dep_map
292}
293
294proc unregister_dependencies {name} {
295
296        open_dep_map
297        foreach dep [list_depends $name] {
298                unregister_dep [lindex $dep 0] [lindex $dep 1] [lindex $dep 2]
299        }
300        write_dep_map
301}
302
303proc open_dep_map {args} {
304        global macports::registry.format
305        return [${macports::registry.format}::open_dep_map $args]
306}
307
308##
309#
310# From a file name, return a list representing data currently known about the file.
311# This list is a 6-tuple of the form:
312# 0: file path
313# 1: uid
314# 2: gid
315# 3: mode
316# 4: size
317# 5: md5 checksum information
318#
319# fname         a path to a given file.
320# return a 6-tuple about this file.
321proc fileinfo_for_file {fname} {
322    # Add the link to the registry, not the actual file.
323    # (we won't store the md5 of the target of links since it's meaningless
324    # and $statvar(mode) tells us that links are links).
325    if {![catch {file lstat $fname statvar}]} {
326        if {[file isfile $fname] && [file type $fname] != "link"} {
327            if {[catch {md5 file $fname} md5sum] == 0} {
328                # Create a line that matches md5(1)'s output
329                # for backwards compatibility
330                set line "MD5 ($fname) = $md5sum"
331                return [list $fname $statvar(uid) $statvar(gid) $statvar(mode) $statvar(size) $line]
332            }
333        } else {
334            return  [list $fname $statvar(uid) $statvar(gid) $statvar(mode) $statvar(size) "MD5 ($fname) NONE"]
335        }
336    }
337    return {}
338}
339
340##
341#
342# From a list of files, return a list of information concerning these files.
343# The information is obtained through fileinfo_for_file.
344#
345# flist         the list of file to get information about.
346# return a list of 6-tuples described in fileinfo_for_file.
347proc fileinfo_for_index {flist} {
348        global prefix
349
350        set rval [list]
351        foreach file $flist {
352                if {[string index $file 0] != "/"} {
353                        set file [file join $prefix $file]
354                }
355                lappend rval [fileinfo_for_file $file]
356        }
357        return $rval
358}
359
360# List all ports this one depends on
361proc list_depends {name} {
362        global macports::registry.format
363        return [${macports::registry.format}::list_depends $name]
364}
365
366# List all the ports that depend on this port
367proc list_dependents {name {version ""} {revision ""} {variants ""}} {
368        global macports::registry.format
369        return [${macports::registry.format}::list_dependents $name $version $revision $variants]
370}
371
372proc register_dep {dep type port} {
373        global macports::registry.format
374        return [${macports::registry.format}::register_dep $dep $type $port]
375}
376
377proc unregister_dep {dep type port} {
378        global macports::registry.format
379        return [${macports::registry.format}::unregister_dep $dep $type $port]
380}
381
382proc clean_dep_map {args} {
383    global macports::registry.format
384    return [${macports::registry.format}::clean_dep_map $args]
385}
386
387proc write_dep_map {args} {
388        global macports::registry.format
389        return [${macports::registry.format}::write_dep_map $args]
390}
391
392# upgrade flat receipts to registry2.0 sqlite db
393proc convert_to_sqlite {} {
394    set ilist [receipt_flat::installed "" ""]
395
396    foreach installed $ilist {
397        set iname [lindex $installed 0]
398        set iversion [lindex $installed 1]
399        set irevision [lindex $installed 2]
400        set ivariants [lindex $installed 3]
401        set proplist [list name $iname version $iversion revision $irevision variants $ivariants]
402
403        set iref [receipt_flat::open_entry $iname $iversion $irevision $ivariants]
404
405        lappend proplist date [receipt_flat::property_retrieve $iref date]
406        lappend proplist epoch [receipt_flat::property_retrieve $iref epoch]
407        lappend proplist negated_variants [receipt_flat::property_retrieve $iref negated_variants]
408        lappend proplist requested [receipt_flat::property_retrieve $iref requested]
409        lappend proplist os_platform [receipt_flat::property_retrieve $iref os_platform]
410        lappend proplist os_major [receipt_flat::property_retrieve $iref os_major]
411        lappend proplist archs [receipt_flat::property_retrieve $iref archs]
412
413        set installtype [receipt_flat::property_retrieve $iref installtype]
414        lappend proplist installtype $installtype
415        if { $installtype == "image" } {
416            set imagedir [receipt_flat::property_retrieve $iref imagedir]
417            set contents [receipt_flat::property_retrieve $iref contents]
418            set imagefiles [list]
419            set idlen [string length $imagedir]
420            foreach f $contents {
421                set fullpath [lindex $f 0]
422                # strip image dir from start
423                set path [string range $fullpath $idlen [string length $fullpath]]
424                lappend imagefiles $path
425            }
426            lappend proplist imagefiles $imagefiles
427            set active [receipt_flat::property_retrieve $iref active]
428            if {$active} {
429                set state installed
430                lappend proplist files [receipt_flat::port_registered $iname]
431            } else {
432                set state imaged
433            }
434        } else {
435            set imagedir ""
436            set state installed
437            lappend proplist files [receipt_flat::port_registered $iname]
438        }
439        lappend proplist location $imagedir
440        lappend proplist state $state
441       
442        receipt_flat::open_dep_map
443        set deplist [receipt_flat::list_depends $iname]
444        set depnames [list]
445        foreach dep $deplist {
446            lappend depnames [lindex $dep 0]
447        }
448        lappend proplist depends $depnames
449       
450        lappend proplist portfile ""
451       
452        # add the entry to the db
453        receipt_sqlite::create_entry_l $proplist
454    }
455}
456
457# End of registry namespace
458}
Note: See TracBrowser for help on using the repository browser.