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

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

fix reg2 deactivate

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 29.5 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 64269 2010-02-28 02:45:55Z 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] "active"] } {
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                            deactivate [$owner name] "" ""
455                            set owner {}
456                        }
457                    }
458
459                    if { [string is true -strict $force] } {
460                        # if we're forcing the activation, then we move any existing
461                        # files to a backup file, both in the filesystem and in the
462                        # registry
463                        if { [file exists $file] } {
464                            set bakfile "${file}${baksuffix}"
465                            ui_warn "File $file already exists.  Moving to: $bakfile."
466                            file rename -force -- $file $bakfile
467                            lappend backups $file
468                        }
469                        if { $owner != {} } {
470                            $owner deactivate [list $file]
471                            $owner activate [list $file] [list "${file}${baksuffix}"]
472                        }
473                    } else {
474                        # if we're not forcing the activation, then we bail out if
475                        # we find any files that already exist, or have entries in
476                        # the registry
477                        if { $owner != {} && $owner != $port } {
478                            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."
479                        } elseif { $owner == {} && [file exists $file] } {
480                            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."
481                        }
482                    }
483
484                    # Split out the filename's subpaths and add them to the
485                    # imagefile list.
486                    # We need directories first to make sure they will be there
487                    # before links. However, because file mkdir creates all parent
488                    # directories, we don't need to have them sorted from root to
489                    # subpaths. We do need, nevertheless, all sub paths to make sure
490                    # we'll set the directory attributes properly for all
491                    # directories.
492                    set directory [file dirname $file]
493                    while { [lsearch -exact $files $directory] == -1 } {
494                        lappend files $directory
495                        set directory [file dirname $directory]
496                    }
497
498                    # Also add the filename to the imagefile list.
499                    lappend files $file
500                }
501
502                # Sort the list in forward order, removing duplicates.
503                # Since the list is sorted in forward order, we're sure that
504                # directories are before their elements.
505                # We don't have to do this as mentioned above, but it makes the
506                # debug output of activate make more sense.
507                set theList [lsort -increasing -unique $files]
508
509                # Activate it, and catch errors so we can roll-back
510                try {
511                    $port activate $imagefiles
512                    foreach file $theList {
513                        _activate_file "${imagedir}${file}" $file
514                    }
515                } catch {*} {
516                    ui_debug "Activation failed, rolling back."
517                    # can't do it here since we're already inside a transaction
518                    set deactivate_this yes
519                    throw
520                }
521            }
522        } catch {*} {
523            # roll back activation of this port
524            if {[info exists deactivate_this]} {
525                _deactivate_contents $port {} yes
526            }
527            # if any errors occurred, move backed-up files back to their original
528            # locations, then rethrow the error. Transaction rollback will take care
529            # of this in the registry.
530            foreach file $backups {
531                file rename -force -- "${file}${baksuffix}" $file
532            }
533            # reactivate deactivated ports
534            foreach entry $deactivated {
535                set pvers "[$entry version]_[$entry revision][$entry variants]"
536                activate [$entry name] $pvers ""
537            }
538            throw
539        }
540    } else {
541        # registry1.0
542        foreach file $imagefiles {
543            set srcfile "${imagedir}${file}"
544
545            # To be able to install links, we test if we can lstat the file to
546            # figure out if the source file exists (file exists will return
547            # false for symlinks on files that do not exist)
548            if { [catch {file lstat $srcfile dummystatvar}] } {
549                return -code error "Image error: Source file $srcfile does not appear to exist (cannot lstat it).  Unable to activate port $name."
550            }
551
552            set port [registry::file_registered $file]
553           
554            if {$port != 0  && $port != $name} {
555                # deactivate conflicting port if it is replaced_by this one
556                if {[catch {mportlookup $port} result]} {
557                    global errorInfo
558                    ui_debug "$errorInfo"
559                    return -code error "port lookup failed: $result"
560                }
561                array unset portinfo
562                array set portinfo [lindex $result 1]
563                if {[info exists portinfo(replaced_by)] && [lsearch -exact -nocase $portinfo(replaced_by) $name] != -1} {
564                    lappend deactivated [lindex [registry::active $port] 0]
565                    deactivate $port "" ""
566                    set port 0
567                }
568            }
569   
570            if { $port != 0  && $force != 1 && $port != $name } {
571                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."
572            } elseif { [file exists $file] && $force != 1 } {
573                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."
574            } elseif { $force == 1 && [file exists $file] || $port != 0 } {
575                set bakfile "${file}${baksuffix}"
576
577                if {[file exists $file]} {
578                    ui_warn "File $file already exists.  Moving to: $bakfile."
579                    file rename -force -- $file $bakfile
580                    lappend backups $file
581                }
582
583                if { $port != 0 } {
584                    set bakport [registry::file_registered $file]
585                    registry::unregister_file $file
586                    if {[file exists $bakfile]} {
587                        registry::register_file $bakfile $bakport
588                    }
589                }
590            }
591
592            # Split out the filename's subpaths and add them to the imagefile list.
593            # We need directories first to make sure they will be there before
594            # links. However, because file mkdir creates all parent directories,
595            # we don't need to have them sorted from root to subpaths. We do need,
596            # nevertheless, all sub paths to make sure we'll set the directory
597            # attributes properly for all directories.
598            set directory [file dirname $file]
599            while { [lsearch -exact $files $directory] == -1 } { 
600                lappend files $directory
601                set directory [file dirname $directory]
602            }
603
604            # Also add the filename to the imagefile list.
605            lappend files $file
606        }
607        registry::write_file_map
608
609        # Sort the list in forward order, removing duplicates.
610        # Since the list is sorted in forward order, we're sure that directories
611        # are before their elements.
612        # We don't have to do this as mentioned above, but it makes the
613        # debug output of activate make more sense.
614        set theList [lsort -increasing -unique $files]
615
616        # Activate it, and catch errors so we can roll-back
617        if { [catch { foreach file $theList {
618                        _activate_file "${imagedir}${file}" $file
619                    }} result]} {
620            ui_debug "Activation failed, rolling back."
621            _deactivate_contents $name $imagefiles
622            # return backed up files to their old locations
623            foreach f $backups {
624                set bakfile "${f}${baksuffix}"
625                set bakport [registry::file_registered $bakfile]
626                if {$bakport != 0} {
627                    registry::unregister_file $bakfile
628                    registry::register_file $f $bakport
629                }
630                file rename -force -- $bakfile $file
631            }
632            # reactivate deactivated ports
633            foreach entry $deactivated {
634                set pname [lindex $entry 0]
635                set pvers "[lindex $entry 1]_[lindex $entry 2][lindex $entry 3]"
636                activate $pname $pvers ""
637            }
638            registry::write_file_map
639
640            return -code error $result
641        }
642    }
643}
644
645proc _deactivate_file {dstfile} {
646    if { [file type $dstfile] == "link" } {
647        ui_debug "deactivating link: $dstfile"
648        file delete -- $dstfile
649    } elseif { [file isdirectory $dstfile] } {
650        # 0 item means empty.
651        if { [llength [readdir $dstfile]] == 0 } {
652            ui_debug "deactivating directory: $dstfile"
653            file delete -- $dstfile
654        } else {
655            ui_debug "$dstfile is not empty"
656        }
657    } else {
658        ui_debug "deactivating file: $dstfile"
659        file delete -- $dstfile
660    }
661}
662
663proc _deactivate_contents {port imagefiles {force 0}} {
664    variable use_reg2
665    set files [list]
666    if {$use_reg2} {
667        set imagefiles [$port files]
668    }
669
670    foreach file $imagefiles {
671        if { [file exists $file] || (![catch {file type $file}] && [file type $file] == "link") } {
672            # Normalize the file path to avoid removing the intermediate
673            # symlinks (remove the empty directories instead)
674            # Remark: paths in the registry may be not normalized.
675            # This is not really a problem and it is in fact preferable.
676            # Indeed, if I change the activate code to include normalized paths
677            # instead of the paths we currently have, users' registry won't
678            # match and activate will say that some file exists but doesn't
679            # belong to any port.
680            set theFile [file normalize $file]
681            lappend files $theFile
682
683            # Split out the filename's subpaths and add them to the image list as
684            # well. The realpath call is necessary because file normalize
685            # does not resolve symlinks on OS X < 10.6
686            set directory [realpath [file dirname $theFile]]
687            while { [lsearch -exact $files $directory] == -1 } { 
688                lappend files $directory
689                set directory [file dirname $directory]
690            }
691        } else {
692            ui_debug "$file does not exist."
693        }
694    }
695
696    # Sort the list in reverse order, removing duplicates.
697    # Since the list is sorted in reverse order, we're sure that directories
698    # are after their elements.
699    set theList [lsort -decreasing -unique $files]
700
701    # Remove all elements.
702    if {$use_reg2} {
703        registry::write {
704            $port deactivate $imagefiles
705            foreach file $theList {
706                _deactivate_file $file
707            }
708        }
709    } else {
710        foreach file $theList {
711            _deactivate_file $file
712        }
713    }
714}
715
716# End of portimage namespace
717}
Note: See TracBrowser for help on using the repository browser.