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     pboth("  $c\n");
  47     defined($p= fork) or die $!;
  48     if ($p) { $processes{$p}= $c; return; }
  49     open STDIN,"$i" or die "$c stdin $i: $!";
  50     open STDOUT,"$o" or die "$c stdout $o: $!";
  51     &closepipes;
  52     exec $c; die "$c: $!";
  53 }
  54
  55 sub rewind_raw () {
  56     runsystem("mt -f $tape rewind");
  57 }
  58
  59 sub readtapeid_raw () {
  60     open T, ">>TAPEID" or die $!; close T;
  61     unlink 'TAPEID' or die $!;
  62     rewind_raw();
  63     system "mt -f $tape setblk $blocksizebytes"; $? and die $?;
  64     system "dd if=$tape bs=${blocksize}b count=10 ".
  65            "| tar -b$blocksize -vvxf - TAPEID";
  66 }
  67
  68 sub runsystem ($) {
  69     pboth("    $_[0]\n");
  70     system $_[0];
  71     $? and die $?;
  72 }
  73
  74 sub pboth ($) {
  75     my ($str) = @_;
  76     print LOG $str or die $!;
  77     print $str or die $!;
  78 }
  79
  80 sub nexttapefile ($) {
  81     my ($what) = @_;
  82     $currenttapefilenumber++;
  83     $currenttapefilename= $what;
  84     pboth(sprintf "writing tape file #%d (mt fsf %d): %s\n",
  85           $currenttapefilenumber, $currenttapefilenumber-1, $what);
  86 }
  87
  88 sub writetapeid ($$) {
  89     open T, ">TAPEID" or die $!;
  90     print T "$_[0]\n$_[1]\n" or die $!;
  91     close T or die $!;
  92
  93     $currenttapefilenumber= 0;
  94     nexttapefile('TAPEID');
  95
  96     system "tar -b$blocksize -vvcf TAPEID.tar TAPEID"; $? and die $?;
  97     system "dd if=TAPEID.tar of=$ntape bs=${blocksize}b count=10";
  98     $? and die $?;
  99 }
 100
 101 sub endprocesses () {
 102     while (keys %processes) {
 103         $p= waitpid(-1,0) or die "wait: $!";
 104         if (!exists $processes{$p}) { warn "unknown pid exited: $p, code $?\n"; next; }
 105         $c= $processes{$p};
 106         delete $processes{$p};
 107         $? && die "error: command gave code $?: $c\n";
 108     }
 109     pboth("  ok\n");
 110 }
 111
 112 sub killprocesses {
 113     for $p (keys %processes) {
 114         kill 15,$p or warn "kill process $p: $!";
 115     }
 116     undef %processes;
 117 }
 118
 119 # Read a fsys.foo filesystem group definition file.
 120 # Syntax is: empty lines and those beginning with '#' are ignored.
 121 # Trailing whitespace is ignored. Lines of the form 'prefix foo bar'
 122 # are handled specially, as arex lines 'exclude regexp'; otherwise
 123 # we just shove the line into @fsys and let parsefsys deal with it.
 124
 125 sub readfsysfile ($) {
 126     my ($fn) = @_;
 127     my ($fh,$sfn);
 128     $fh= new IO::File "$fn", "r" or die "cannot open fsys file $fn ($!).\n";
 129     for (;;) {
 130         $!=0; $_= <$fh> or die "unexpected EOF in $fn ($!)\n";
 131         chomp; s/\s*$//;
 132         last if m/^end$/;
 133         next unless m/\S/;
 134         next if m/^\#/;
 135         if (m/^prefix\s+(\w+)\s+(\S.*\S)$/) {
 136             $prefix{$1}= $2;
 137         } elsif (m/^prefix\-df\s+(\w+)\s+(\S.*\S)$/) {
 138             $prefixdf{$1}= $2;
 139         } elsif (m/^snap(?:\=(\w+))?\s+(\w+)\s+(\w+)$/) {
 140             push @excldir,$1;
 141         } elsif (m/^excludedir\s+(\S.*\S)$/) {
 142             push @excldir,$1;
 143         } elsif (m/^exclude\s+(\S.*\S)$/) {
 144             push @excl,$1;
 145         } elsif (m/^include\s+(\S.*\S)$/) {
 146             $sfn = $1;
 147             $sfn =~ s/^\./fsys./;
 148             $sfn = "$etc/$sfn" unless $sfn =~ m,^/,;
 149             readfsysfile($sfn);
 150         } else {
 151             push @fsys,$_;
 152         }
 153     }
 154     close $fh or die $!;
 155 }
 156
 157 sub readfsys ($) {
 158     my ($fsnm) = @_;
 159     my ($fsf);
 160     $fsf= "$etc/fsys.$fsnm";
 161     stat $fsf or die "Filesystems $fsnm unknown ($!).\n";
 162     readfsysfile($fsf);
 163 }
 164
 165 # Parse a line from a filesystem definition file. We expect the line
 166 # to be in $tf.
 167 sub parsefsys () {
 168     my ($dopts,$dopt);
 169     if ($tf =~ m#^(/\S*)\s+(\w+)([,=0-9a-z]*)$#) {
 170         # Line of form '[/device:]/file/system  dumptype[,options]'
 171         $atf= $1;
 172         $tm= $2;
 173         $dopts= $3;
 174         $prefix= '<local>';
 175         $pcstr= '';
 176         $rstr= '';
 177     } elsif ($tf =~ m#^(/\S*)\s+(\w+)([,=0-9a-z]*)\s+(\w+)$#) {
 178         # Line of form '[/device:]/file/system dumptype[,options] prefix'
 179         # (used for remote backups)
 180         $atf= $1;
 181         $tm= $2;
 182         $dopts= $3;
 183         $prefix= $4;
 184         $pcstr= "$prefix:";
 185         defined($prefix{$prefix}) or die "prefix $prefix in $tf ?\n";
 186         $rstr= $prefix{$prefix}.' ';
 187     } else {
 188         die "fsys $tf ?";
 189     }
 190
 191     $fsidstr= $pcstr.$atf;
 192     $fsidstr =~ s/[,+]/+$&/g;
 193     $fsidstr =~ s#/#,#g;
 194     $fsidfile= "/var/lib/chiark-backup/incstamp,$fsidstr";
 195
 196     $dev = $atf =~ s,^(.*)\:,, ? $1 : '';
 197
 198     if (!length $pcstr) {
 199         stat $atf or die "stat $atf: $!";
 200         -d _ or die "not a dir: $atf";
 201     }
 202
 203     undef %dopt;
 204     foreach $dopt (split /\,/,$dopts) {
 205         if (grep { $dopt eq $_ } qw(gz)) {
 206             $dopt{$dopt}= 'y';
 207         } elsif (grep { $dopt eq $_ } qw(snap)) {
 208             $dopt{$dopt}= $dopt;
 209         } elsif ($dopt =~ m/\=/ && grep { $` eq $_ } qw(gz snap)) {
 210             $dopt{$`}= $';
 211         } elsif (length $dopt) {
 212             die "unknown option $dopt (in $dopts $tf)";
 213         }
 214     }
 215
 216     my ($gzo);
 217     foreach $gzo (qw(gz gzi)) {
 218         if ($dopt{$gzo} eq 'y') {
 219             $$gzo= '1';
 220         } elsif ($dopt{$gzo} =~ m/^\d$/) {
 221             $$gzo= $dopt{$gzo};
 222         } elsif (defined $dopt{$gzo}) {
 223             die "$tf bad $gzo";
 224         } else {
 225             $$gzo= '';
 226         }
 227     }
 228
 229     if (length $dopt{'snap'}) {
 230         length $dev or die "$pcstr:$atf no device but needed for snap";
 231     }
 232 }
 233
 234 sub execute ($) {
 235     pboth("  $_[0]\n");
 236     system $_[0]; $? and die "$_[0] $?";
 237 }
 238
 239 sub prepfsys () {
 240     $dev_print= $dev;
 241     $atf_print= $atf;
 242
 243     if (length $dopt{'snap'}) {
 244
 245         system('snap-drop'); $? and die $?;
 246
 247         $snapscripts= '/etc/chiark-backup/snap';
 248         $snapbase= "$rstr $snapscripts/$dopt{'snap'}";
 249         $snapargs= "/var/lib/chiark-backup";
 250
 251         $snapsnap= "$snapbase snap $snapargs $dev $atf";
 252         $snapdrop= "$snapbase drop $snapargs";
 253
 254         open SD, ">snap-drop.new" or die $!;
 255         print SD $snapdrop,"\n" or die $!;
 256         close SD or die $!;
 257         rename "snap-drop.new","snap-drop" or die $!;
 258
 259         execute($snapsnap);
 260
 261         $dev_nosnap= $dev;
 262         $atf_nosnap= $atf;
 263         $dev= "/var/lib/chiark-backup/snap-device";
 264         $atf= "/var/lib/chiark-backup/snap-mount";
 265     }
 266 }
 267
 268 sub finfsys () {
 269     if (length $dopt{'snap'}) {
 270         system('snap-drop'); $? and die $?;
 271     }
 272 }
 273
 274 sub openlog () {
 275     unlink 'log';
 276     $u= umask(007);
 277     open LOG, ">log" or die $!;
 278     umask $u;
 279     select(LOG); $|=1; select(STDOUT);
 280 }
 281
 282 $SIG{'__DIE__'}= 'killprocesses';
 283
 284 1;