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 $nice='nice ' if !defined $nice;
  27
  28 sub printdate () {
  29     print scalar(localtime),"\n";
  30 }
  31
  32 # Set status info -- we write the current status to a file
  33 # so if we hang or crash the last thing written to the file
  34 # will tell us where we were when things went pear-shaped.
  35 sub setstatus ($) {
  36     open S, ">this-status.new" or die $!;
  37     print S $_[0],"\n" or die $!;
  38     close S or die $!;
  39     rename "this-status.new","this-status" or die $!;
  40 }
  41
  42 # startprocess, endprocesses, killprocesses are
  43 # used to implement the funky pipeline stuff.
  44 sub startprocess ($$$) {
  45     my ($i,$o,$c) = @_;
  46     print LOG "  $c\n" or die $!;
  47     print "  $c\n" or die $!;
  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     system "mt -f $tape rewind"; $? and die $?;
  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 writetapeid ($$) {
  70     open T, ">TAPEID" or die $!;
  71     print T "$_[0]\n$_[1]\n" or die $!;
  72     close T or die $!;
  73
  74     system "tar -b$blocksize -vvcf TAPEID.tar TAPEID"; $? and die $?;
  75     system "dd if=TAPEID.tar of=$ntape bs=${blocksize}b count=10";
  76     $? and die $?;
  77 }
  78
  79 sub endprocesses () {
  80     while (keys %processes) {
  81         $p= waitpid(-1,0) or die "wait: $!";
  82         if (!exists $processes{$p}) { warn "unknown pid exited: $p, code $?\n"; next; }
  83         $c= $processes{$p};
  84         delete $processes{$p};
  85         $? && die "error: command gave code $?: $c\n";
  86     }
  87     print LOG "  ok\n" or die $!;
  88     print "  ok\n" or die $!;
  89 }
  90
  91 sub killprocesses {
  92     for $p (keys %processes) {
  93         kill 15,$p or warn "kill process $p: $!";
  94     }
  95     undef %processes;
  96 }
  97
  98 # Read a fsys.foo filesystem group definition file.
  99 # Syntax is: empty lines and those beginning with '#' are ignored.
 100 # Trailing whitespace is ignored. Lines of the form 'prefix foo bar'
 101 # are handled specially, as arex lines 'exclude regexp'; otherwise
 102 # we just shove the line into @fsys and let parsefsys deal with it.
 103
 104 sub readfsysfile ($) {
 105     my ($fn) = @_;
 106     my ($fh,$sfn);
 107     $fh= new IO::File "$fn", "r" or die "cannot open fsys file $fn ($!).\n";
 108     for (;;) {
 109         $!=0; $_= <$fh> or die "unexpected EOF in $fn ($!)\n";
 110         chomp; s/\s*$//;
 111         last if m/^end$/;
 112         next unless m/\S/;
 113         next if m/^\#/;
 114         if (m/^prefix\s+(\w+)\s+(\S.*\S)$/) {
 115             $prefix{$1}= $2;
 116         } elsif (m/^prefix\-df\s+(\w+)\s+(\S.*\S)$/) {
 117             $prefixdf{$1}= $2;
 118         } elsif (m/^excludedir\s+(\S.*\S)$/) {
 119             push @excldir,$1;
 120         } elsif (m/^exclude\s+(\S.*\S)$/) {
 121             push @excl,$1;
 122         } elsif (m/^include\s+(\S.*\S)$/) {
 123             $sfn = $1;
 124             $sfn =~ s/^\./fsys./;
 125             $sfn = "$etc/$sfn" unless $sfn =~ m,^/,;
 126             readfsysfile($sfn);
 127         } else {
 128             push @fsys,$_;
 129         }
 130     }
 131     close $fh or die $!;
 132 }
 133
 134 sub readfsys ($) {
 135     my ($fsnm) = @_;
 136     my ($fsf);
 137     $fsf= "$etc/fsys.$fsnm";
 138     stat $fsf or die "Filesystems $fsnm unknown ($!).\n";
 139     readfsysfile($fsf);
 140 }
 141
 142 # Parse a line from a filesystem definition file. We expect the line
 143 # to be in $tf.
 144 sub parsefsys () {
 145     my ($dopts,$dopt);
 146     if ($tf =~ m#^(/\S*)\s+(\w+)([,=0-9a-z]*)$#) {
 147         # Line of form '[/device:]/file/system  dumptype[,options]'
 148         $atf= $1;
 149         $tm= $2;
 150         $dopts= $3;
 151         $prefix= '<local>';
 152         $pcstr= '';
 153         stat $atf or die "stat $atf: $!";
 154         -d _ or die "not a dir: $atf";
 155         $rstr= '';
 156     } elsif ($tf =~ m#^(/\S*)\s+(\w+)([,=0-9a-z]*)\s+(\w+)$#) {
 157         # Line of form '[/device:]/file/system dumptype[,options] prefix'
 158         # (used for remote backups)
 159         $atf= $1;
 160         $tm= $2;
 161         $dopts= $3;
 162         $prefix= $4;
 163         $pcstr= "$prefix:";
 164         defined($prefix{$prefix}) or die "prefix $prefix in $tf ?\n";
 165         $rstr= $prefix{$prefix}.' ';
 166     } else {
 167         die "fsys $tf ?";
 168     }
 169
 170     $dev = $atf =~ s,^(.*)\:,, ? $1 : '';
 171
 172     undef %dopt;
 173     foreach $dopt (split /\,/,$dopts) {
 174         if (grep { $dopt eq $_ } qw(gz)) {
 175             $dopt{$dopt}= 'y';
 176         } elsif ($dopt =~ m/\=/ && grep { $` eq $_ } qw(gz)) {
 177             $dopt{$`}= $';
 178         } elsif (length $dopt) {
 179             die "unknown option $dopt (in $dopts $tf)";
 180         }
 181     }
 182
 183     my ($gzo);
 184     foreach $gzo (qw(gz gzi)) {
 185         if ($dopt{$gzo} eq 'y') {
 186             $$gzo= '1';
 187         } elsif ($dopt{$gzo} =~ m/^\d$/) {
 188             $$gzo= $dopt{$gzo};
 189         } elsif (defined $dopt{$gzo}) {
 190             die "$tf bad $gzo";
 191         } else {
 192             $$gzo= '';
 193         }
 194     }
 195 }
 196
 197 sub openlog () {
 198     unlink 'log';
 199     $u= umask(007);
 200     open LOG, ">log" or die $!;
 201     umask $u;
 202     select(LOG); $|=1; select(STDOUT);
 203 }
 204
 205 $SIG{'__DIE__'}= 'killprocesses';
 206
 207 1;