- 2.0.0 release. Minor tweaks to disable utf8.
[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 2.0.0, released 14 Jun 2003.
52 #
53 # See http://backuppc.sourceforge.net.
54 #
55 #========================================================================
56
57 use strict;
58 no  utf8;
59 use lib "/usr/local/BackupPC/lib";
60 use File::Path;
61 use Getopt::Std;
62 use BackupPC::Lib;
63 use BackupPC::Attrib qw(:all);
64 use BackupPC::FileZIO;
65 use BackupPC::View;
66
67 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
68 my $TopDir = $bpc->TopDir();
69 my $BinDir = $bpc->BinDir();
70 my %Conf   = $bpc->Conf();
71
72 my %opts;
73
74 if ( !getopts("th:n:p:r:s:", \%opts) || @ARGV < 1 ) {
75     print(STDERR "usage: $0 [-t] [-h host] [-n dumpNum] [-s shareName]"
76                . " [-r pathRemove] [-p pathAdd]"
77                . " files/directories...\n");
78     exit(1);
79 }
80
81 if ( $opts{h} !~ /^([\w\.\s-]+)$/ ) {
82     print(STDERR "$0: bad host name '$opts{h}'\n");
83     exit(1);
84 }
85 my $Host = $opts{h};
86
87 if ( $opts{n} !~ /^(\d+)$/ ) {
88     print(STDERR "$0: bad dump number '$opts{n}'\n");
89     exit(1);
90 }
91 my $Num = $opts{n};
92
93 my @Backups = $bpc->BackupInfoRead($Host);
94 my $FileCnt = 0;
95 my $ByteCnt = 0;
96 my $DirCnt = 0;
97 my $SpecialCnt = 0;
98 my $ErrorCnt = 0;
99
100 my $i;
101 for ( $i = 0 ; $i < @Backups ; $i++ ) {
102     last if ( $Backups[$i]{num} == $Num );
103 }
104 if ( $i >= @Backups ) {
105     print(STDERR "$0: bad backup number $Num for host $Host\n");
106     exit(1);
107 }
108
109 my $PathRemove = $1 if ( $opts{r} =~ /(.+)/ );
110 my $PathAdd    = $1 if ( $opts{p} =~ /(.+)/ );
111 if ( $opts{s} !~ /^([\w\s\.\/\$-]+)$/ ) {
112     print(STDERR "$0: bad share name '$opts{s}'\n");
113     exit(1);
114 }
115 my $ShareName = $opts{s};
116
117 #
118 # This constant and the line of code below that uses it are borrowed
119 # from Archive::Tar.  Thanks to Calle Dybedahl and Stephen Zander.
120 # See www.cpan.org.
121 #
122 # Archive::Tar is Copyright 1997 Calle Dybedahl. All rights reserved.
123 #                 Copyright 1998 Stephen Zander. All rights reserved.
124 #
125 my $tar_pack_header
126     = 'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12';
127 my $tar_header_length = 512;
128
129 my $BufSize    = 1048576;     # 1MB or 2^20
130 my $WriteBuf   = "";
131 my $WriteBufSz = 20 * $tar_header_length;
132
133 my(%UidCache, %GidCache);
134 my(%HardLinkExtraFiles, @HardLinks);
135
136 #
137 # Write out all the requested files/directories
138 #
139 binmode(STDOUT);
140 my $fh = *STDOUT;
141 foreach my $dir ( @ARGV ) {
142     archiveWrite($fh, $dir);
143 }
144
145 #
146 # Write out any hardlinks (if any)
147 #
148 foreach my $hdr ( @HardLinks ) {
149     $hdr->{size} = 0;
150     if ( defined($PathRemove)
151           && substr($hdr->{linkname}, 0, length($PathRemove)+1)
152                     eq ".$PathRemove" ) {
153         substr($hdr->{linkname}, 0, length($PathRemove)+1) = ".$PathAdd";
154     }
155     TarWriteFileInfo($fh, $hdr);
156 }
157
158 #
159 # Finish with two null 512 byte headers, and then round out a full
160 # block.
161
162 my $data = "\0" x ($tar_header_length * 2);
163 TarWrite($fh, \$data);
164 TarWrite($fh, undef);
165
166 #
167 # print out totals if requested
168 #
169 if ( $opts{t} ) {
170     print STDERR "Done: $FileCnt files, $ByteCnt bytes, $DirCnt dirs,",
171                  " $SpecialCnt specials, $ErrorCnt errors\n";
172 }
173 exit(0);
174
175 ###########################################################################
176 # Subroutines
177 ###########################################################################
178
179 sub archiveWrite
180 {
181     my($fh, $dir, $tarPathOverride) = @_;
182
183     my $view = BackupPC::View->new($bpc, $Host, \@Backups);
184
185     if ( $dir =~ m{(^|/)\.\.(/|$)} ) {
186         print(STDERR "$0: bad directory '$dir'\n");
187         $ErrorCnt++;
188         return;
189     }
190     $view->find($Num, $ShareName, $dir, 0, \&TarWriteFile,
191                 $fh, $tarPathOverride);
192 }
193
194 sub UidLookup
195 {
196     my($uid) = @_;
197
198     $UidCache{$uid} = (getpwuid($uid))[0] if ( !exists($UidCache{$uid}) );
199     return $UidCache{$uid};
200 }
201
202 sub GidLookup
203 {
204     my($gid) = @_;
205
206     $GidCache{$gid} = (getgrgid($gid))[0] if ( !exists($GidCache{$gid}) );
207     return $GidCache{$gid};
208 }
209
210 sub TarWrite
211 {
212     my($fh, $dataRef) = @_;
213
214     if ( !defined($dataRef) ) {
215         #
216         # do flush by padding to a full $WriteBufSz
217         #
218         my $data = "\0" x ($WriteBufSz - length($WriteBuf));
219         $dataRef = \$data;
220     }
221     if ( length($WriteBuf) + length($$dataRef) < $WriteBufSz ) {
222         #
223         # just buffer and return
224         #
225         $WriteBuf .= $$dataRef;
226         return;
227     }
228     my $done = $WriteBufSz - length($WriteBuf);
229     if ( syswrite($fh, $WriteBuf . substr($$dataRef, 0, $done))
230                                 != $WriteBufSz ) {
231         print(STDERR "Unable to write to output file ($!)\n");
232         exit(1);
233     }
234     while ( $done + $WriteBufSz <= length($$dataRef) ) {
235         if ( syswrite($fh, substr($$dataRef, $done, $WriteBufSz))
236                             != $WriteBufSz ) {
237             print(STDERR "Unable to write to output file ($!)\n");
238             exit(1);
239         }
240         $done += $WriteBufSz;
241     }
242     $WriteBuf = substr($$dataRef, $done);
243 }
244
245 sub TarWritePad
246 {
247     my($fh, $size) = @_;
248
249     if ( $size % $tar_header_length ) {
250         my $data = "\0" x ($tar_header_length - ($size % $tar_header_length));
251         TarWrite($fh, \$data);
252     }
253 }
254
255 sub TarWriteHeader
256 {
257     my($fh, $hdr) = @_;
258
259     $hdr->{uname} = UidLookup($hdr->{uid}) if ( !defined($hdr->{uname}) );
260     $hdr->{gname} = GidLookup($hdr->{gid}) if ( !defined($hdr->{gname}) );
261     my $devmajor = defined($hdr->{devmajor}) ? sprintf("%07o", $hdr->{devmajor})
262                                              : "";
263     my $devminor = defined($hdr->{devminor}) ? sprintf("%07o", $hdr->{devminor})
264                                              : "";
265     my $data = pack($tar_pack_header,
266                      substr($hdr->{name}, 0, 99),
267                      sprintf("%07o", $hdr->{mode}),
268                      sprintf("%07o", $hdr->{uid}),
269                      sprintf("%07o", $hdr->{gid}),
270                      sprintf("%011o", $hdr->{size}),
271                      sprintf("%011o", $hdr->{mtime}),
272                      "",        #checksum field - space padded by pack("A8")
273                      $hdr->{type},
274                      substr($hdr->{linkname}, 0, 99),
275                      $hdr->{magic} || 'ustar ',
276                      $hdr->{version} || ' ',
277                      $hdr->{uname},
278                      $hdr->{gname},
279                      $devmajor,
280                      $devminor,
281                      ""         # prefix is empty
282                  );
283     substr($data, 148, 7) = sprintf("%06o\0", unpack("%16C*",$data));
284     TarWrite($fh, \$data);
285 }
286
287 sub TarWriteFileInfo
288 {
289     my($fh, $hdr) = @_;
290
291     #
292     # Handle long link names (symbolic links)
293     #
294     if ( length($hdr->{linkname}) > 99 ) {
295         my %h;
296         my $data = $hdr->{linkname} . "\0";
297         $h{name} = "././\@LongLink";
298         $h{type} = "K";
299         $h{size} = length($data);
300         TarWriteHeader($fh, \%h);
301         TarWrite($fh, \$data);
302         TarWritePad($fh, length($data));
303     }
304     #
305     # Handle long file names
306     #
307     if ( length($hdr->{name}) > 99 ) {
308         my %h;
309         my $data = $hdr->{name} . "\0";
310         $h{name} = "././\@LongLink";
311         $h{type} = "L";
312         $h{size} = length($data);
313         TarWriteHeader($fh, \%h);
314         TarWrite($fh, \$data);
315         TarWritePad($fh, length($data));
316     }
317     TarWriteHeader($fh, $hdr);
318 }
319
320 my $Attr;
321 my $AttrDir;
322
323 sub TarWriteFile
324 {
325     my($hdr, $fh, $tarPathOverride) = @_;
326
327     my $tarPath = $hdr->{relPath};
328     $tarPath = $tarPathOverride if ( defined($tarPathOverride) );
329
330     if ( defined($PathRemove)
331             && substr($tarPath, 0, length($PathRemove)) eq $PathRemove ) {
332         substr($tarPath, 0, length($PathRemove)) = $PathAdd;
333     }
334     $tarPath = "./" . $tarPath if ( $tarPath !~ /^\.\// );
335     $tarPath =~ s{//+}{/}g;
336     $hdr->{name} = $tarPath;
337
338     if ( $hdr->{type} == BPC_FTYPE_DIR ) {
339         #
340         # Directory: just write the header
341         #
342         $hdr->{name} .= "/" if ( $hdr->{name} !~ m{/$} );
343         TarWriteFileInfo($fh, $hdr);
344         $DirCnt++;
345     } elsif ( $hdr->{type} == BPC_FTYPE_FILE ) {
346         #
347         # Regular file: write the header and file
348         #
349         my $f = BackupPC::FileZIO->open($hdr->{fullPath}, 0, $hdr->{compress});
350         if ( !defined($f) ) {
351             print(STDERR "Unable to open file $hdr->{fullPath}\n");
352             $ErrorCnt++;
353             return;
354         }
355         TarWriteFileInfo($fh, $hdr);
356         my($data, $size);
357         while ( $f->read(\$data, $BufSize) > 0 ) {
358             TarWrite($fh, \$data);
359             $size += length($data);
360         }
361         $f->close;
362         TarWritePad($fh, $size);
363         $FileCnt++;
364         $ByteCnt += $size;
365     } elsif ( $hdr->{type} == BPC_FTYPE_HARDLINK ) {
366         #
367         # Hardlink file: either write a hardlink or the complete file
368         # depending upon whether the linked-to file will be written
369         # to the archive.
370         #
371         # Start by reading the contents of the link.
372         #
373         my $f = BackupPC::FileZIO->open($hdr->{fullPath}, 0, $hdr->{compress});
374         if ( !defined($f) ) {
375             print(STDERR "Unable to open file $hdr->{fullPath}\n");
376             $ErrorCnt++;
377             return;
378         }
379         my $data;
380         while ( $f->read(\$data, $BufSize) > 0 ) {
381             $hdr->{linkname} .= $data;
382         }
383         $f->close;
384         #
385         # Check @ARGV and the list of hardlinked files we have explicity
386         # dumped to see if we have dumped this file or not
387         #
388         my $done = 0;
389         my $name = $hdr->{linkname};
390         $name =~ s{^\./}{/};
391         if ( $HardLinkExtraFiles{$name} ) {
392             $done = 1;
393         } else {
394             foreach my $arg ( @ARGV ) {
395                 $arg =~ s{^\./+}{/};
396                 $arg =~ s{/+$}{};
397                 $done = 1 if ( $name eq $arg || $name =~ /^\Q$arg\// );
398             }
399         }
400         if ( $done ) {
401             #
402             # Target file will be or was written, so just remember
403             # the hardlink so we can dump it later.
404             #
405             push(@HardLinks, $hdr);
406             $SpecialCnt++;
407         } else {
408             #
409             # Have to dump the original file.  Just call the top-level
410             # routine, so that we save the hassle of dealing with
411             # mangling, merging and attributes.
412             #
413             $HardLinkExtraFiles{$hdr->{linkname}} = 1;
414             archiveWrite($fh, $hdr->{linkname}, $hdr->{name});
415         }
416     } elsif ( $hdr->{type} == BPC_FTYPE_SYMLINK ) {
417         #
418         # Symbolic link: read the symbolic link contents into the header
419         # and write the header.
420         #
421         my $f = BackupPC::FileZIO->open($hdr->{fullPath}, 0, $hdr->{compress});
422         if ( !defined($f) ) {
423             print(STDERR "Unable to open symlink file $hdr->{fullPath}\n");
424             $ErrorCnt++;
425             return;
426         }
427         my $data;
428         while ( $f->read(\$data, $BufSize) > 0 ) {
429             $hdr->{linkname} .= $data;
430         }
431         $f->close;
432         $hdr->{size} = 0;
433         TarWriteFileInfo($fh, $hdr);
434         $SpecialCnt++;
435     } elsif ( $hdr->{type} == BPC_FTYPE_CHARDEV
436            || $hdr->{type} == BPC_FTYPE_BLOCKDEV
437            || $hdr->{type} == BPC_FTYPE_FIFO ) {
438         #
439         # Special files: for char and block special we read the
440         # major and minor numbers from a plain file.
441         #
442         if ( $hdr->{type} != BPC_FTYPE_FIFO ) {
443             my $f = BackupPC::FileZIO->open($hdr->{fullPath}, 0,
444                                                 $hdr->{compress});
445             my $data;
446             if ( !defined($f) || $f->read(\$data, $BufSize) < 0 ) {
447                 print(STDERR "Unable to open/read char/block special file"
448                            . " $hdr->{fullPath}\n");
449                 $f->close if ( defined($f) );
450                 $ErrorCnt++;
451                 return;
452             }
453             $f->close;
454             if ( $data =~ /(\d+),(\d+)/ ) {
455                 $hdr->{devmajor} = $1;
456                 $hdr->{devminor} = $2;
457             }
458         }
459         $hdr->{size} = 0;
460         TarWriteFileInfo($fh, $hdr);
461         $SpecialCnt++;
462     } else {
463         print(STDERR "Got unknown type $hdr->{type} for $hdr->{name}\n");
464         $ErrorCnt++;
465     }
466 }