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 readtapeid_raw () {
  55     open T, ">>TAPEID" or die $!; close T;
  56     unlink 'TAPEID' or die $!;
  57     system "mt -f $tape rewind"; $? and die $?;
  58     system "mt -f $tape setblk $blocksizebytes"; $? and die $?;
  59     system "dd if=$tape bs=${blocksize}b count=10 ".
  60            "| tar -b$blocksize -vvxf - TAPEID";
  61 }
  62
  63 sub writetapeid ($) {
  64     open T, ">TAPEID" or die $!;
  65     print T "$_[0]\n" or die $!;
  66     close T or die $!;
  67
  68     system "tar -b$blocksize -vvcf TAPEID.tar TAPEID"; $? and die $?;
  69     system "dd if=TAPEID.tar of=$ntape bs=${blocksize}b count=10";
  70     $? and die $?;
  71 }
  72
  73 sub endprocesses () {
  74     while (keys %processes) {
  75         $p= waitpid(-1,0) or die "wait: $!";
  76         if (!exists $processes{$p}) { warn "unknown pid exited: $p, code $?\n"; next; }
  77         $c= $processes{$p};
  78         delete $processes{$p};
  79         $? && die "error: command gave code $?: $c\n";
  80     }
  81     print LOG "  ok\n" or die $!;
  82     print "  ok\n" or die $!;
  83 }
  84
  85 sub killprocesses {
  86     for $p (keys %processes) {
  87         kill 15,$p or warn "kill process $p: $!";
  88     }
  89     undef %processes;
  90 }
  91
  92 # Read a fsys.foo filesystem group definition file.
  93 # Syntax is: empty lines and those beginning with '#' are ignored.
  94 # Trailing whitespace is ignored. Lines of the form 'prefix foo bar'
  95 # are handled specially, as arex lines 'exclude regexp'; otherwise
  96 # we just shove the line into @fsys and let parsefsys deal with it.
  97
  98 sub readfsysfile ($) {
  99     my ($fn) = @_;
 100     my ($fh,$sfn);
 101     $fh= new IO::File "$fn", "r" or die "cannot open fsys file $fn ($!).\n";
 102     for (;;) {
 103         $!=0; $_= <$fh> or die "unexpected EOF in $fn ($!)\n";
 104         chomp; s/\s*$//;
 105         last if m/^end$/;
 106         next unless m/\S/;
 107         next if m/^\#/;
 108         if (m/^prefix\s+(\w+)\s+(\S.*\S)$/) {
 109             $prefix{$1}= $2;
 110         } elsif (m/^prefix\-df\s+(\w+)\s+(\S.*\S)$/) {
 111             $prefixdf{$1}= $2;
 112         } elsif (m/^excludedir\s+(\S.*\S)$/) {
 113             push @excldir,$1;
 114         } elsif (m/^exclude\s+(\S.*\S)$/) {
 115             push @excl,$1;
 116         } elsif (m/^include\s+(\S.*\S)$/) {
 117             $sfn = $1;
 118             $sfn =~ s/^\./fsys./;
 119             $sfn = "$etc/$sfn" unless $sfn =~ m,^/,;
 120             readfsysfile($sfn);
 121         } else {
 122             push @fsys,$_;
 123         }
 124     }
 125     close $fh or die $!;
 126 }
 127
 128 sub readfsys ($) {
 129     my ($fsnm) = @_;
 130     my ($fsf);
 131     $fsf= "$etc/fsys.$fsnm";
 132     stat $fsf or die "Filesystems $fsnm unknown ($!).\n";
 133     readfsysfile($fsf);
 134 }
 135
 136 # Parse a line from a filesystem definition file. We expect the line
 137 # to be in $tf.
 138 sub parsefsys () {
 139     if ($tf =~ m,^(/\S*)\s+(\w+)$,) {
 140         # Line of form '/file/system    dumptype'
 141         $atf= $1;
 142         $tm= $2;
 143         $prefix= '<local>';
 144         stat $atf or die "stat $atf: $!";
 145         -d _ or die "not a dir: $atf";
 146         $rstr= '';
 147     } elsif ($tf =~ m,^(/\S*)\s+(\w+)\s+(\w+)$,) {
 148         # Line of form '/file/system dumptype prefix'
 149         # (used for remote backups, I think)
 150         $atf= $1;
 151         $tm= $2;
 152         $prefix= $3;
 153         defined($prefix{$prefix}) or die "prefix $prefix in $tf ?\n";
 154         $rstr= $prefix{$prefix}.' ';
 155     }
 156 }
 157
 158 sub openlog () {
 159     unlink 'log';
 160     $u= umask(007);
 161     open LOG, ">log" or die $!;
 162     umask $u;
 163     select(LOG); $|=1; select(STDOUT);
 164 }
 165
 166 $SIG{'__DIE__'}= 'killprocesses';
 167
 168 1;