844ab9746d46b5fc8ada76a65fef478a8267bfa1
[BackupPC.git] / bin / BackupPC_tarCreate
1 #!/bin/perl -T
2 #============================================================= -*-perl-*-
3 #
4 # BackupPC_tarCreate: create a tar archive of an existing dump
5 # for restore on a client.
6 #
7 # DESCRIPTION
8 #  
9 #   Usage: BackupPC_tarCreate [-t] [-h host] [-n dumpNum] [-s shareName]
10 #                   [-r pathRemove] [-p pathAdd] files/directories...
11 #
12 #   Flags:
13 #     Required options:
14 #
15 #       -h host         host from which the tar archive is created
16 #       -n dumpNum      dump number from which the tar archive is created
17 #       -s shareName    share name from which the tar archive is created
18 #
19 #     Other options:
20 #       -t              print summary totals
21 #       -r pathRemove   path prefix that will be replaced with pathAdd
22 #       -p pathAdd      new path prefix
23 #
24 #     The -h, -n and -s options specify which dump is used to generate
25 #     the tar archive.  The -r and -p options can be used to relocate
26 #     the paths in the tar archive so extracted files can be placed
27 #     in a location different from their original location.
28 #
29 # AUTHOR
30 #   Craig Barratt  <cbarratt@users.sourceforge.net>
31 #
32 # COPYRIGHT
33 #   Copyright (C) 2001  Craig Barratt
34 #
35 #   This program is free software; you can redistribute it and/or modify
36 #   it under the terms of the GNU General Public License as published by
37 #   the Free Software Foundation; either version 2 of the License, or
38 #   (at your option) any later version.
39 #
40 #   This program is distributed in the hope that it will be useful,
41 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
42 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
43 #   GNU General Public License for more details.
44 #
45 #   You should have received a copy of the GNU General Public License
46 #   along with this program; if not, write to the Free Software
47 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
48 #
49 #========================================================================
50 #
51 # Version 1.5.0, released 2 Aug 2002.
52 #
53 # See http://backuppc.sourceforge.net.
54 #
55 #========================================================================
56
57 use strict;
58 use lib "__INSTALLDIR__/lib";
59 use File::Path;
60 use Getopt::Std;
61 use BackupPC::Lib;
62 use BackupPC::Attrib qw(:all);
63 use BackupPC::FileZIO;
64
65 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
66 my $TopDir = $bpc->TopDir();
67 my $BinDir = $bpc->BinDir();
68 my %Conf   = $bpc->Conf();
69
70 my %opts;
71 getopts("th:n:p:r:s:", \%opts);
72
73 if ( @ARGV < 1 ) {
74     print(STDERR "usage: $0 [-t] [-h host] [-n dumpNum] [-s shareName]"
75                . " [-r pathRemove] [-p pathAdd]"
76                . " files/directories...\n");
77     exit(1);
78 }
79
80 if ( $opts{h} !~ /^([\w\.-]+)$/ ) {
81     print(STDERR "$0: bad host name '$opts{h}'\n");
82     exit(1);
83 }
84 my $Host = $opts{h};
85
86 if ( $opts{n} !~ /^(\d+)$/ ) {
87     print(STDERR "$0: bad dump number '$opts{n}'\n");
88     exit(1);
89 }
90 my $Num = $opts{n};
91
92 my @Backups = $bpc->BackupInfoRead($Host);
93 my($Compress, $Mangle, $CompressF, $MangleF, $NumF, $i);
94 my $FileCnt = 0;
95 my $ByteCnt = 0;
96 my $DirCnt = 0;
97 my $SpecialCnt = 0;
98 my $ErrorCnt = 0;
99
100 for ( $i = 0 ; $i < @Backups ; $i++ ) {
101     if ( !$Backups[$i]{noFill} ) {
102         #
103         # Remember the most recent filled backup
104         #
105         $NumF      = $Backups[$i]{num};
106         $MangleF   = $Backups[$i]{mangle};
107         $CompressF = $Backups[$i]{compress};
108     }
109     next if ( $Backups[$i]{num} != $Num );
110     $Compress = $Backups[$i]{compress};
111     $Mangle   = $Backups[$i]{mangle};
112     if ( !$Backups[$i]{noFill} ) {
113         # no need to back-fill a filled backup
114         $NumF = $MangleF = $CompressF = undef;
115     }
116     last;
117 }
118 if ( $i >= @Backups ) {
119     print(STDERR "$0: bad backup number $Num for host $Host\n");
120     exit(1);
121 }
122
123 my $PathRemove = $1 if ( $opts{r} =~ /(.+)/ );
124 my $PathAdd    = $1 if ( $opts{p} =~ /(.+)/ );
125 if ( $opts{s} !~ /^([\w\s\.\/\$-]+)$/ ) {
126     print(STDERR "$0: bad share name '$opts{s}'\n");
127     exit(1);
128 }
129 my $ShareNameOrig = $opts{s};
130 my $ShareName  = $Mangle  ? $bpc->fileNameEltMangle($ShareNameOrig)
131                           : $ShareNameOrig;
132 my $ShareNameF = $MangleF ? $bpc->fileNameEltMangle($ShareNameOrig)
133                           : $ShareNameOrig;
134
135 #
136 # This constant and the line of code below that uses it are borrowed
137 # from Archive::Tar.  Thanks to Calle Dybedahl and Stephen Zander.
138 # See www.cpan.org.
139 #
140 # Archive::Tar is Copyright 1997 Calle Dybedahl. All rights reserved.
141 #                 Copyright 1998 Stephen Zander. All rights reserved.
142 #
143 my $tar_pack_header
144     = 'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12';
145 my $tar_header_length = 512;
146
147 my $BufSize    = 1048576;     # 1MB or 2^20
148 my $WriteBuf   = "";
149 my $WriteBufSz = 20 * $tar_header_length;
150
151 my(%UidCache, %GidCache);
152 my(%HardLinkExtraFiles, @HardLinks);
153
154 #
155 # Write out all the requested files/directories
156 #
157 my $fh = *STDOUT;
158 foreach my $dir ( @ARGV ) {
159     archiveWrite($fh, $dir);
160 }
161
162 #
163 # Write out any hardlinks (if any)
164 #
165 foreach my $hdr ( @HardLinks ) {
166     $hdr->{size} = 0;
167     if ( defined($PathRemove)
168           && substr($hdr->{linkname}, 0, length($PathRemove)+1)
169                     eq ".$PathRemove" ) {
170         substr($hdr->{linkname}, 0, length($PathRemove)+1) = ".$PathAdd";
171     }
172     TarWriteFileInfo($fh, $hdr);
173 }
174
175 #
176 # Finish with two null 512 byte headers, and then round out a full
177 # block.
178
179 my $data = "\0" x ($tar_header_length * 2);
180 TarWrite($fh, \$data);
181 TarWrite($fh, undef);
182
183 #
184 # print out totals if requested
185 #
186 if ( $opts{t} ) {
187     print STDERR "Done: $FileCnt files, $ByteCnt bytes, $DirCnt dirs,",
188                  " $SpecialCnt specials, $ErrorCnt errors\n";
189 }
190 exit(0);
191
192 ###########################################################################
193 # Subroutines
194 ###########################################################################
195
196 sub archiveWrite
197 {
198     my($fh, $dir, $tarPathOverride) = @_;
199     if ( $dir =~ m{(^|/)\.\.(/|$)} || $dir !~ /^(.*)$/ ) {
200         print(STDERR "$0: bad directory '$dir'\n");
201         $ErrorCnt++;
202         next;
203     }
204     (my $DirOrig  = $1) =~ s{/+$}{};
205     $DirOrig      =~ s{^\.?/+}{};
206     my($Dir, $DirF, $FullPath, $FullPathF);
207     if ( $DirOrig eq "" ) {
208         $Dir = $DirF = "";
209         $FullPath  = "$TopDir/pc/$Host/$Num/$ShareName";
210         $FullPathF = "$TopDir/pc/$Host/$NumF/$ShareNameF"
211                                             if ( defined($NumF) );
212     } else {
213         $Dir       = $Mangle  ? $bpc->fileNameMangle($DirOrig) : $DirOrig;
214         $DirF      = $MangleF ? $bpc->fileNameMangle($DirOrig) : $DirOrig;
215         $FullPath  = "$TopDir/pc/$Host/$Num/$ShareName/$Dir";
216         $FullPathF = "$TopDir/pc/$Host/$NumF/$ShareNameF/$DirF"
217                                             if ( defined($NumF) );
218     }
219     if ( -f $FullPath ) {
220         TarWriteFile($fh, $FullPath, $Mangle, $Compress, $tarPathOverride);
221     } elsif ( -d $FullPath || (defined($NumF) && -d $FullPathF) ) {
222         MergeFind($fh, $FullPath, $FullPathF);
223     } elsif ( defined($NumF) && -f $FullPathF ) {
224         TarWriteFile($fh, $FullPathF, $MangleF, $CompressF, $tarPathOverride);
225     } else {
226         print(STDERR "$0: $Host, backup $Num, doesn't have a directory or file"
227                    . " $ShareNameOrig/$DirOrig\n");
228         $ErrorCnt++;
229     }
230 }
231
232 sub UidLookup
233 {
234     my($uid) = @_;
235
236     $UidCache{$uid} = (getpwuid($uid))[0] if ( !exists($UidCache{$uid}) );
237     return $UidCache{$uid};
238 }
239
240 sub GidLookup
241 {
242     my($gid) = @_;
243
244     $GidCache{$gid} = (getgrgid($gid))[0] if ( !exists($GidCache{$gid}) );
245     return $GidCache{$gid};
246 }
247
248 sub TarWrite
249 {
250     my($fh, $dataRef) = @_;
251
252     if ( !defined($dataRef) ) {
253         #
254         # do flush by padding to a full $WriteBufSz
255         #
256         my $data = "\0" x ($WriteBufSz - length($WriteBuf));
257         $dataRef = \$data;
258     }
259     if ( length($WriteBuf) + length($$dataRef) < $WriteBufSz ) {
260         #
261         # just buffer and return
262         #
263         $WriteBuf .= $$dataRef;
264         return;
265     }
266     my $done = $WriteBufSz - length($WriteBuf);
267     if ( syswrite($fh, $WriteBuf . substr($$dataRef, 0, $done))
268                                 != $WriteBufSz ) {
269         print(STDERR "Unable to write to output file\n");
270         exit(1);
271     }
272     while ( $done + $WriteBufSz <= length($$dataRef) ) {
273         if ( syswrite($fh, substr($$dataRef, $done, $WriteBufSz))
274                             != $WriteBufSz ) {
275             print(STDERR "Unable to write to output file\n");
276             exit(1);
277         }
278         $done += $WriteBufSz;
279     }
280     $WriteBuf = substr($$dataRef, $done);
281 }
282
283 sub TarWritePad
284 {
285     my($fh, $size) = @_;
286
287     if ( $size % $tar_header_length ) {
288         my $data = "\0" x ($tar_header_length - ($size % $tar_header_length));
289         TarWrite($fh, \$data);
290     }
291 }
292
293 sub TarWriteHeader
294 {
295     my($fh, $hdr) = @_;
296
297     $hdr->{uname} = UidLookup($hdr->{uid}) if ( !defined($hdr->{uname}) );
298     $hdr->{gname} = GidLookup($hdr->{gid}) if ( !defined($hdr->{gname}) );
299     my $devmajor = defined($hdr->{devmajor}) ? sprintf("%07o", $hdr->{devmajor})
300                                              : "";
301     my $devminor = defined($hdr->{devminor}) ? sprintf("%07o", $hdr->{devminor})
302                                              : "";
303     my $data = pack($tar_pack_header,
304                      substr($hdr->{name}, 0, 99),
305                      sprintf("%07o", $hdr->{mode}),
306                      sprintf("%07o", $hdr->{uid}),
307                      sprintf("%07o", $hdr->{gid}),
308                      sprintf("%011o", $hdr->{size}),
309                      sprintf("%011o", $hdr->{mtime}),
310                      "",        #checksum field - space padded by pack("A8")
311                      $hdr->{type},
312                      substr($hdr->{linkname}, 0, 99),
313                      $hdr->{magic} || 'ustar ',
314                      $hdr->{version} || ' ',
315                      $hdr->{uname},
316                      $hdr->{gname},
317                      $devmajor,
318                      $devminor,
319                      ""         # prefix is empty
320                  );
321     substr($data, 148, 7) = sprintf("%06o\0", unpack("%16C*",$data));
322     TarWrite($fh, \$data);
323 }
324
325 sub TarWriteFileInfo
326 {
327     my($fh, $hdr) = @_;
328
329     #
330     # Handle long link names (symbolic links)
331     #
332     if ( length($hdr->{linkname}) > 99 ) {
333         my %h;
334         my $data = $hdr->{linkname} . "\0";
335         $h{name} = "././\@LongLink";
336         $h{type} = "K";
337         $h{size} = length($data);
338         TarWriteHeader($fh, \%h);
339         TarWrite($fh, \$data);
340         TarWritePad($fh, length($data));
341     }
342     #
343     # Handle long file names
344     #
345     if ( length($hdr->{name}) > 99 ) {
346         my %h;
347         my $data = $hdr->{name} . "\0";
348         $h{name} = "././\@LongLink";
349         $h{type} = "L";
350         $h{size} = length($data);
351         TarWriteHeader($fh, \%h);
352         TarWrite($fh, \$data);
353         TarWritePad($fh, length($data));
354     }
355     TarWriteHeader($fh, $hdr);
356 }
357
358 my $Attr;
359 my $AttrDir;
360
361 sub TarWriteFile
362 {
363     my($fh, $fullName, $mangle, $compress, $tarPathOverride) = @_;
364     my($tarPath);
365
366     if ( $fullName =~ m{^\Q$TopDir/pc/$Host/$Num/$ShareName\E(.*)}
367         || (defined($NumF)
368             && $fullName =~ m{^\Q$TopDir/pc/$Host/$NumF/$ShareNameF\E(.*)}) ) {
369         $tarPath = $mangle ? $bpc->fileNameUnmangle($1) : $1;
370     } else {
371         print(STDERR "Unexpected file name from find: $fullName\n");
372         return;
373     }
374     $tarPath = $tarPathOverride if ( defined($tarPathOverride) );
375     (my $dir = $fullName) =~ s{/([^/]*)$}{};
376     my $fileName = $mangle ? $bpc->fileNameUnmangle($1) : $1;
377     if ( $mangle && $AttrDir ne $dir ) {
378         $AttrDir = $dir;
379         $Attr = BackupPC::Attrib->new({ compress => $compress });
380         if ( -f $Attr->fileName($dir) && !$Attr->read($dir) ) {
381             print(STDERR "Can't read attribute file in $dir\n");
382             $ErrorCnt++;
383             $Attr = undef;
384         }
385     }
386     my $hdr = $Attr->get($fileName) if ( defined($Attr) );
387     if ( !defined($hdr) ) {
388         #
389         # No attributes.  Must be an old style backup.  Reconstruct
390         # what we can.  Painful part is computing the size if compression
391         # is on: only method is to uncompress the file.
392         #
393         my @s = stat($fullName);
394         $hdr = {
395             type  => -d _ ? BPC_FTYPE_DIR : BPC_FTYPE_FILE,
396             mode  => $s[2],
397             uid   => $s[4],
398             gid   => $s[5],
399             size  => -f _ ? $s[7] : 0,
400             mtime => $s[9],
401         };
402         if ( $compress && -f _ ) {
403             #
404             # Compute the correct size by reading the whole file
405             #
406             my $f = BackupPC::FileZIO->open($fullName, 0, $compress);
407             if ( !defined($f) ) {
408                 print(STDERR "Unable to open file $fullName\n");
409                 $ErrorCnt++;
410                 return;
411             }
412             my($data, $size);
413             while ( $f->read(\$data, $BufSize) > 0 ) {
414                 $size += length($data);
415             }
416             $f->close;
417             $hdr->{size} = $size;
418         }
419     }
420     if ( defined($PathRemove)
421             && substr($tarPath, 0, length($PathRemove)) eq $PathRemove ) {
422         substr($tarPath, 0, length($PathRemove)) = $PathAdd;
423     }
424     $tarPath = "./" . $tarPath if ( $tarPath !~ /^\.\// );
425     $tarPath =~ s{//+}{/}g;
426     $hdr->{name} = $tarPath;
427
428     if ( $hdr->{type} == BPC_FTYPE_DIR ) {
429         #
430         # Directory: just write the header
431         #
432         $hdr->{name} .= "/" if ( $hdr->{name} !~ m{/$} );
433         TarWriteFileInfo($fh, $hdr);
434         $DirCnt++;
435     } elsif ( $hdr->{type} == BPC_FTYPE_FILE ) {
436         #
437         # Regular file: write the header and file
438         #
439         my $f = BackupPC::FileZIO->open($fullName, 0, $compress);
440         if ( !defined($f) ) {
441             print(STDERR "Unable to open file $fullName\n");
442             $ErrorCnt++;
443             return;
444         }
445         TarWriteFileInfo($fh, $hdr);
446         my($data, $size);
447         while ( $f->read(\$data, $BufSize) > 0 ) {
448             TarWrite($fh, \$data);
449             $size += length($data);
450         }
451         $f->close;
452         TarWritePad($fh, $size);
453         $FileCnt++;
454         $ByteCnt += $size;
455     } elsif ( $hdr->{type} == BPC_FTYPE_HARDLINK ) {
456         #
457         # Hardlink file: either write a hardlink or the complete file
458         # depending upon whether the linked-to file will be written
459         # to the archive.
460         #
461         # Start by reading the contents of the link.
462         #
463         my $f = BackupPC::FileZIO->open($fullName, 0, $compress);
464         if ( !defined($f) ) {
465             print(STDERR "Unable to open file $fullName\n");
466             $ErrorCnt++;
467             return;
468         }
469         my $data;
470         while ( $f->read(\$data, $BufSize) > 0 ) {
471             $hdr->{linkname} .= $data;
472         }
473         $f->close;
474         #
475         # Check @ARGV and the list of hardlinked files we have explicity
476         # dumped to see if we have dumped this file or not
477         #
478         my $done = 0;
479         my $name = $hdr->{linkname};
480         $name =~ s{^\./}{/};
481         if ( $HardLinkExtraFiles{$name} ) {
482             $done = 1;
483         } else {
484             foreach my $arg ( @ARGV ) {
485                 $arg =~ s{^\./+}{/};
486                 $arg =~ s{/+$}{};
487                 $done = 1 if ( $name eq $arg || $name =~ /^\Q$arg\// );
488             }
489         }
490         if ( $done ) {
491             #
492             # Target file will be or was written, so just remember
493             # the hardlink so we can dump it later.
494             #
495             push(@HardLinks, $hdr);
496             $SpecialCnt++;
497         } else {
498             #
499             # Have to dump the original file.  Just call the top-level
500             # routine, so that we save the hassle of dealing with
501             # mangling, merging and attributes.
502             #
503             $HardLinkExtraFiles{$hdr->{linkname}} = 1;
504             archiveWrite($fh, $hdr->{linkname}, $hdr->{name});
505         }
506     } elsif ( $hdr->{type} == BPC_FTYPE_SYMLINK ) {
507         #
508         # Symbolic link: read the symbolic link contents into the header
509         # and write the header.
510         #
511         my $f = BackupPC::FileZIO->open($fullName, 0, $compress);
512         if ( !defined($f) ) {
513             print(STDERR "Unable to open symlink file $fullName\n");
514             $ErrorCnt++;
515             return;
516         }
517         my $data;
518         while ( $f->read(\$data, $BufSize) > 0 ) {
519             $hdr->{linkname} .= $data;
520         }
521         $f->close;
522         $hdr->{size} = 0;
523         TarWriteFileInfo($fh, $hdr);
524         $SpecialCnt++;
525     } elsif ( $hdr->{type} == BPC_FTYPE_CHARDEV
526            || $hdr->{type} == BPC_FTYPE_BLOCKDEV
527            || $hdr->{type} == BPC_FTYPE_FIFO ) {
528         #
529         # Special files: for char and block special we read the
530         # major and minor numbers from a plain file.
531         #
532         if ( $hdr->{type} != BPC_FTYPE_FIFO ) {
533             my $f = BackupPC::FileZIO->open($fullName, 0, $compress);
534             my $data;
535             if ( !defined($f) || $f->read(\$data, $BufSize) < 0 ) {
536                 print(STDERR "Unable to open/read char/block special file"
537                            . " $fullName\n");
538                 $f->close if ( defined($f) );
539                 $ErrorCnt++;
540                 return;
541             }
542             $f->close;
543             if ( $data =~ /(\d+),(\d+)/ ) {
544                 $hdr->{devmajor} = $1;
545                 $hdr->{devminor} = $2;
546             }
547         }
548         $hdr->{size} = 0;
549         TarWriteFileInfo($fh, $hdr);
550         $SpecialCnt++;
551     } else {
552         print(STDERR "Got unknown type $hdr->{type} for $hdr->{name}\n");
553         $ErrorCnt++;
554     }
555 }
556
557 #
558 # Does a recursive find of $dir, filling in from the (filled dump)
559 # directory $dirF.  Handles the cases where $dir and $dirF might
560 # or might not be mangled etc.
561 #
562 sub MergeFind
563 {
564     my($fh, $dir, $dirF) = @_;
565
566     my(@Dir, $fLast);
567     if ( -d $dir ) {
568         TarWriteFile($fh, $dir, $Mangle, $Compress);
569     } elsif ( -d $dirF ) {
570         TarWriteFile($fh, $dirF, $MangleF, $CompressF);
571     }
572     if ( opendir(DIR, $dir) ) {
573         @Dir = readdir(DIR);
574         closedir(DIR);
575     }
576     if ( defined($NumF) && opendir(DIR, $dirF) ) {
577         if ( $Mangle == $MangleF ) {
578             @Dir = (@Dir, readdir(DIR));
579         } else {
580             foreach my $f ( readdir(DIR) ) {
581                 if ( $Mangle ) {
582                     push(@Dir, $bpc->fileNameMangle($f));
583                 } else {
584                     push(@Dir, $bpc->fileNameUnmangle($f));
585                 }
586             }
587         }
588     }
589     foreach my $f ( sort({$a cmp $b} @Dir) ) {
590         next if ( $f eq "." || $f eq ".."
591                || $f eq $fLast || ($Mangle && $f eq "attrib") );
592         $fLast = $f;
593         my($fF) = $f;
594         if ( $Mangle != $MangleF ) {
595             $fF = $Mangle ? $bpc->fileNameUnmangle($f)
596                           : $bpc->fileNameMangle($f);
597         }
598         if ( -e "$dir/$f" ) {
599             if ( -d "$dir/$f" ) {
600                 MergeFind($fh, "$dir/$f", "$dirF/$fF");
601             } else {
602                 TarWriteFile($fh, "$dir/$f", $Mangle, $Compress);
603             }
604         } elsif ( -e "$dirF/$fF" ) {
605             if ( -d "$dirF/$fF" ) {
606                 MergeFind($fh, "$dir/$f", "$dirF/$fF");
607             } else {
608                 TarWriteFile($fh, "$dirF/$fF", $MangleF, $CompressF);
609             }
610         } else {
611             print(STDERR "$0: Botch on $dir, $dirF, $f, $fF\n");
612             $ErrorCnt++;
613         }
614     }
615 }