chiark / gitweb /
Clean up a bit and add copyright notices.
[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 sub printdate () {
25     print scalar(localtime),"\n";
26 }
27
28 # Set status info -- we write the current status to a file 
29 # so if we hang or crash the last thing written to the file
30 # will tell us where we were when things went pear-shaped.
31 sub setstatus ($) {
32     open S, ">this-status.new" or die $!;
33     print S $_[0],"\n" or die $!;
34     close S or die $!;
35     rename "this-status.new","this-status" or die $!;
36 }
37
38 # startprocess, endprocesses, killprocesses are 
39 # used to implement the funky pipeline stuff.
40 sub startprocess ($$$) {
41     my ($i,$o,$c) = @_;
42     print LOG "  $c\n" or die $!;
43     print "  $c\n" or die $!;
44     defined($p= fork) or die $!;
45     if ($p) { $processes{$p}= $c; return; }
46     open STDIN,"$i" or die "$c stdin $i: $!";
47     open STDOUT,"$o" or die "$c stdout $o: $!";
48     &closepipes;
49     exec $c; die "$c: $!";
50 }
51
52 sub endprocesses () {
53     while (keys %processes) {
54         $p= waitpid(-1,0) or die "wait: $!";
55         if (!exists $processes{$p}) { warn "unknown pid exited: $p, code $?\n"; next; }
56         $c= $processes{$p};
57         delete $processes{$p};
58         $? && die "error: command gave code $?: $c\n";
59     }
60     print LOG "  ok\n" or die $!;
61     print "  ok\n" or die $!;
62 }
63
64 sub killprocesses {
65     for $p (keys %processes) {
66         kill 15,$p or warn "kill process $p: $!";
67     }
68     undef %processes;
69 }
70
71 # Read a fsys.foo filesystem group definition file.
72 # Syntax is: empty lines and those beginning with '#' are ignored.
73 # Trailing whitespace is ignored. Lines of the form 'prefix foo bar'
74 # are handled specially, as arex lines 'exclude regexp'; otherwise 
75 # we just shove the line into @fsys and let parsefsys deal with it.
76 sub readfsys ($) {
77     my ($fsnm) = @_;
78     open F, "$etc/fsys.$fsnm" or die "Filesystems $fsnm unknown ($!).\n";
79     for (;;) {
80         $_= <F> or die "unexpected EOF in $etc/fsys.$fsnm\n"; chomp; s/\s*$//;
81         last if m/^end$/;
82         next unless m/\S/;
83         next if m/^\#/;
84         if (m/^prefix\s+(\w+)\s+(\S.*\S)$/) {
85             $prefix{$1}= $2;
86         } elsif (m/^prefix\-df\s+(\w+)\s+(\S.*\S)$/) {
87             $prefixdf{$1}= $2;
88         } elsif (m/^excludedir\s+(\S.*\S)$/) {
89             push @excldir,$1;
90         } elsif (m/^exclude\s+(\S.*\S)$/) {
91             push @excl,$1;
92         } else {
93             push @fsys,$_;
94         }
95     }
96     close F or die $!;
97 }
98
99 # Parse a line from a filesystem definition file. We expect the line
100 # to be in $tf.
101 sub parsefsys () {
102     if ($tf =~ m,^(/\S*)\s+(\w+)$,) {
103         # Line of form '/file/system    dumptype'
104         $atf= $1;
105         $tm= $2;
106         $prefix= '<local>';
107         stat $atf or die "stat $atf: $!";
108         -d _ or die "not a dir: $atf";
109         $rstr= '';
110     } elsif ($tf =~ m,^(/\S*)\s+(\w+)\s+(\w+)$,) {
111         # Line of form '/file/system dumptype prefix'
112         # (used for remote backups, I think)
113         $atf= $1;
114         $tm= $2;
115         $prefix= $3;
116         defined($prefix{$prefix}) or die "prefix $prefix in $tf ?\n";
117         $rstr= $prefix{$prefix}.' ';
118     }
119 }
120
121 sub openlog () {
122     unlink 'log';
123     $u= umask(007);
124     open LOG, ">log" or die $!;
125     umask $u;
126     select(LOG); $|=1; select(STDOUT);
127 }
128
129 $SIG{'__DIE__'}= 'killprocesses';
130
131 1;