« back to all changes in this revision
Viewing changes to scripts/fcopy
- browse files at revision 2923
- compare with another revision
- download diff
- download tarball
- view history from revision 2923
- Committer: lange
- Date: 2005-11-10 12:47:47 UTC
- Revision ID: svn-v4:ba5ec265-b0fb-0310-8e1a-cf9e4c2b1591:trunk:3022
rename directory scripts to bin, fix pathes in Makefile
- files added:
- bin
- files removed:
- scripts
- files modified:
- Makefile
added
removed
scripts/fcopy
1
#! /usr/bin/perl
2
3
# $Id$
4
#*********************************************************************
5
#
6
# fcopy -- copy files using FAI classes and preserve directory structure
7
#
8
# This script is part of FAI (Fully Automatic Installation)
9
# Copyright (C) 2000-2004 Thomas Lange, lange@informatik.uni-koeln.de
10
# Universitaet zu Koeln
11
#
12
#*********************************************************************
13
# This program is free software; you can redistribute it and/or modify
14
# it under the terms of the GNU General Public License as published by
15
# the Free Software Foundation; either version 2 of the License, or
16
# (at your option) any later version.
17
#
18
# This program is distributed in the hope that it will be useful, but
19
# WITHOUT ANY WARRANTY; without even the implied warranty of
20
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21
# General Public License for more details.
22
#
23
# A copy of the GNU General Public License is available as
24
# '/usr/share/common-licences/GPL' in the Debian GNU/Linux distribution
25
# or on the World Wide Web at http://www.gnu.org/copyleft/gpl.html. You
26
# can also obtain it by writing to the Free Software Foundation, Inc.,
27
# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
28
#*********************************************************************
29
30
my $version = "Version 1.23, 24-march-2005";
31
32
use strict;
33
use File::Copy;
34
use File::Compare;
35
use File::Find;
36
use File::Path;
37
use File::Basename;
38
use Getopt::Std;
39
40
use vars qw/*name/;
41
42
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
43
# Global variables
44
my $debug;
45
my $error = 0;
46
my $verbose;
47
my $target;
48
my $source;
49
my $logfile;
50
my @classes;
51
52
my @opt_modes;
53
my @rlist;
54
my %changed;
55
my %lastclass;
56
my $modeset;
57
my $nobackup;
58
my $opt_update;
59
my $backupdir;
60
my @ignoredirs = qw'CVS .svn .arch-ids {arch}';
61
62
# getopts:
63
our ($opt_s, $opt_t, $opt_r, $opt_m, $opt_M, $opt_v, $opt_d, $opt_D, $opt_i);
64
our ($opt_B, $opt_c, $opt_C, $opt_h, $opt_F, $opt_l, $opt_L, $opt_P, $opt_b);
65
our $opt_I;
66
67
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
68
sub copy_one {
69
70
# copy file $prefix/$source/$class to $target/$source
71
my ($prefix,$source,$target) = @_;
72
my ($class,$sourcefile,$destfile);
73
# 'normalize' source filenames: very important for updating !
74
$source=~ s/^(\.\/|\/)*//;
75
76
my $ps = "$prefix/$source";
77
$ps =~ s#//#/#;
78
my $tpath = "$target/" . dirname $source;
79
my $preserve = 0;
80
my $logcomment = "";
81
82
warn "copy_one: source: $source: ps: $ps tpath: $tpath\n" if $debug;
83
84
# $prefix/$source must be a directory
85
unless (-d $ps) { ewarn("$ps is not a directory. Not copied.");return }
86
# use the last class for which a file exists
87
foreach (@classes) { $class = $_,last if -f "$ps/$_"; }
88
$destfile = "$target/$source";
89
90
my $backupfile = ( $backupdir ? "$backupdir/$source" : "$destfile.pre_fcopy");
91
my $bpath= dirname $backupfile;
92
93
unless (defined $class) {
94
ewarn("no matching file for any class for $source defined.");
95
# do not copy
96
$opt_d and -f $destfile and ($nobackup and unlink($destfile) or
97
(-d $bpath or mkpath($bpath,$debug,0755)) and move($destfile,$backupfile));
98
return;
99
}
100
warn "using class: $class\n" if $debug;
101
$sourcefile = "$ps/$class";
102
103
# do nothing if source and destination files are equal
104
if ($opt_update) {
105
# compare logically
106
if ($lastclass{$source}) {
107
# $source has already been copied last time
108
109
if ($lastclass{$source} ne $class) {
110
$logcomment = "\t# changed class" if $logfile;
111
} else {
112
if ($changed{"$source/$class"} or
113
$changed{"$source/postinst"} or
114
$changed{"$source/file-modes"}) {
115
$logcomment = "\t# changed file" if $logfile;
116
} else {
117
$logcomment = "\t# preserved (logical)" if $logfile;
118
$preserve = 1;
119
}
120
}
121
} else {
122
$logcomment = "\t# new (logical)" if $logfile;
123
}
124
} else {
125
# compare literally
126
127
if ( compare($sourcefile,$destfile)) {
128
$logcomment="\t# new (literal)";
129
} else {
130
$logcomment="\t# preserved (literal)" if $logfile;
131
$preserve = 1;
132
}
133
}
134
#if a package is being purged, our information about its config files is
135
#wrong, so first check if they exist. if not, don't preserve, but copy
136
if ($preserve && ! -e $destfile) {
137
$logcomment="\t# magically disappeared (maybe purged)";
138
$preserve=0;
139
}
140
141
print LOGFILE "$source\t$class$logcomment\n" if $logfile;
142
if ($preserve) {
143
ewarn("preserving $source \n");
144
return;
145
}
146
147
# if destination is a symlink and -l is given, complain about it
148
if ($opt_l && -l $destfile) {
149
ewarn("Destination $destfile is a symlink");
150
return;
151
}
152
153
# create subdirectories if they do not exist
154
mkpath($tpath,$debug,0755) unless -d $tpath;
155
156
# save existing file, add suffix .pre_fcopy
157
# what should I do if $destfile is a symlink?
158
$nobackup or (-f $destfile and
159
(-d $bpath or mkpath($bpath,$debug,0755)) and move($destfile,$backupfile));
160
if (copy($sourcefile,$destfile)) {
161
print "fcopy: copied $sourcefile to $destfile\n" ;
162
postinst($ps,$destfile,$class);
163
set_mode($ps,$destfile,$class);
164
} else {
165
ewarn("copy $sourcefile to $destfile failed. $!") ;
166
}
167
}
168
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
169
sub postinst {
170
171
my ($sourcefile,$destfile,$class) = @_;
172
return unless -x "$sourcefile/postinst";
173
warn "executing $sourcefile/postinst $class $destfile\n" if $debug;
174
system "$sourcefile/postinst $class $destfile";
175
}
176
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
177
sub name2num {
178
179
# convert names to numeric uid, gid
180
my ($user,$group) = @_;
181
my $uid = ($user =~ /^\d+$/) ? $user : getpwnam $user;
182
my $gid = ($group =~ /^\d+$/) ? $group : getgrnam $group;
183
warn "name2id $user = $uid ; $group = $gid\n" if $debug;
184
return ($uid,$gid);
185
}
186
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
187
sub set_mode {
188
189
# set target file's owner, group, mode and time
190
# use owner,group,mode from -m or from the file file-modes or
191
# use the values from the source file
192
my ($sourcefile,$destfile,$class) = @_;
193
my ($uid,$gid,$owner,$group,$mode);
194
# get mtime,uid,gid,mode from source file
195
my ($stime,@defmodes) = (stat("$sourcefile/$class"))[9,4,5,2];
196
197
if ($modeset) { # use -m values
198
($owner,$group,$mode) = @opt_modes;
199
} elsif (-f "$sourcefile/file-modes"){
200
($owner,$group,$mode) = read_file_mode("$sourcefile/file-modes",$class);
201
} else { # use values from source file
202
($owner,$group,$mode) = @defmodes;
203
}
204
205
($uid,$gid) = name2num($owner,$group);
206
warn "chown/chmod u:$uid g:$gid m:$mode $destfile\n" if $debug;
207
chown ($uid,$gid, $destfile) || ewarn("chown $owner $group $destfile failed. $!");
208
chmod ($mode, $destfile) || ewarn("chmod $mode $destfile failed. $!");
209
utime ($stime,$stime, $destfile) || ewarn("utime for $destfile failed. $!");
210
}
211
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
212
sub check_mopt {
213
214
# save and check -m options
215
$modeset = 1;
216
my $n = @opt_modes = split(/,/,$opt_m);
217
($n != 3) &&
218
die "fcopy: wrong number of options for -m. Exact 3 comma separated items needed.\n";
219
unless ($opt_modes[2] =~/^[0-7]+$/) {
220
die "fcopy: file mode should be an octal number. Value is: $opt_modes[2]\n";
221
}
222
$opt_modes[2] = oct($opt_modes[2]);
223
}
224
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
225
sub read_file_mode {
226
227
my ($modefile,$class) = @_;
228
my ($owner,$group,$mode,$fclass,@defaults);
229
230
warn "reading $modefile\n" if $verbose;
231
open (MODEFILE,"<$modefile") || die "fcopy: can't open $modefile\n";
232
while (<MODEFILE>) {
233
# skip empty lines
234
next if /^\s*$/;
235
($owner,$group,$mode,$fclass) = split;
236
$mode = oct($mode);
237
# class found
238
return ($owner,$group,$mode) if ($fclass eq $class);
239
# when no class is specified use data for all classes
240
$fclass or @defaults = ($owner,$group,$mode);
241
}
242
close MODEFILE;
243
return @defaults if @defaults;
244
ewarn("no modes found for $class in $modefile");
245
}
246
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
247
sub read_classes {
248
249
# read class names from a file
250
my $file = shift;
251
my @classes;
252
253
open(CLASS,$file) || die "fcopy: can't open class file $file. $!\n";
254
while (<CLASS>) {
255
next if /^#/;
256
push @classes, split;
257
}
258
close CLASS;
259
return @classes;
260
}
261
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
262
sub ewarn {
263
264
# print warnings and set error to 1
265
$error = 1;
266
warn "fcopy: @_\n";
267
}
268
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
269
sub read_status {
270
my $n = my @status_files=split(/,/,$opt_update);
271
($n != 2) && die "fcopy: need both log and changes file\n";
272
273
open(LASTLOG,$status_files[0]);
274
while (<LASTLOG>) {
275
s/\#.*//g;
276
chomp;
277
my ($source,$class) = split(/\s/,$_,2);
278
$class=~s/\s*//g;
279
$lastclass{$source} = $class;
280
}
281
close(LASTLOG);
282
283
$_=$source; /([^\/]+)$/;
284
my $source_base = $1;
285
open(CHANGES,$status_files[1]);
286
while (<CHANGES>) {
287
s/\#.*//g;
288
chomp;
289
m#$source_base/(\S+)$# and $changed{$1} = 1;
290
}
291
close(CHANGES);
292
}
293
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
294
sub read_files {
295
296
# read list of files
297
# lines starting with # are comments
298
my $file = shift;
299
my @list;
300
301
open(LIST,"<$file") || die "fcopy: Can't open file $file\n";
302
while (<LIST>) {
303
next if /^#/;
304
chomp;
305
push @list, $_;
306
}
307
return @list;
308
}
309
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
310
sub usage {
311
312
print << "EOF";
313
fcopy, copy files using classes. $version
314
315
Copyright (C) 2001-2003 by Thomas Lange
316
317
Usage: fcopy [OPTION] ... SOURCE ...
318
319
-B Remove backup file.
320
-c class[,class] Define classes.
321
-C file Read classes from file.
322
-d Remove target file if no class applies.
323
-D Create debug output.
324
-F file Read list of sources from file.
325
-h Show summary of options.
326
-i Exit with 0 when no class applies.
327
-I dir[,dir] Override default list of ignored subdirectories
328
-l Do not copy if destination is a symbolic link.
329
-L file Log destination and used class to file
330
-m user,group,mode Set user, group and mode for copied files.
331
-M Same as -m root,root,0644
332
-P log,changes Copy if class or source for class has changed since
333
previous run
334
-r Copy recursivly but skip ignored directories.
335
-s source_dir Look for source files relative to source_dir.
336
-t target_dir Copy files relativ to target_dir.
337
-b backup_dir Where to save backups of overwritten files
338
-v Create verbose output.
339
340
Report bugs to <lange\@informatik.uni-koeln.de>.
341
EOF
342
exit 0;
343
}
344
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
345
sub rfilter {
346
347
# Filter for recursive copying
348
349
# are we in a directory ? should we ignore it ?
350
my $location=$_;
351
(-d and (! grep $location eq $_,@ignoredirs )) or return 0;
352
# a directory without subdirs has two hard links
353
# don't count @ignoredirs as subdirs
354
my $subdirs=(lstat($_))[3] - 2 - grep(-d,@ignoredirs);
355
# push leaf
356
push @rlist,$File::Find::name unless $subdirs;
357
}
358
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
359
# main program
360
361
$|=1;
362
getopts('Ms:t:rm:vidDc:C:hF:lL:P:Bb:I:');
363
$opt_h && usage;
364
$opt_M and $opt_m="root,root,0644"; # set default modes
365
$opt_m && check_mopt();
366
$nobackup = $opt_B || $ENV{FCOPY_NOBACKUP} || 0;
367
$verbose = $opt_v || $ENV{verbose} || 0;
368
$debug = $opt_D || $ENV{debug} || 0;
369
$source = $opt_s || $ENV{FAI} && "$ENV{FAI}/files" || `pwd`;
370
$target = $opt_t || $ENV{FAI_ROOT} || $ENV{target};
371
$target eq "/" or $ENV{'ROOTCMD'}="chroot $target";
372
$logfile = $opt_L || $ENV{LOGDIR} && "$ENV{LOGDIR}/fcopy.log" || 0;
373
$logfile and (open(LOGFILE,">> $logfile") || die("can't open logfile: $!"));
374
$backupdir = $opt_b || $ENV{FAI_BACKUPDIR};
375
376
if ($ENV{FCOPY_LASTLOG} and $ENV{FCOPY_UPDATELOG}) {
377
$opt_update = "$ENV{FCOPY_LASTLOG},$ENV{FCOPY_UPDATELOG}";
378
}
379
$opt_P and $opt_update=$opt_P;
380
$opt_update and read_status();
381
382
#for postinst scripts
383
$ENV{'FAI_ROOT'}=$ENV{'target'}=$target;
384
385
# last class has highest priority
386
$ENV{classes} and @classes = reverse split /\s+/,$ENV{classes};
387
$opt_c and @classes = split /,/,$opt_c;
388
$opt_C and @classes = read_classes($opt_C);
389
warn join ' ','Classes:',@classes,"\n" if $debug;
390
$opt_F and @ARGV = read_files($opt_F);
391
$ENV{'FCOPY_IGNOREDIRS'} and @ignoredirs = split /\s+/,$ENV{'FCOPY_IGNOREDIRS'};
392
$opt_I and @ignoredirs = split /,/,$opt_I;
393
394
die "fcopy: source undefined\n" unless $source;
395
die "fcopy: target undefined\n" unless $target;
396
397
if ($opt_r) {
398
foreach (@ARGV) { $_="$source/$_"; } # add prefix to list of directories
399
File::Find::find(\&rfilter,@ARGV);
400
foreach (@rlist) { $_=~ s#^$source/##; } # remove prefix from all fines found
401
warn "List of all files found by File::Find::find: @rlist" if $debug;
402
@ARGV = @rlist;
403
}
404
405
foreach (@ARGV) { copy_one($source,$_,$target); }
406
$opt_i && exit 0; # ignore any warning
407
exit $error;
Loggerhead is a web-based interface for Breezy
Version: 2.0.1