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 70666 2010-08-16 18:19:34Z 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 | |
---|
34 | package provide portimage 2.0 |
---|
35 | |
---|
36 | package require registry 1.0 |
---|
37 | package require registry2 2.0 |
---|
38 | package require registry_util 2.0 |
---|
39 | package require macports 1.0 |
---|
40 | package require Pextlib 1.0 |
---|
41 | |
---|
42 | set 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 | |
---|
65 | namespace eval portimage { |
---|
66 | |
---|
67 | variable force 0 |
---|
68 | variable use_reg2 0 |
---|
69 | variable noexec 0 |
---|
70 | variable is_upgrade no |
---|
71 | variable config_upgrade_completed no |
---|
72 | variable upgrade_actions_list [list] |
---|
73 | variable changed_config_files [list] |
---|
74 | |
---|
75 | # Activate a "Port Image" |
---|
76 | proc 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 | |
---|
220 | proc 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 | |
---|
329 | proc _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 | |
---|
391 | proc _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 |
---|
414 | proc _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 |
---|
442 | proc _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 |
---|
486 | proc _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 | |
---|
755 | proc _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 | |
---|
778 | proc _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 | |
---|
836 | proc _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 | |
---|
841 | proc _pick_config_upgrade_actions {requested active changed_files} { |
---|
842 | global UI_PREFIX |
---|
843 | variable config_upgrade_completed |
---|
844 | |
---|
845 | set actions_list [list] |
---|
846 | foreach file $changed_files { |
---|
847 | ui_debug "File $file has changed" |
---|
848 | set choice "" |
---|
849 | while {[lsearch "keep new" $choice] < 0} { |
---|
850 | if {$choice eq "current"} { |
---|
851 | #catch {exec /usr/bin/diff -u [] []} a |
---|
852 | #set result [string range $a 0 [expr [string length $a]-33]] |
---|
853 | #ui_msg "$result" |
---|
854 | } elseif {$choice eq "upgraded"} { |
---|
855 | #catch {exec /usr/bin/diff -u [] []} a |
---|
856 | #set result [string range $a 0 [expr [string length $a]-33]] |
---|
857 | #ui_msg "$result" |
---|
858 | } |
---|
859 | ui_msg "$UI_PREFIX [format [msgcat::mc "Please choose one of (keep) current, install (new), show diff original-(current), show diff current-(upgraded):"] ]" |
---|
860 | #puts "\nPlease choose one of (keep) current, install (new), show diff original-(current), show diff current-(upgraded):" |
---|
861 | gets stdin choice |
---|
862 | } |
---|
863 | lappend actions_list "$file" |
---|
864 | lappend actions_list "$choice" |
---|
865 | } |
---|
866 | set config_upgrade_completed "yes" |
---|
867 | return $actions_list |
---|
868 | } |
---|
869 | |
---|
870 | # End of portimage namespace |
---|
871 | } |
---|