Context Navigation

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

Visit:

Last change on this file since 70666 was 70666, checked in by and.damore@…, 9 years ago
fixed ui_* messages
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 36.3 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 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	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats: