source: trunk/base/src/registry2.0/portimage.tcl @ 64292

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

reg2 updates, including fix for deadlock during install

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 29.6 KB
Line 
1# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:ft=tcl:et:sw=4:ts=4:sts=4
2# portimage.tcl
3# $Id: portimage.tcl 64292 2010-02-28 20:13:29Z jmr@macports.org $
4#
5# Copyright (c) 2004 Will Barton <wbb4@opendarwin.org>
6# Copyright (c) 2002 Apple Inc.
7# All rights reserved.
8#
9# Redistribution and use in source and binary forms, with or without
10# modification, are permitted provided that the following conditions
11# are met:
12# 1. Redistributions of source code must retain the above copyright
13#    notice, this list of conditions and the following disclaimer.
14# 2. Redistributions in binary form must reproduce the above copyright
15#    notice, this list of conditions and the following disclaimer in the
16#    documentation and/or other materials provided with the distribution.
17# 3. Neither the name of Apple Inc. nor the names of its contributors
18#    may be used to endorse or promote products derived from this software
19#    without specific prior written permission.
20#
21# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
22# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
23# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
25# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
26# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
27# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
28# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
29# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
30# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31# POSSIBILITY OF SUCH DAMAGE.
32#
33
34package provide portimage 2.0
35
36package require registry 1.0
37package require registry2 2.0
38package require registry_util 2.0
39package require macports 1.0
40package require Pextlib 1.0
41
42set UI_PREFIX "--> "
43
44#
45# Port Images are basically just installations of the destroot of a port into
46# ${macports::registry.path}/software/${name}/${version}_${revision}${variants}
47# They allow the user to install multiple versions of the same port, treating
48# each revision and each different combination of variants as a "version".
49#
50# From there, the user can "activate" a port image.  This creates {sym,hard}links for
51# all files in the image into the ${prefix}.  Directories are created.
52# Activation checks the registry's file_map for any files which conflict with
53# other "active" ports, and will not overwrite the links to the those files.
54# The conflicting port must be deactivated first.
55#
56# The user can also "deactivate" an active port.  This will remove all {sym,hard}links
57# from ${prefix}, and if any directories are empty, remove them as well.  It
58# will also remove all of the references of the files from the registry's
59# file_map
60#
61# For the creating and removing of links during activation and deactivation,
62# code very similar to what is used in portinstall is used.
63#
64
65namespace eval portimage {
66
67variable force 0
68variable use_reg2 0
69
70# Activate a "Port Image"
71proc activate {name v optionslist} {
72    global macports::prefix macports::registry.format macports::registry.path registry_open UI_PREFIX
73    array set options $optionslist
74    variable force
75    variable use_reg2
76
77    if {[info exists options(ports_force)] && [string is true -strict $options(ports_force)] } {
78        set force 1
79    }
80    if {[string equal ${macports::registry.format} "receipt_sqlite"]} {
81        set use_reg2 1
82        if {![info exists registry_open]} {
83            registry::open [file join ${macports::registry.path} registry registry.db]
84            set registry_open yes
85        }
86    }
87    set todeactivate [list]
88
89    if {$use_reg2} {
90        registry::read {
91
92            set requested [_check_registry $name $v]
93            # set name again since the one we were passed may not have had the correct case
94            set name [$requested name]
95            set version [$requested version]
96            set revision [$requested revision]
97            set variants [$requested variants]
98            set specifier "${version}_${revision}${variants}"
99
100            # if another version of this port is active, deactivate it first
101            set current [registry::entry installed $name]
102            if { [llength $current] > 1 } {
103                foreach i $current {
104                    set iversion [$i version]
105                    set irevision [$i revision]
106                    set ivariants [$i variants]
107                    set ispecifier "${iversion}_${irevision}${ivariants}"
108                    if { ![string equal $specifier $ispecifier]
109                            && [string equal [$i state] "installed"] } {
110                        lappend todeactivate $ispecifier
111                    }
112                }
113            }
114
115            # this shouldn't be possible
116            if { ![string equal [$requested installtype] "image"] } {
117                return -code error "Image error: ${name} @${version}_${revision}${variants} not installed as an image."
118            }
119
120            if { [string equal [$requested state] "installed"] } {
121                return -code error "Image error: ${name} @${version}_${revision}${variants} is already active."
122            }
123        }
124    } else {
125        # registry1.0
126        set ilist [_check_registry $name $v]
127        # set name again since the one we were passed may not have had the correct case
128        set name [lindex $ilist 0]
129        set version [lindex $ilist 1]
130        set revision [lindex $ilist 2]
131        set variants [lindex $ilist 3]
132
133        # if another version of this port is active, deactivate it first
134        set ilist [registry::installed $name]
135        if { [llength $ilist] > 1 } {
136            foreach i $ilist {
137                set iversion [lindex $i 1]
138                set irevision [lindex $i 2]
139                set ivariants [lindex $i 3]
140                set iactive [lindex $i 4]
141                if { ![string equal "${iversion}_${irevision}${ivariants}" "${version}_${revision}${variants}"] && $iactive == 1 } {
142                    lappend todeactivate "${iversion}_${irevision}${ivariants}"
143                }
144            }
145        }
146
147        set ref [registry::open_entry $name $version $revision $variants]
148
149        if { ![string equal [registry::property_retrieve $ref installtype] "image"] } {
150            return -code error "Image error: ${name} @${version}_${revision}${variants} not installed as an image."
151        }
152        if { [registry::property_retrieve $ref active] != 0 } {
153            return -code error "Image error: ${name} @${version}_${revision}${variants} is already active."
154        }
155    }
156
157    foreach a $todeactivate {
158        deactivate $name $a [list ports_force 1]
159    }
160
161    if {$v != ""} {
162        ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s @%s"] $name $v]"
163    } else {
164        ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s"] $name]"
165    }
166
167    if {$use_reg2} {
168        _activate_contents $requested
169        $requested state installed
170    } else {
171        set imagedir [registry::property_retrieve $ref imagedir]
172
173        set contents [registry::property_retrieve $ref contents]
174
175        set imagefiles [_check_contents $name $contents $imagedir]
176
177        registry::open_file_map
178        _activate_contents $name $imagefiles $imagedir
179
180        registry::property_store $ref active 1
181
182        registry::write_entry $ref
183
184        foreach file $imagefiles {
185            registry::register_file $file $name
186        }
187        registry::write_file_map
188        registry::close_file_map
189    }
190}
191
192proc deactivate {name v optionslist} {
193    global UI_PREFIX macports::registry.format macports::registry.path registry_open
194    array set options $optionslist
195    variable use_reg2
196
197    if {[info exists options(ports_force)] && [string is true -strict $options(ports_force)] } {
198        # this not using the namespace variable is correct, since activate
199        # needs to be able to force deactivate independently of whether
200        # the activation is being forced
201        set force 1
202    } else {
203        set force 0
204    }
205    if {[string equal ${macports::registry.format} "receipt_sqlite"]} {
206        set use_reg2 1
207        if {![info exists registry_open]} {
208            registry::open [file join ${macports::registry.path} registry registry.db]
209            set registry_open yes
210        }
211    }
212
213    if {$use_reg2} {
214        if { [string equal $name ""] } {
215            throw registry::image-error "Registry error: Please specify the name of the port."
216        }
217        set ilist [registry::entry installed $name]
218        if { [llength $ilist] == 1 } {
219            set requested [lindex $ilist 0]
220        } else {
221            throw registry::image-error "Image error: port ${name} is not active."
222        }
223        # set name again since the one we were passed may not have had the correct case
224        set name [$requested name]
225        set version [$requested version]
226        set revision [$requested revision]
227        set variants [$requested variants]
228        set specifier "${version}_${revision}${variants}"
229    } else {
230        set ilist [registry::active $name]
231        if { [llength $ilist] > 1 } {
232            return -code error "Registry error: Please specify the name of the port."
233        } else {
234            set ilist [lindex $ilist 0]
235        }
236        # set name again since the one we were passed may not have had the correct case
237        set name [lindex $ilist 0]
238        set version [lindex $ilist 1]
239        set revision [lindex $ilist 2]
240        set variants [lindex $ilist 3]
241        set specifier "${version}_${revision}${variants}"
242    }
243
244    if { $v != "" && ![string equal $specifier $v] } {
245        return -code error "Active version of $name is not $v but ${specifier}."
246    }
247
248    if {$v != ""} {
249        ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $v]"
250    } else {
251        ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s"] $name]"
252    }
253
254    if {$use_reg2} {
255        if { ![string equal [$requested installtype] "image"] } {
256            return -code error "Image error: ${name} @${specifier} not installed as an image."
257        }
258        # this shouldn't be possible
259        if { [$requested state] != "installed" } {
260            return -code error "Image error: ${name} @${specifier} is not active."
261        }
262
263        registry::check_dependents $requested $force
264
265        _deactivate_contents $requested {} $force
266        $requested state imaged
267    } else {
268        set ref [registry::open_entry $name $version $revision $variants]
269
270        if { ![string equal [registry::property_retrieve $ref installtype] "image"] } {
271            return -code error "Image error: ${name} @${specifier} not installed as an image."
272        }
273        if { [registry::property_retrieve $ref active] != 1 } {
274            return -code error "Image error: ${name} @${specifier} is not active."
275        }
276
277        registry::open_file_map
278        set imagefiles [registry::port_registered $name]
279
280        _deactivate_contents $name $imagefiles
281
282        foreach file $imagefiles {
283            registry::unregister_file $file
284        }
285        registry::write_file_map
286        registry::close_file_map
287
288        registry::property_store $ref active 0
289
290        registry::write_entry $ref
291    }
292}
293
294proc _check_registry {name v} {
295    global UI_PREFIX macports::registry.installtype
296    variable use_reg2
297
298    if {$use_reg2} {
299        if { [registry::decode_spec $v version revision variants] } {
300            set ilist [registry::entry imaged $name $version $revision $variants]
301            set valid 1
302        } else {
303            set valid [string equal $v {}]
304            set ilist [registry::entry imaged $name]
305        }
306
307        if { [llength $ilist] > 1 || (!$valid && [llength $ilist] == 1) } {
308            ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $name are currently installed:"]"
309            foreach i $ilist {
310                set iname [$i name]
311                set iversion [$i version]
312                set irevision [$i revision]
313                set ivariants [$i variants]
314                if { [$i state] == "installed" } {
315                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s (active)"] $iname $iversion $irevision $ivariants]"
316                } else {
317                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s"] $iname $iversion $irevision $ivariants]"
318                }
319            }
320            if { $valid } {
321                throw registry::invalid "Registry error: Please specify the full version as recorded in the port registry."
322            } else {
323                throw registry::invalid "Registry error: Invalid version specified. Please specify a version as recorded in the port registry."
324            }
325        } elseif { [llength $ilist] == 1 } {
326            return [lindex $ilist 0]
327        }
328        throw registry::invalid "Registry error: No port of $name installed."
329    } else {
330        # registry1.0
331        set ilist [registry::installed $name $v]
332        if { [string equal $v ""] && [llength $ilist] > 1 } {
333            # set name again since the one we were passed may not have had the correct case
334            set name [lindex [lindex $ilist 0] 0]
335            ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $name are currently installed:"]"
336            foreach i $ilist { 
337                set iname [lindex $i 0]
338                set iversion [lindex $i 1]
339                set irevision [lindex $i 2]
340                set ivariants [lindex $i 3]
341                set iactive [lindex $i 4]
342                if { $iactive == 0 } {
343                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s"] $iname $iversion $irevision $ivariants]"
344                } elseif { $iactive == 1 } {
345                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s (active)"] $iname $iversion $irevision $ivariants]"
346                }
347            }
348            return -code error "Registry error: Please specify the full version as recorded in the port registry."
349        } elseif {[llength $ilist] == 1} {
350            return [lindex $ilist 0]
351        }
352        return -code error "Registry error: No port of $name installed."
353    }
354}
355
356proc _check_contents {name contents imagedir} {
357
358    set imagefiles [list]
359    set idlen [string length $imagedir]
360
361    # generate list of activated file paths from list of paths in the image dir
362    foreach fe $contents {
363        set srcfile [lindex $fe 0]
364        if { ![string equal $srcfile ""] && [file type $srcfile] != "directory" } {
365            set file [string range $srcfile $idlen [string length $srcfile]]
366
367            lappend imagefiles $file
368        }
369    }
370
371    return $imagefiles
372}
373
374## Activates a file from an image into the filesystem. Deals with symlinks,
375## directories and files.
376##
377## @param [in] srcfile path to file in image
378## @param [in] dstfile path to activate file to
379proc _activate_file {srcfile dstfile} {
380    switch [file type $srcfile] {
381        link {
382            ui_debug "activating link: $dstfile"
383            file copy -force -- $srcfile $dstfile
384        }
385        directory {
386            # Don't recursively copy directories
387            ui_debug "activating directory: $dstfile"
388            # Don't do anything if the directory already exists.
389            if { ![file isdirectory $dstfile] } {
390                file mkdir $dstfile
391                # fix attributes on the directory.
392                eval file attributes {$dstfile} [file attributes $srcfile]
393                # set mtime on installed element
394                file mtime $dstfile [file mtime $srcfile]
395            }
396        }
397        default {
398            ui_debug "activating file: $dstfile"
399            # Try a hard link first and if that fails, a symlink
400            if {[catch {file link -hard $dstfile $srcfile}]} {
401                ui_debug "hardlinking $srcfile to $dstfile failed, symlinking instead"
402                file link -symbolic $dstfile $srcfile
403            }
404        }
405    }
406}
407
408## Activates the contents of a port
409proc _activate_contents {port {imagefiles {}} {imagedir {}}} {
410    variable force
411    variable use_reg2
412    global macports::prefix
413
414    set files [list]
415    set baksuffix .mp_[clock seconds]
416    if {$use_reg2} {
417        set imagedir [$port location]
418        set imagefiles [$port imagefiles]
419    } else {
420        set name $port
421    }
422
423    set deactivated [list]
424    set backups [list]
425    # This is big and hairy and probably could be done better.
426    # First, we need to check the source file, make sure it exists
427    # Then we remove the $imagedir from the path of the file in the contents
428    #  list  and check to see if that file exists
429    # Last, if the file exists, and belongs to another port, and force is set
430    #  we remove the file from the file_map, take ownership of it, and
431    #  clobber it
432    if {$use_reg2} {
433        try {
434            registry::write {
435                foreach file $imagefiles {
436                    set srcfile "${imagedir}${file}"
437
438                    # To be able to install links, we test if we can lstat the file to
439                    # figure out if the source file exists (file exists will return
440                    # false for symlinks on files that do not exist)
441                    if { [catch {file lstat $srcfile dummystatvar}] } {
442                        throw registry::image-error "Image error: Source file $srcfile does not appear to exist (cannot lstat it).  Unable to activate port [$port name]."
443                    }
444
445                    set owner [registry::entry owner $file]
446
447                    if {$owner != {} && $owner != $port} {
448                        # deactivate conflicting port if it is replaced_by this one
449                        set result [mportlookup [$owner name]]
450                        array unset portinfo
451                        array set portinfo [lindex $result 1]
452                        if {[info exists portinfo(replaced_by)] && [lsearch -exact -nocase $portinfo(replaced_by) [$port name]] != -1} {
453                            lappend deactivated $owner
454                            # XXX this is bad, deactivate does another write transaction (probably deadlocks)
455                            deactivate [$owner name] "" ""
456                            set owner {}
457                        }
458                    }
459
460                    if { [string is true -strict $force] } {
461                        # if we're forcing the activation, then we move any existing
462                        # files to a backup file, both in the filesystem and in the
463                        # registry
464                        if { [file exists $file] } {
465                            set bakfile "${file}${baksuffix}"
466                            ui_warn "File $file already exists.  Moving to: $bakfile."
467                            file rename -force -- $file $bakfile
468                            lappend backups $file
469                        }
470                        if { $owner != {} } {
471                            $owner deactivate [list $file]
472                            $owner activate [list $file] [list "${file}${baksuffix}"]
473                        }
474                    } else {
475                        # if we're not forcing the activation, then we bail out if
476                        # we find any files that already exist, or have entries in
477                        # the registry
478                        if { $owner != {} && $owner != $port } {
479                            throw registry::image-error "Image error: $file is being used by the active [$owner name] port.  Please deactivate this port first, or use 'port -f activate [$port name]' to force the activation."
480                        } elseif { $owner == {} && [file exists $file] } {
481                            throw registry::image-error "Image error: $file already exists and does not belong to a registered port.  Unable to activate port [$port name]. Use 'port -f activate [$port name]' to force the activation."
482                        }
483                    }
484
485                    # Split out the filename's subpaths and add them to the
486                    # imagefile list.
487                    # We need directories first to make sure they will be there
488                    # before links. However, because file mkdir creates all parent
489                    # directories, we don't need to have them sorted from root to
490                    # subpaths. We do need, nevertheless, all sub paths to make sure
491                    # we'll set the directory attributes properly for all
492                    # directories.
493                    set directory [file dirname $file]
494                    while { [lsearch -exact $files $directory] == -1 } {
495                        lappend files $directory
496                        set directory [file dirname $directory]
497                    }
498
499                    # Also add the filename to the imagefile list.
500                    lappend files $file
501                }
502
503                # Sort the list in forward order, removing duplicates.
504                # Since the list is sorted in forward order, we're sure that
505                # directories are before their elements.
506                # We don't have to do this as mentioned above, but it makes the
507                # debug output of activate make more sense.
508                set theList [lsort -increasing -unique $files]
509
510                # Activate it, and catch errors so we can roll-back
511                try {
512                    $port activate $imagefiles
513                    foreach file $theList {
514                        _activate_file "${imagedir}${file}" $file
515                    }
516                } catch {*} {
517                    ui_debug "Activation failed, rolling back."
518                    # can't do it here since we're already inside a transaction
519                    set deactivate_this yes
520                    throw
521                }
522            }
523        } catch {*} {
524            # roll back activation of this port
525            if {[info exists deactivate_this]} {
526                _deactivate_contents $port {} yes
527            }
528            # if any errors occurred, move backed-up files back to their original
529            # locations, then rethrow the error. Transaction rollback will take care
530            # of this in the registry.
531            foreach file $backups {
532                file rename -force -- "${file}${baksuffix}" $file
533            }
534            # reactivate deactivated ports
535            foreach entry $deactivated {
536                set pvers "[$entry version]_[$entry revision][$entry variants]"
537                activate [$entry name] $pvers ""
538            }
539            throw
540        }
541    } else {
542        # registry1.0
543        foreach file $imagefiles {
544            set srcfile "${imagedir}${file}"
545
546            # To be able to install links, we test if we can lstat the file to
547            # figure out if the source file exists (file exists will return
548            # false for symlinks on files that do not exist)
549            if { [catch {file lstat $srcfile dummystatvar}] } {
550                return -code error "Image error: Source file $srcfile does not appear to exist (cannot lstat it).  Unable to activate port $name."
551            }
552
553            set port [registry::file_registered $file]
554           
555            if {$port != 0  && $port != $name} {
556                # deactivate conflicting port if it is replaced_by this one
557                if {[catch {mportlookup $port} result]} {
558                    global errorInfo
559                    ui_debug "$errorInfo"
560                    return -code error "port lookup failed: $result"
561                }
562                array unset portinfo
563                array set portinfo [lindex $result 1]
564                if {[info exists portinfo(replaced_by)] && [lsearch -exact -nocase $portinfo(replaced_by) $name] != -1} {
565                    lappend deactivated [lindex [registry::active $port] 0]
566                    deactivate $port "" ""
567                    set port 0
568                }
569            }
570   
571            if { $port != 0  && $force != 1 && $port != $name } {
572                return -code error "Image error: $file is being used by the active $port port.  Please deactivate this port first, or use 'port -f activate $name' to force the activation."
573            } elseif { [file exists $file] && $force != 1 } {
574                return -code error "Image error: $file already exists and does not belong to a registered port.  Unable to activate port $name. Use 'port -f activate $name' to force the activation."
575            } elseif { $force == 1 && [file exists $file] || $port != 0 } {
576                set bakfile "${file}${baksuffix}"
577
578                if {[file exists $file]} {
579                    ui_warn "File $file already exists.  Moving to: $bakfile."
580                    file rename -force -- $file $bakfile
581                    lappend backups $file
582                }
583
584                if { $port != 0 } {
585                    set bakport [registry::file_registered $file]
586                    registry::unregister_file $file
587                    if {[file exists $bakfile]} {
588                        registry::register_file $bakfile $bakport
589                    }
590                }
591            }
592
593            # Split out the filename's subpaths and add them to the imagefile list.
594            # We need directories first to make sure they will be there before
595            # links. However, because file mkdir creates all parent directories,
596            # we don't need to have them sorted from root to subpaths. We do need,
597            # nevertheless, all sub paths to make sure we'll set the directory
598            # attributes properly for all directories.
599            set directory [file dirname $file]
600            while { [lsearch -exact $files $directory] == -1 } { 
601                lappend files $directory
602                set directory [file dirname $directory]
603            }
604
605            # Also add the filename to the imagefile list.
606            lappend files $file
607        }
608        registry::write_file_map
609
610        # Sort the list in forward order, removing duplicates.
611        # Since the list is sorted in forward order, we're sure that directories
612        # are before their elements.
613        # We don't have to do this as mentioned above, but it makes the
614        # debug output of activate make more sense.
615        set theList [lsort -increasing -unique $files]
616
617        # Activate it, and catch errors so we can roll-back
618        if { [catch { foreach file $theList {
619                        _activate_file "${imagedir}${file}" $file
620                    }} result]} {
621            ui_debug "Activation failed, rolling back."
622            _deactivate_contents $name $imagefiles
623            # return backed up files to their old locations
624            foreach f $backups {
625                set bakfile "${f}${baksuffix}"
626                set bakport [registry::file_registered $bakfile]
627                if {$bakport != 0} {
628                    registry::unregister_file $bakfile
629                    registry::register_file $f $bakport
630                }
631                file rename -force -- $bakfile $file
632            }
633            # reactivate deactivated ports
634            foreach entry $deactivated {
635                set pname [lindex $entry 0]
636                set pvers "[lindex $entry 1]_[lindex $entry 2][lindex $entry 3]"
637                activate $pname $pvers ""
638            }
639            registry::write_file_map
640
641            return -code error $result
642        }
643    }
644}
645
646proc _deactivate_file {dstfile} {
647    if { [file type $dstfile] == "link" } {
648        ui_debug "deactivating link: $dstfile"
649        file delete -- $dstfile
650    } elseif { [file isdirectory $dstfile] } {
651        # 0 item means empty.
652        if { [llength [readdir $dstfile]] == 0 } {
653            ui_debug "deactivating directory: $dstfile"
654            file delete -- $dstfile
655        } else {
656            ui_debug "$dstfile is not empty"
657        }
658    } else {
659        ui_debug "deactivating file: $dstfile"
660        file delete -- $dstfile
661    }
662}
663
664proc _deactivate_contents {port imagefiles {force 0}} {
665    variable use_reg2
666    set files [list]
667    if {$use_reg2} {
668        set imagefiles [$port files]
669    }
670
671    foreach file $imagefiles {
672        if { [file exists $file] || (![catch {file type $file}] && [file type $file] == "link") } {
673            # Normalize the file path to avoid removing the intermediate
674            # symlinks (remove the empty directories instead)
675            # Remark: paths in the registry may be not normalized.
676            # This is not really a problem and it is in fact preferable.
677            # Indeed, if I change the activate code to include normalized paths
678            # instead of the paths we currently have, users' registry won't
679            # match and activate will say that some file exists but doesn't
680            # belong to any port.
681            set theFile [file normalize $file]
682            lappend files $theFile
683
684            # Split out the filename's subpaths and add them to the image list as
685            # well. The realpath call is necessary because file normalize
686            # does not resolve symlinks on OS X < 10.6
687            set directory [realpath [file dirname $theFile]]
688            while { [lsearch -exact $files $directory] == -1 } { 
689                lappend files $directory
690                set directory [file dirname $directory]
691            }
692        } else {
693            ui_debug "$file does not exist."
694        }
695    }
696
697    # Sort the list in reverse order, removing duplicates.
698    # Since the list is sorted in reverse order, we're sure that directories
699    # are after their elements.
700    set theList [lsort -decreasing -unique $files]
701
702    # Remove all elements.
703    if {$use_reg2} {
704        registry::write {
705            $port deactivate $imagefiles
706            foreach file $theList {
707                _deactivate_file $file
708            }
709        }
710    } else {
711        foreach file $theList {
712            _deactivate_file $file
713        }
714    }
715}
716
717# End of portimage namespace
718}
Note: See TracBrowser for help on using the repository browser.