source: branches/gsoc10-configfiles/base/src/registry2.0/portimage.tcl @ 70668

Last change on this file since 70668 was 70668, checked in by and.damore@…, 8 years ago

Added actual diff output

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 36.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 70668 2010-08-16 18:31:48Z and.damore@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
69variable noexec 0
70variable is_upgrade no
71variable config_upgrade_completed no
72variable upgrade_actions_list [list]
73variable changed_config_files [list]
74
75# Activate a "Port Image"
76proc activate {name v optionslist} {
77    global macports::prefix macports::registry.format macports::registry.path registry_open UI_PREFIX
78    array set options $optionslist
79    variable force
80    variable use_reg2
81    variable noexec
82    variable is_upgrade
83    variable config_upgrade_completed
84    variable upgrade_actions_list
85    variable changed_config_files
86   
87    if {[info exists options(ports_force)] && [string is true -strict $options(ports_force)] } {
88        set force 1
89    }
90    if {[info exists options(ports_activate_no-exec)]} {
91        set noexec $options(ports_activate_no-exec)
92    }
93    if {[string equal ${macports::registry.format} "receipt_sqlite"]} {
94        set use_reg2 1
95        if {![info exists registry_open]} {
96            registry::open [file join ${macports::registry.path} registry registry.db]
97            set registry_open yes
98        }
99    }
100    set todeactivate [list]
101
102    # before activating new image we handle deactivation of old version
103    if {$use_reg2} {
104        registry::read {
105
106            set requested [_check_registry $name $v]
107            # set name again since the one we were passed may not have had the correct case
108            set name [$requested name]
109            set version [$requested version]
110            set revision [$requested revision]
111            set variants [$requested variants]
112            set specifier "${version}_${revision}${variants}"
113
114            # if another version of this port is active, deactivate it first
115            set current [registry::entry installed $name]
116            foreach i $current {
117                if { ![string equal $specifier "[$i version]_[$i revision][$i variants]"] } {
118                    lappend todeactivate $i
119                }
120            }
121
122            # this shouldn't be possible
123            if { ![string equal [$requested installtype] "image"] } {
124                return -code error "Image error: ${name} @${version}_${revision}${variants} not installed as an image."
125            }
126
127            if { [string equal [$requested state] "installed"] } {
128                return -code error "Image error: ${name} @${version}_${revision}${variants} is already active."
129            }
130        }
131        if {$todeactivate ne ""} {set is_upgrade "yes"}
132        foreach a $todeactivate {
133            ## At this point $requested is registry::entry for the port to be
134            ## installed, $todeactivate is active version for same port           
135            set changed_config_files [_check_config_files_changed $requested [$requested imagefiles] [$requested imagefiles_with_md5]]
136            if {$changed_config_files ne "" && [info exists options(ports_upgrade_config-upgrade)] && $options(ports_upgrade_config-upgrade) eq "yes"} {
137                set upgrade_actions_list [_pick_config_upgrade_actions $requested $a $changed_config_files]
138            } else {
139                set config_upgrade_completed "no"
140            }
141           
142            if {$is_upgrade && $changed_config_files ne "" && $config_upgrade_completed ne "yes"} {
143                return -code error "Image error: run     port uninstall ${name} @${version}_${revision}${variants}; port upgrade --config-upgrade ${name}"
144            }
145           
146            if {$noexec || ![registry::run_target $a deactivate [list ports_nodepcheck 1]]} {
147                deactivate $name "[$a version]_[$a revision][$a variants]" [list ports_nodepcheck 1]
148            }
149        }
150    } else {
151        # registry1.0
152        set ilist [_check_registry $name $v]
153        # set name again since the one we were passed may not have had the correct case
154        set name [lindex $ilist 0]
155        set version [lindex $ilist 1]
156        set revision [lindex $ilist 2]
157        set variants [lindex $ilist 3]
158
159        # if another version of this port is active, deactivate it first
160        set ilist [registry::installed $name]
161        if { [llength $ilist] > 1 } {
162            foreach i $ilist {
163                set iversion [lindex $i 1]
164                set irevision [lindex $i 2]
165                set ivariants [lindex $i 3]
166                set iactive [lindex $i 4]
167                if { ![string equal "${iversion}_${irevision}${ivariants}" "${version}_${revision}${variants}"] && $iactive == 1 } {
168                    lappend todeactivate "${iversion}_${irevision}${ivariants}"
169                }
170            }
171        }
172
173        set ref [registry::open_entry $name $version $revision $variants]
174
175        if { ![string equal [registry::property_retrieve $ref installtype] "image"] } {
176            return -code error "Image error: ${name} @${version}_${revision}${variants} not installed as an image."
177        }
178        if { [registry::property_retrieve $ref active] != 0 } {
179            return -code error "Image error: ${name} @${version}_${revision}${variants} is already active."
180        }
181
182        foreach a $todeactivate {
183            deactivate $name $a [list ports_nodepcheck 1]
184        }
185    }
186
187    #eventually print variants
188    if {$v != ""} {
189        ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s @%s"] $name $v]"
190    } else {
191        ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s"] $name]"
192    }
193
194    #activate new image
195    if {$use_reg2} {
196            _activate_contents $requested
197            $requested state installed
198    } else {
199        set imagedir [registry::property_retrieve $ref imagedir]
200
201        set contents [registry::property_retrieve $ref contents]
202
203        set imagefiles [_check_contents $name $contents $imagedir]
204
205        registry::open_file_map
206        _activate_contents $name $imagefiles $imagedir
207
208        registry::property_store $ref active 1
209
210        registry::write_entry $ref
211
212        foreach file $imagefiles {
213            registry::register_file $file $name
214        }
215        registry::write_file_map
216        registry::close_file_map
217    }
218}
219
220proc deactivate {name v optionslist} {
221    global UI_PREFIX macports::registry.format macports::registry.path registry_open
222    array set options $optionslist
223    variable use_reg2
224    variable is_upgrade
225    variable config_upgrade_completed
226    variable upgrade_actions_list
227    variable changed_config_files
228   
229    if {[info exists options(ports_force)] && [string is true -strict $options(ports_force)] } {
230        # this not using the namespace variable is correct, since activate
231        # needs to be able to force deactivate independently of whether
232        # the activation is being forced
233        set force 1
234    } else {
235        set force 0
236    }
237    if {[string equal ${macports::registry.format} "receipt_sqlite"]} {
238        set use_reg2 1
239        if {![info exists registry_open]} {
240            registry::open [file join ${macports::registry.path} registry registry.db]
241            set registry_open yes
242        }
243    }
244
245    if {$use_reg2} {
246        if { [string equal $name ""] } {
247            throw registry::image-error "Registry error: Please specify the name of the port."
248        }
249        set ilist [registry::entry installed $name]
250        if { [llength $ilist] == 1 } {
251            set requested [lindex $ilist 0]
252        } else {
253            throw registry::image-error "Image error: port ${name} is not active."
254        }
255        # set name again since the one we were passed may not have had the correct case
256        set name [$requested name]
257        set version [$requested version]
258        set revision [$requested revision]
259        set variants [$requested variants]
260        set specifier "${version}_${revision}${variants}"
261    } else {
262        set ilist [registry::active $name]
263        if { [llength $ilist] > 1 } {
264            return -code error "Registry error: Please specify the name of the port."
265        } else {
266            set ilist [lindex $ilist 0]
267        }
268        # set name again since the one we were passed may not have had the correct case
269        set name [lindex $ilist 0]
270        set version [lindex $ilist 1]
271        set revision [lindex $ilist 2]
272        set variants [lindex $ilist 3]
273        set specifier "${version}_${revision}${variants}"
274    }
275
276    if { $v != "" && ![string equal $specifier $v] } {
277        return -code error "Active version of $name is not $v but ${specifier}."
278    }
279
280    if {$v != ""} {
281        ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $v]"
282    } else {
283        ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s"] $name]"
284    }
285
286    if {$use_reg2} {
287        if { ![string equal [$requested installtype] "image"] } {
288            return -code error "Image error: ${name} @${specifier} not installed as an image."
289        }
290        # this shouldn't be possible
291        if { [$requested state] != "installed" } {
292            return -code error "Image error: ${name} @${specifier} is not active."
293        }
294
295        if {![info exists options(ports_nodepcheck)] || ![string is true -strict $options(ports_nodepcheck)]} {
296            registry::check_dependents $requested $force
297        }
298
299        _deactivate_contents $requested [$requested files] [$requested files_with_md5] $force
300
301        $requested state imaged
302    } else {
303        set ref [registry::open_entry $name $version $revision $variants]
304
305        if { ![string equal [registry::property_retrieve $ref installtype] "image"] } {
306            return -code error "Image error: ${name} @${specifier} not installed as an image."
307        }
308        if { [registry::property_retrieve $ref active] != 1 } {
309            return -code error "Image error: ${name} @${specifier} is not active."
310        }
311
312        registry::open_file_map
313        set imagefiles [registry::port_registered $name]
314
315        _deactivate_contents $name $imagefiles
316
317        foreach file $imagefiles {
318            registry::unregister_file $file
319        }
320        registry::write_file_map
321        registry::close_file_map
322
323        registry::property_store $ref active 0
324
325        registry::write_entry $ref
326    }
327}
328
329proc _check_registry {name v} {
330    global UI_PREFIX macports::registry.installtype
331    variable use_reg2
332
333    if {$use_reg2} {
334        if { [registry::decode_spec $v version revision variants] } {
335            set ilist [registry::entry imaged $name $version $revision $variants]
336            set valid 1
337        } else {
338            set valid [string equal $v {}]
339            set ilist [registry::entry imaged $name]
340        }
341
342        if { [llength $ilist] > 1 || (!$valid && [llength $ilist] == 1) } {
343            ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $name are currently installed:"]"
344            foreach i $ilist {
345                set iname [$i name]
346                set iversion [$i version]
347                set irevision [$i revision]
348                set ivariants [$i variants]
349                if { [$i state] == "installed" } {
350                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s (active)"] $iname $iversion $irevision $ivariants]"
351                } else {
352                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s"] $iname $iversion $irevision $ivariants]"
353                }
354            }
355            if { $valid } {
356                throw registry::invalid "Registry error: Please specify the full version as recorded in the port registry."
357            } else {
358                throw registry::invalid "Registry error: Invalid version specified. Please specify a version as recorded in the port registry."
359            }
360        } elseif { [llength $ilist] == 1 } {
361            return [lindex $ilist 0]
362        }
363        throw registry::invalid "Registry error: No port of $name installed."
364    } else {
365        # registry1.0
366        set ilist [registry::installed $name $v]
367        if { [string equal $v ""] && [llength $ilist] > 1 } {
368            # set name again since the one we were passed may not have had the correct case
369            set name [lindex [lindex $ilist 0] 0]
370            ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $name are currently installed:"]"
371            foreach i $ilist { 
372                set iname [lindex $i 0]
373                set iversion [lindex $i 1]
374                set irevision [lindex $i 2]
375                set ivariants [lindex $i 3]
376                set iactive [lindex $i 4]
377                if { $iactive == 0 } {
378                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s"] $iname $iversion $irevision $ivariants]"
379                } elseif { $iactive == 1 } {
380                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s (active)"] $iname $iversion $irevision $ivariants]"
381                }
382            }
383            return -code error "Registry error: Please specify the full version as recorded in the port registry."
384        } elseif {[llength $ilist] == 1} {
385            return [lindex $ilist 0]
386        }
387        return -code error "Registry error: No port of $name installed."
388    }
389}
390
391proc _check_contents {name contents imagedir} {
392
393    set imagefiles [list]
394    set idlen [string length $imagedir]
395
396    # generate list of activated file paths from list of paths in the image dir
397    foreach fe $contents {
398        set srcfile [lindex $fe 0]
399        if { ![string equal $srcfile ""] && [file type $srcfile] != "directory" } {
400            set file [string range $srcfile $idlen [string length $srcfile]]
401
402            lappend imagefiles $file
403        }
404    }
405
406    return $imagefiles
407}
408
409## Checks all files in config files for changes comparing actual checksum with
410## checksum in registry.
411##
412## @param [in] port     portfile upgrading
413## @return  1 if config files of port changed, 0 otherwise
414proc _check_config_files_changed {port files files_with_md5} {
415    set changed_files [list]
416    foreach file $files {
417        if { [file isfile $file] && [_is_config_file $file]} {
418            if {[catch {md5 file "$file"} actual_md5] == 0} {
419                set stored_md5 [dict get $files_with_md5 $file]               
420                if {[string equal -nocase $actual_md5 $stored_md5]} {
421                    ui_debug "config file:$file not modified"
422                } else {
423                    ui_debug "config file:$file modified"
424                    lappend changed_files  $file
425                }
426            } else {
427            puts "couldn't catch md5"
428            }
429        } else {
430            #element not of type file, can safely remove this else branch
431        }
432    }
433    return $changed_files
434}
435
436## Activates a file from an image into the filesystem. Deals with symlinks,
437## directories and files.
438##
439## @param [in] srcfile path to file in image
440## @param [in] dstfile path to activate file to
441## @return 1 if file needs to be explicitly deleted if we have to roll back, 0 otherwise
442proc _activate_file {srcfile dstfile} {
443    variable is_upgrade
444    variable upgrade_actions_list
445    variable changed_config_files
446    array set actions "$upgrade_actions_list"
447   
448    switch [file type $srcfile] {
449        link {
450            ui_debug "activating link: $dstfile"
451            file copy -force -- $srcfile $dstfile
452            return 1
453        }
454        directory {
455            # Don't recursively copy directories
456            ui_debug "activating directory: $dstfile"
457            # Don't do anything if the directory already exists.
458            if { ![file isdirectory $dstfile] } {
459                file mkdir $dstfile
460                # fix attributes on the directory.
461                eval file attributes {$dstfile} [file attributes $srcfile]
462                # set mtime on installed element
463                file mtime $dstfile [file mtime $srcfile]
464            }
465            return 0
466        }
467        default {
468            ui_debug "activating file: $dstfile"           
469            if { [_is_config_file $dstfile]} {
470                ui_debug "copying $srcfile to $dstfile as it is a config file"
471                # copy config files rather than hardlink them
472                file copy $srcfile $dstfile
473            } else {
474                # Try a hard link first and if that fails, a symlink
475                if {[catch {file link -hard $dstfile $srcfile}]} {
476                    ui_debug "hardlinking $srcfile to $dstfile failed, symlinking instead"
477                    file link -symbolic $dstfile $srcfile
478                }
479            }
480            return 1
481        }
482    }
483}
484
485## Activates the contents of a port
486proc _activate_contents {port {imagefiles {}} {imagedir {}}} {
487    variable force
488    variable use_reg2
489    variable noexec
490    variable is_upgrade
491    variable config_upgrade_completed
492    variable upgrade_actions_list
493    variable changed_config_files
494    array set actions "$upgrade_actions_list"
495    global macports::prefix
496
497    set files [list]
498    set baksuffix .mp_[clock seconds]
499    if {$use_reg2} {
500        set imagedir [$port location]
501        set imagefiles [$port imagefiles]
502
503        foreach file $imagefiles {
504            if {$is_upgrade && [info exists actions($file)] && $actions($file) eq "keep"} {
505                ui_debug "skipping activation for config file:$file"
506                set num [lsearch $imagefiles $file]
507                set imagefiles [lreplace $imagefiles $num $num]
508                continue
509            }
510        }
511    } else {
512        set name $port
513    }
514    set backups [list]
515    # This is big and hairy and probably could be done better.
516    # First, we need to check the source file, make sure it exists
517    # Then we remove the $imagedir from the path of the file in the contents
518    #  list  and check to see if that file exists
519    # Last, if the file exists, and belongs to another port, and force is set
520    #  we remove the file from the file_map, take ownership of it, and
521    #  clobber it
522    if {$use_reg2} {
523        array set todeactivate {}
524        try {
525            registry::write {
526                foreach file $imagefiles {
527                    set srcfile "${imagedir}${file}"
528
529                    # To be able to install links, we test if we can lstat the file to
530                    # figure out if the source file exists (file exists will return
531                    # false for symlinks on files that do not exist)
532                    if { [catch {file lstat $srcfile dummystatvar}] } {
533                        throw registry::image-error "Image error: Source file $srcfile does not appear to exist (cannot lstat it).  Unable to activate port [$port name]."
534                    }
535                   
536                    set owner [registry::entry owner $file]
537
538                    if {$owner != {} && $owner != $port} {
539                        # deactivate conflicting port if it is replaced_by this one
540                        set result [mportlookup [$owner name]]
541                        array unset portinfo
542                        array set portinfo [lindex $result 1]
543                        if {[info exists portinfo(replaced_by)] && [lsearch -regexp $portinfo(replaced_by) "(?i)^[$port name]\$"] != -1} {
544                            # we'll deactivate the owner later, but before activating our files
545                            set todeactivate($owner) yes
546                            set owner "replaced"
547                        }
548                    }
549
550                    if {$owner != "replaced"} {
551                        if { [string is true -strict $force] } {
552                            # if we're forcing the activation, then we move any existing
553                            # files to a backup file, both in the filesystem and in the
554                            # registry
555                            if { [file exists $file] } {
556                                set bakfile "${file}${baksuffix}"
557                                ui_warn "File $file already exists.  Moving to: $bakfile."
558                                file rename -force -- $file $bakfile
559                                lappend backups $file
560                            }
561                            if { $owner != {} } {
562                                $owner deactivate [list $file]
563                                $owner activate [list $file] [list "${file}${baksuffix}"]
564                            }
565                        } else {
566                            # if we're not forcing the activation, then we bail out if
567                            # we find any files that already exist, or have entries in
568                            # the registry
569                            if { $owner != {} && $owner != $port } {
570                                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."
571                            } elseif { $owner == {} && ![catch {file type $file}] } {
572                                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."
573                            }
574                        }
575                    }
576
577                    # Split out the filename's subpaths and add them to the
578                    # imagefile list.
579                    # We need directories first to make sure they will be there
580                    # before links. However, because file mkdir creates all parent
581                    # directories, we don't need to have them sorted from root to
582                    # subpaths. We do need, nevertheless, all sub paths to make sure
583                    # we'll set the directory attributes properly for all
584                    # directories.
585                    set directory [file dirname $file]
586                    while { [lsearch -exact $files $directory] == -1 } {
587                        lappend files $directory
588                        set directory [file dirname $directory]
589                    }
590
591                    # Also add the filename to the imagefile list.
592                    lappend files $file
593                }
594            }
595
596            # deactivate ports replaced_by this one
597            foreach owner [array names todeactivate] {
598                if {$noexec || ![registry::run_target $owner deactivate [list ports_nodepcheck 1]]} {
599                    deactivate [$owner name] "" [list ports_nodepcheck 1]
600                }
601            }
602
603            # Sort the list in forward order, removing duplicates.
604            # Since the list is sorted in forward order, we're sure that
605            # directories are before their elements.
606            # We don't have to do this as mentioned above, but it makes the
607            # debug output of activate make more sense.
608            set files [lsort -increasing -unique $files]
609            set rollback_filelist {}
610            registry::write {
611                # Activate it, and catch errors so we can roll-back
612                try {
613                    $port activate $imagefiles
614                    foreach file $files {
615                        if {[_activate_file "${imagedir}${file}" $file] == 1} {
616                            lappend rollback_filelist $file
617                        }
618                    }
619                } catch {*} {
620                    ui_debug "Activation failed, rolling back."
621                    # can't do it here since we're already inside a transaction
622                    set deactivate_this yes
623                    throw
624                }
625            }
626        } catch {*} {
627            # roll back activation of this port
628            if {[info exists deactivate_this]} {
629                _deactivate_contents $port $rollback_filelist {} yes yes
630            }
631            # if any errors occurred, move backed-up files back to their original
632            # locations, then rethrow the error. Transaction rollback will take care
633            # of this in the registry.
634            foreach file $backups {
635                file rename -force -- "${file}${baksuffix}" $file
636            }
637            # reactivate deactivated ports
638            foreach entry [array names todeactivate] {
639                if {[$entry state] == "imaged" && ($noexec || ![registry::run_target $entry activate ""])} {
640                    set pvers "[$entry version]_[$entry revision][$entry variants]"
641                    activate [$entry name] $pvers [list ports_activate_no-exec $noexec]
642                }
643            }
644            throw
645        }
646    } else {
647        # registry1.0
648        set deactivated [list]
649        foreach file $imagefiles {
650            set srcfile "${imagedir}${file}"
651
652            # To be able to install links, we test if we can lstat the file to
653            # figure out if the source file exists (file exists will return
654            # false for symlinks on files that do not exist)
655            if { [catch {file lstat $srcfile dummystatvar}] } {
656                return -code error "Image error: Source file $srcfile does not appear to exist (cannot lstat it).  Unable to activate port $name."
657            }
658
659            set port [registry::file_registered $file]
660           
661            if {$port != 0  && $port != $name} {
662                # deactivate conflicting port if it is replaced_by this one
663                if {[catch {mportlookup $port} result]} {
664                    global errorInfo
665                    ui_debug "$errorInfo"
666                    return -code error "port lookup failed: $result"
667                }
668                array unset portinfo
669                array set portinfo [lindex $result 1]
670                if {[info exists portinfo(replaced_by)] && [lsearch -regexp $portinfo(replaced_by) "(?i)^${name}\$"] != -1} {
671                    lappend deactivated [lindex [registry::active $port] 0]
672                    deactivate $port "" ""
673                    set port 0
674                }
675            }
676   
677            if { $port != 0  && $force != 1 && $port != $name } {
678                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."
679            } elseif { [file exists $file] && $force != 1 } {
680                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."
681            } elseif { $force == 1 && [file exists $file] || $port != 0 } {
682                set bakfile "${file}${baksuffix}"
683
684                if {[file exists $file]} {
685                    ui_warn "File $file already exists.  Moving to: $bakfile."
686                    file rename -force -- $file $bakfile
687                    lappend backups $file
688                }
689
690                if { $port != 0 } {
691                    set bakport [registry::file_registered $file]
692                    registry::unregister_file $file
693                    if {[file exists $bakfile]} {
694                        registry::register_file $bakfile $bakport
695                    }
696                }
697            }
698
699            # Split out the filename's subpaths and add them to the imagefile list.
700            # We need directories first to make sure they will be there before
701            # links. However, because file mkdir creates all parent directories,
702            # we don't need to have them sorted from root to subpaths. We do need,
703            # nevertheless, all sub paths to make sure we'll set the directory
704            # attributes properly for all directories.
705            set directory [file dirname $file]
706            while { [lsearch -exact $files $directory] == -1 } { 
707                lappend files $directory
708                set directory [file dirname $directory]
709            }
710
711            # Also add the filename to the imagefile list.
712            lappend files $file
713        }
714        registry::write_file_map
715
716        # Sort the list in forward order, removing duplicates.
717        # Since the list is sorted in forward order, we're sure that directories
718        # are before their elements.
719        # We don't have to do this as mentioned above, but it makes the
720        # debug output of activate make more sense.
721        set files [lsort -increasing -unique $files]
722        set rollback_filelist {}
723
724        # Activate it, and catch errors so we can roll-back
725        if { [catch { foreach file $files {
726                        if {[_activate_file "${imagedir}${file}" $file] == 1} {
727                            lappend rollback_filelist $file
728                        }
729                    }} result]} {
730            ui_debug "Activation failed, rolling back."
731            _deactivate_contents $name $rollback_filelist {} yes yes
732            # return backed up files to their old locations
733            foreach f $backups {
734                set bakfile "${f}${baksuffix}"
735                set bakport [registry::file_registered $bakfile]
736                if {$bakport != 0} {
737                    registry::unregister_file $bakfile
738                    registry::register_file $f $bakport
739                }
740                file rename -force -- $bakfile $file
741            }
742            # reactivate deactivated ports
743            foreach entry $deactivated {
744                set pname [lindex $entry 0]
745                set pvers "[lindex $entry 1]_[lindex $entry 2][lindex $entry 3]"
746                activate $pname $pvers ""
747            }
748            registry::write_file_map
749
750            return -code error $result
751        }
752    }
753}
754
755proc _deactivate_file {dstfile} {
756    variable is_upgrade
757    variable upgrade_actions_list
758    variable changed_config_files
759    array set actions "$upgrade_actions_list"
760   
761    if { [file type $dstfile] == "link" } {
762        ui_debug "deactivating link: $dstfile"
763        file delete -- $dstfile
764    } elseif { [file isdirectory $dstfile] } {
765        # 0 item means empty.
766        if { [llength [readdir $dstfile]] == 0 } {
767            ui_debug "deactivating directory: $dstfile"
768            file delete -- $dstfile
769        } else {
770            ui_debug "$dstfile is not empty"
771        }
772    } else {
773        ui_debug "deactivating file: $dstfile"
774        file delete -- $dstfile
775    }
776}
777
778proc _deactivate_contents {port imagefiles {imagefiles_with_md5 {}} {force 0} {rollback 0}} {
779    variable use_reg2
780    variable is_upgrade
781    variable upgrade_actions_list
782    variable changed_config_files
783    array set actions "$upgrade_actions_list"
784    set files [list]
785
786    foreach file $imagefiles {
787        if { [file exists $file] || (![catch {file type $file}] && [file type $file] == "link") } {
788            # Normalize the file path to avoid removing the intermediate
789            # symlinks (remove the empty directories instead)
790            # Remark: paths in the registry may be not normalized.
791            # This is not really a problem and it is in fact preferable.
792            # Indeed, if I change the activate code to include normalized paths
793            # instead of the paths we currently have, users' registry won't
794            # match and activate will say that some file exists but doesn't
795            # belong to any port.
796            # The custom realpath proc is necessary because file normalize
797            # does not resolve symlinks on OS X < 10.6
798            set directory [realpath [file dirname $file]]
799
800            if {$is_upgrade && [info exists actions($file)] && $actions($file) eq "keep"} {
801                ui_debug "skipping deactivation for config file:$file"
802                continue
803            }
804            lappend files [file join $directory [file tail $file]]
805
806            # Split out the filename's subpaths and add them to the image list
807            # as well.
808            while { [lsearch -exact $files $directory] == -1 } {
809                lappend files $directory
810                set directory [file dirname $directory]
811            }
812        } else {
813            ui_debug "$file does not exist."
814        }
815    }
816    # Sort the list in reverse order, removing duplicates.
817    # Since the list is sorted in reverse order, we're sure that directories
818    # are after their elements.
819    set files [lsort -decreasing -unique $files]
820
821    # Remove all elements.
822    if {$use_reg2 && !$rollback} {
823        registry::write {
824            $port deactivate $imagefiles
825            foreach file $files {
826                _deactivate_file $file
827            }
828        }
829    } else {
830        foreach file $files {
831            _deactivate_file $file
832        }
833    }
834}
835
836proc _is_config_file {filename} {
837    #replace hardcoded path with $config_path from portmain.tcl, what namespace does "option" add options to?
838    if {[string match ${::macports::prefix}/etc* "$filename"]} {return 1} {return 0}
839}
840
841proc _pick_config_upgrade_actions {requested active changed_files} {
842    global UI_PREFIX
843    variable config_upgrade_completed
844
845    set newimagedir [$requested location]
846    set oldimagedir [$active location]
847    set actions_list [list]
848    foreach file $changed_files {
849        ui_msg "$UI_PREFIX [format [msgcat::mc "File %s has changed"] $file]"
850        set choice ""
851        while {[lsearch "keep new" $choice] < 0} { 
852            if {$choice eq "current"} {
853                catch {exec /usr/bin/diff -u $oldimagedir$file $file} a
854                set result [string range $a 0 [expr [string length $a]-33]]
855                ui_msg "\n$result\n"
856            } elseif {$choice eq "upgraded"} {
857                catch {exec /usr/bin/diff -u $file $newimagedir$file} a
858                set result [string range $a 0 [expr [string length $a]-33]]
859                ui_msg "\n$result\n"               
860            }
861            ui_msg "$UI_PREFIX [format [msgcat::mc "Please choose one of (keep) current, install (new), show diff original-(current), show diff current-(upgraded):"] ]"
862            #puts "\nPlease choose one of (keep) current, install (new), show diff original-(current), show diff current-(upgraded):"
863            gets stdin choice
864        }
865        lappend actions_list "$file" 
866        lappend actions_list "$choice"
867    }
868    set config_upgrade_completed "yes"
869    return $actions_list
870}
871
872# End of portimage namespace
873}
Note: See TracBrowser for help on using the repository browser.