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