chiark / gitweb /
start 6.0.1~
[chiark-utils.git] / backup / backuplib.pl
1 # backuplib.pl
2 # core common routines
3 #
4 # This file is part of chiark backup, a system for backing up GNU/Linux and
5 # other UN*X-compatible machines, as used on chiark.greenend.org.uk.
6 #
7 # chiark backup is:
8 #  Copyright (C) 1997-1998,2000-2001,2007
9 #                     Ian Jackson <ian@chiark.greenend.org.uk>
10 #  Copyright (C) 1999 Peter Maydell <pmaydell@chiark.greenend.org.uk>
11 #
12 # This is free software; you can redistribute it and/or modify it under the
13 # terms of the GNU General Public License as published by the Free Software
14 # Foundation; either version 3, or (at your option) any later version.
15 #
16 # This is distributed in the hope that it will be useful, but WITHOUT ANY
17 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
18 # FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
19 # details.
20 #
21 # You should have received a copy of the GNU General Public License along
22 # with this program; if not, consult the Free Software Foundation's
23 # website at www.fsf.org, or the GNU Project website at www.gnu.org.
24
25 require IO::File;
26
27 $nice='nice ' if !defined $nice;
28
29 sub printdate () {
30     print scalar(localtime),"\n";
31 }
32
33 # Set status info -- we write the current status to a file 
34 # so if we hang or crash the last thing written to the file
35 # will tell us where we were when things went pear-shaped.
36 sub setstatus ($) {
37     open S, ">this-status.new" or die $!;
38     print S $_[0],"\n" or die $!;
39     close S or die $!;
40     rename "this-status.new","this-status" or die $!;
41 }
42
43 # startprocess, endprocesses, killprocesses are 
44 # used to implement the funky pipeline stuff.
45 sub startprocess ($$$) {
46     my ($i,$o,$c) = @_;
47     pboth("  $c\n");
48     defined($p= fork) or die $!;
49     if ($p) { $processes{$p}= $c; return; }
50     open STDIN,"$i" or die "$c stdin $i: $!";
51     open STDOUT,"$o" or die "$c stdout $o: $!";
52     &closepipes;
53     exec $c; die "$c: $!";
54 }
55
56 sub rewind_raw () {
57     runsystem("mt -f $tape rewind");
58 }
59
60 sub readtapeid_raw () {
61     open T, ">>TAPEID" or die $!; close T;
62     unlink 'TAPEID' or die $!;
63     rewind_raw();
64     system "mt -f $tape setblk $blocksizebytes"; $? and die $?;
65     system "dd if=$tape bs=${blocksize}b count=10 ".
66            "| tar -b$blocksize -vvxf - TAPEID";
67 }
68
69 sub runsystem ($) {
70     pboth("    $_[0]\n");
71     system $_[0];
72     $? and die $?;
73 }
74
75 sub pboth ($) {
76     my ($str) = @_;
77     print LOG $str or die $!;
78     print $str or die $!;
79 }
80
81 sub nexttapefile ($) {
82     my ($what) = @_;
83     $currenttapefilenumber++;
84     $currenttapefilename= $what;
85     pboth(sprintf "writing tape file #%d (mt fsf %d): %s\n",
86           $currenttapefilenumber, $currenttapefilenumber-1, $what);
87 }
88
89 sub writetapeid ($$) {
90     open T, ">TAPEID" or die $!;
91     print T "$_[0]\n$_[1]\n" or die $!;
92     close T or die $!;
93
94     $currenttapefilenumber= 0;
95     nexttapefile('TAPEID');
96
97     system "tar -b$blocksize -vvcf TAPEID.tar TAPEID"; $? and die $?;
98     system "dd if=TAPEID.tar of=$ntape bs=${blocksize}b count=10";
99     $? and die $?;
100 }
101
102 sub endprocesses () {
103     while (keys %processes) {
104         $p= waitpid(-1,0) or die "wait: $!";
105         if (!exists $processes{$p}) { warn "unknown pid exited: $p, code $?\n"; next; }
106         $c= $processes{$p};
107         delete $processes{$p};
108         $? && die "error: command gave code $?: $c\n";
109     }
110     pboth("  ok\n");
111 }
112
113 sub killprocesses {
114     for $p (keys %processes) {
115         kill 15,$p or warn "kill process $p: $!";
116     }
117     undef %processes;
118 }
119
120 # Read a fsys.foo filesystem group definition file.
121 # Syntax is: empty lines and those beginning with '#' are ignored.
122 # Trailing whitespace is ignored. Lines of the form 'prefix foo bar'
123 # are handled specially, as arex lines 'exclude regexp'; otherwise 
124 # we just shove the line into @fsys and let parsefsys deal with it.
125
126 sub readfsysfile ($) {
127     my ($fn) = @_;
128     my ($fh,$sfn);
129     $fh= new IO::File "$fn", "r" or die "cannot open fsys file $fn ($!).\n";
130     for (;;) {
131         $!=0; $_= <$fh> or die "unexpected EOF in $fn ($!)\n";
132         chomp; s/\s*$//;
133         last if m/^end$/;
134         next unless m/\S/;
135         next if m/^\#/;
136         if (m/^prefix\s+(\w+)\s+(\S.*\S)$/) {
137             $prefix{$1}= $2;
138         } elsif (m/^prefix\-df\s+(\w+)\s+(\S.*\S)$/) {
139             $prefixdf{$1}= $2;
140         } elsif (m/^snap(?:\=(\w+))?\s+(\w+)\s+(\w+)$/) {
141             push @excldir,$1;
142         } elsif (m/^excludedir\s+(\S.*\S)$/) {
143             push @excldir,$1;
144         } elsif (m/^exclude\s+(\S.*\S)$/) {
145             push @excl,$1;
146         } elsif (m/^include\s+(\S.*\S)$/) {
147             $sfn = $1;
148             $sfn =~ s/^\./fsys./;
149             $sfn = "$etc/$sfn" unless $sfn =~ m,^/,;
150             readfsysfile($sfn);
151         } else {
152             push @fsys,$_;
153         }
154     }
155     close $fh or die $!;
156 }
157
158 sub readfsys ($) {
159     my ($fsnm) = @_;
160     my ($fsf);
161     $fsf= "$etc/fsys.$fsnm";
162     stat $fsf or die "Filesystems $fsnm unknown ($!).\n";
163     readfsysfile($fsf);
164 }
165
166 # Parse a line from a filesystem definition file. We expect the line
167 # to be in $tf.
168 sub parsefsys () {
169     my ($dopts,$dopt);
170     if ($tf =~ m#^(/\S*)\s+(\w+)([,=0-9a-z]*)$#) {
171         # Line of form '[/device:]/file/system  dumptype[,options]'
172         $atf= $1;
173         $tm= $2;
174         $dopts= $3;
175         $prefix= '<local>';
176         $pcstr= '';
177         $rstr= '';
178     } elsif ($tf =~ m#^(/\S*)\s+(\w+)([,=0-9a-z]*)\s+(\w+)$#) {
179         # Line of form '[/device:]/file/system dumptype[,options] prefix'
180         # (used for remote backups)
181         $atf= $1;
182         $tm= $2;
183         $dopts= $3;
184         $prefix= $4;
185         $pcstr= "$prefix:";
186         defined($prefix{$prefix}) or die "prefix $prefix in $tf ?\n";
187         $rstr= $prefix{$prefix}.' ';
188     } else {
189         die "fsys $tf ?";
190     }
191
192     $fsidstr= $pcstr.$atf;
193     $fsidstr =~ s/[,+]/+$&/g;
194     $fsidstr =~ s#/#,#g;
195     $fsidfile= "/var/lib/chiark-backup/incstamp,$fsidstr";
196
197     $dev = $atf =~ s,^(.*)\:,, ? $1 : '';
198
199     if (!length $pcstr) {
200         stat $atf or die "stat $atf: $!";
201         -d _ or die "not a dir: $atf";
202     }
203
204     undef %dopt;
205     foreach $dopt (split /\,/,$dopts) {
206         if (grep { $dopt eq $_ } qw(gz noinc)) {
207             $dopt{$dopt}= 'y';
208         } elsif (grep { $dopt eq $_ } qw(snap)) {
209             $dopt{$dopt}= $dopt;
210         } elsif ($dopt =~ m/\=/ && grep { $` eq $_ } qw(gz snap)) {
211             $dopt{$`}= $';
212         } elsif (length $dopt) {
213             die "unknown option $dopt (in $dopts $tf)";
214         }
215     }
216
217     my ($gzo);
218     foreach $gzo (qw(gz gzi)) {
219         if ($dopt{$gzo} eq 'y') {
220             $$gzo= '1';
221         } elsif ($dopt{$gzo} =~ m/^\d$/) {
222             $$gzo= $dopt{$gzo};
223         } elsif (defined $dopt{$gzo}) {
224             die "$tf bad $gzo";
225         } else {
226             $$gzo= '';
227         }
228     }
229
230     if (length $dopt{'snap'}) {
231         length $dev or die "$pcstr:$atf no device but needed for snap";
232     }
233 }
234
235 sub execute ($) {
236     pboth("  $_[0]\n");
237     system $_[0]; $? and die "$_[0] $?";
238 }
239
240 sub prepfsys () {
241     $dev_print= $dev;
242     $atf_print= $atf;
243     
244     if (length $dopt{'snap'}) {
245         
246         system('snap-drop'); $? and die $?;
247         
248         $snapscripts= '/etc/chiark-backup/snap';
249         $snapbase= "$rstr $snapscripts/$dopt{'snap'}";
250         $snapargs= "/var/lib/chiark-backup";
251
252         $snapsnap= "$snapbase snap $snapargs $dev $atf";
253         $snapdrop= "$snapbase drop $snapargs";
254
255         open SD, ">snap-drop.new" or die $!;
256         print SD $snapdrop,"\n" or die $!;
257         close SD or die $!;
258         rename "snap-drop.new","snap-drop" or die $!;
259
260         execute($snapsnap);
261
262         $dev_nosnap= $dev;
263         $atf_nosnap= $atf;
264         $dev= "/var/lib/chiark-backup/snap-device";
265         $atf= "/var/lib/chiark-backup/snap-mount";
266     }
267 }
268
269 sub finfsys () {
270     if (length $dopt{'snap'}) {
271         system('snap-drop'); $? and die $?;
272     }
273 }
274
275 sub openlog () {
276     unlink 'log';
277     $u= umask(007);
278     open LOG, ">log" or die $!;
279     umask $u;
280     select(LOG); $|=1; select(STDOUT);
281 }
282
283 $SIG{'__DIE__'}= 'killprocesses';
284
285 1;