chiark / gitweb /
bugfixes
[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 Ian Jackson <ian@chiark.greenend.org.uk>
9 #  Copyright (C) 1999 Peter Maydell <pmaydell@chiark.greenend.org.uk>
10 #
11 # This is free software; you can redistribute it and/or modify it under the
12 # terms of the GNU General Public License as published by the Free Software
13 # Foundation; either version 2, or (at your option) any later version.
14 #
15 # This is distributed in the hope that it will be useful, but WITHOUT ANY
16 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
17 # FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
18 # details.
19 #
20 # You should have received a copy of the GNU General Public License along
21 # with this program; if not, write to the Free Software Foundation, Inc.,
22 # 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
23
24 require IO::File;
25
26 sub printdate () {
27     print scalar(localtime),"\n";
28 }
29
30 # Set status info -- we write the current status to a file 
31 # so if we hang or crash the last thing written to the file
32 # will tell us where we were when things went pear-shaped.
33 sub setstatus ($) {
34     open S, ">this-status.new" or die $!;
35     print S $_[0],"\n" or die $!;
36     close S or die $!;
37     rename "this-status.new","this-status" or die $!;
38 }
39
40 # startprocess, endprocesses, killprocesses are 
41 # used to implement the funky pipeline stuff.
42 sub startprocess ($$$) {
43     my ($i,$o,$c) = @_;
44     print LOG "  $c\n" or die $!;
45     print "  $c\n" or die $!;
46     defined($p= fork) or die $!;
47     if ($p) { $processes{$p}= $c; return; }
48     open STDIN,"$i" or die "$c stdin $i: $!";
49     open STDOUT,"$o" or die "$c stdout $o: $!";
50     &closepipes;
51     exec $c; die "$c: $!";
52 }
53
54 sub rewind_raw () {
55     system "mt -f $tape rewind"; $? and die $?;
56 }
57
58 sub readtapeid_raw () {
59     open T, ">>TAPEID" or die $!; close T;
60     unlink 'TAPEID' or die $!;
61     rewind_raw();
62     system "mt -f $tape setblk $blocksizebytes"; $? and die $?;
63     system "dd if=$tape bs=${blocksize}b count=10 ".
64            "| tar -b$blocksize -vvxf - TAPEID";
65 }
66
67 sub writetapeid ($$) {
68     open T, ">TAPEID" or die $!;
69     print T "$_[0]\n$_[1]\n" or die $!;
70     close T or die $!;
71
72     system "tar -b$blocksize -vvcf TAPEID.tar TAPEID"; $? and die $?;
73     system "dd if=TAPEID.tar of=$ntape bs=${blocksize}b count=10";
74     $? and die $?;
75 }
76
77 sub endprocesses () {
78     while (keys %processes) {
79         $p= waitpid(-1,0) or die "wait: $!";
80         if (!exists $processes{$p}) { warn "unknown pid exited: $p, code $?\n"; next; }
81         $c= $processes{$p};
82         delete $processes{$p};
83         $? && die "error: command gave code $?: $c\n";
84     }
85     print LOG "  ok\n" or die $!;
86     print "  ok\n" or die $!;
87 }
88
89 sub killprocesses {
90     for $p (keys %processes) {
91         kill 15,$p or warn "kill process $p: $!";
92     }
93     undef %processes;
94 }
95
96 # Read a fsys.foo filesystem group definition file.
97 # Syntax is: empty lines and those beginning with '#' are ignored.
98 # Trailing whitespace is ignored. Lines of the form 'prefix foo bar'
99 # are handled specially, as arex lines 'exclude regexp'; otherwise 
100 # we just shove the line into @fsys and let parsefsys deal with it.
101
102 sub readfsysfile ($) {
103     my ($fn) = @_;
104     my ($fh,$sfn);
105     $fh= new IO::File "$fn", "r" or die "cannot open fsys file $fn ($!).\n";
106     for (;;) {
107         $!=0; $_= <$fh> or die "unexpected EOF in $fn ($!)\n";
108         chomp; s/\s*$//;
109         last if m/^end$/;
110         next unless m/\S/;
111         next if m/^\#/;
112         if (m/^prefix\s+(\w+)\s+(\S.*\S)$/) {
113             $prefix{$1}= $2;
114         } elsif (m/^prefix\-df\s+(\w+)\s+(\S.*\S)$/) {
115             $prefixdf{$1}= $2;
116         } elsif (m/^excludedir\s+(\S.*\S)$/) {
117             push @excldir,$1;
118         } elsif (m/^exclude\s+(\S.*\S)$/) {
119             push @excl,$1;
120         } elsif (m/^include\s+(\S.*\S)$/) {
121             $sfn = $1;
122             $sfn =~ s/^\./fsys./;
123             $sfn = "$etc/$sfn" unless $sfn =~ m,^/,;
124             readfsysfile($sfn);
125         } else {
126             push @fsys,$_;
127         }
128     }
129     close $fh or die $!;
130 }
131
132 sub readfsys ($) {
133     my ($fsnm) = @_;
134     my ($fsf);
135     $fsf= "$etc/fsys.$fsnm";
136     stat $fsf or die "Filesystems $fsnm unknown ($!).\n";
137     readfsysfile($fsf);
138 }
139
140 # Parse a line from a filesystem definition file. We expect the line
141 # to be in $tf.
142 sub parsefsys () {
143     my ($dopts,$dopt);
144     if ($tf =~ m#^(/\S*)\s+(\w+)([,0-9a-z]+)$#) {
145         # Line of form '/file/system    dumptype[,options]'
146         $atf= $1;
147         $tm= $2;
148         $dopts= $3;
149         $prefix= '<local>';
150         stat $atf or die "stat $atf: $!";
151         -d _ or die "not a dir: $atf";
152         $rstr= '';
153     } elsif ($tf =~ m#^(/\S*)\s+(\w+)([,0-9a-z]+)\s+(\w+)$#) {
154         # Line of form '/file/system dumptype[,options] prefix'
155         # (used for remote backups)
156         $atf= $1;
157         $tm= $2;
158         $dopts= $3;
159         $prefix= $4;
160         defined($prefix{$prefix}) or die "prefix $prefix in $tf ?\n";
161         $rstr= $prefix{$prefix}.' ';
162     } else {
163         die "fsys $tf ?";
164     }
165     undef %dopt;
166     foreach $dopt (split /\,/,$dopts) {
167         if (grep { $dopt eq $_ } qw(gz)) {
168             $dopt{$dopt}= 'y';
169         } elsif ($dopt =~ m/\=/ && grep { $` eq $_ } qw(gz)) {
170             $dopt{$`}= $';
171         } else {
172             die "unknown option $dopt";
173         }
174     }
175 }
176
177 sub openlog () {
178     unlink 'log';
179     $u= umask(007);
180     open LOG, ">log" or die $!;
181     umask $u;
182     select(LOG); $|=1; select(STDOUT);
183 }
184
185 $SIG{'__DIE__'}= 'killprocesses';
186
187 1;