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;