1 #============================================================= -*-perl-*-
3 # BackupPC::Lib package
7 # This library defines a BackupPC::Lib class and a variety of utility
8 # functions used by BackupPC.
11 # Craig Barratt <cbarratt@users.sourceforge.net>
14 # Copyright (C) 2001-2003 Craig Barratt
16 # This program is free software; you can redistribute it and/or modify
17 # it under the terms of the GNU General Public License as published by
18 # the Free Software Foundation; either version 2 of the License, or
19 # (at your option) any later version.
21 # This program is distributed in the hope that it will be useful,
22 # but WITHOUT ANY WARRANTY; without even the implied warranty of
23 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 # GNU General Public License for more details.
26 # You should have received a copy of the GNU General Public License
27 # along with this program; if not, write to the Free Software
28 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
30 #========================================================================
32 # Version 2.1.0, released 20 Jun 2004.
34 # See http://backuppc.sourceforge.net.
36 #========================================================================
38 package BackupPC::Lib;
42 use vars qw(%Conf %Lang);
56 my($topDir, $installDir, $noUserCheck) = @_;
59 TopDir => $topDir || '/data/BackupPC',
60 BinDir => $installDir || '/usr/local/BackupPC',
61 LibDir => $installDir || '/usr/local/BackupPC',
64 num type startTime endTime
65 nFiles size nFilesExist sizeExist nFilesNew sizeNew
66 xferErrs xferBadFile xferBadShare tarErrs
67 compress sizeExistComp sizeNewComp
68 noFill fillFromNum mangle xferMethod level
71 num startTime endTime result errorMsg nFiles size
72 tarCreateErrs xferErrs
75 num startTime endTime result errorMsg
78 $bpc->{BinDir} .= "/bin";
79 $bpc->{LibDir} .= "/lib";
81 # Clean up %ENV and setup other variables.
83 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
84 $bpc->{PoolDir} = "$bpc->{TopDir}/pool";
85 $bpc->{CPoolDir} = "$bpc->{TopDir}/cpool";
86 if ( defined(my $error = $bpc->ConfigRead()) ) {
87 print(STDERR $error, "\n");
91 # Verify we are running as the correct user
94 && $bpc->{Conf}{BackupPCUserVerify}
95 && $> != (my $uid = (getpwnam($bpc->{Conf}{BackupPCUser}))[2]) ) {
96 print(STDERR "Wrong user: my userid is $>, instead of $uid"
97 . " ($bpc->{Conf}{BackupPCUser})\n");
106 return $bpc->{TopDir};
112 return $bpc->{BinDir};
118 return $bpc->{Version};
124 return %{$bpc->{Conf}};
136 return " admin " if ( !$num );
137 return " admin$num ";
143 return $str =~ /^ admin/;
148 return " trashClean ";
153 my($bpc, $param) = @_;
155 return $bpc->{Conf}{$param};
160 my($bpc, $param) = @_;
162 $bpc->{verbose} = $param if ( defined($param) );
163 return $bpc->{verbose};
170 if ( !defined($bpc->{SigName2Num}) ) {
172 foreach my $name ( split(' ', $Config{sig_name}) ) {
173 $bpc->{SigName2Num}{$name} = $i;
177 return $bpc->{SigName2Num}{$sig};
181 # Generate an ISO 8601 format timeStamp (but without the "T").
182 # See http://www.w3.org/TR/NOTE-datetime and
183 # http://www.cl.cam.ac.uk/~mgk25/iso-time.html
187 my($bpc, $t, $noPad) = @_;
188 my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
189 = localtime($t || time);
190 return sprintf("%04d-%02d-%02d %02d:%02d:%02d",
191 $year + 1900, $mon + 1, $mday, $hour, $min, $sec)
192 . ($noPad ? "" : " ");
197 my($bpc, $host) = @_;
198 local(*BK_INFO, *LOCK);
201 flock(LOCK, LOCK_EX) if open(LOCK, "$bpc->{TopDir}/pc/$host/LOCK");
202 if ( open(BK_INFO, "$bpc->{TopDir}/pc/$host/backups") ) {
204 while ( <BK_INFO> ) {
206 next if ( !/^(\d+\t(incr|full|partial)[\d\t]*$)/ );
208 @{$Backups[@Backups]}{@{$bpc->{BackupFields}}} = split(/\t/);
218 my($bpc, $host, @Backups) = @_;
219 local(*BK_INFO, *LOCK);
222 flock(LOCK, LOCK_EX) if open(LOCK, "$bpc->{TopDir}/pc/$host/LOCK");
223 if ( -s "$bpc->{TopDir}/pc/$host/backups" ) {
224 unlink("$bpc->{TopDir}/pc/$host/backups.old")
225 if ( -f "$bpc->{TopDir}/pc/$host/backups.old" );
226 rename("$bpc->{TopDir}/pc/$host/backups",
227 "$bpc->{TopDir}/pc/$host/backups.old")
228 if ( -f "$bpc->{TopDir}/pc/$host/backups" );
230 if ( open(BK_INFO, ">$bpc->{TopDir}/pc/$host/backups") ) {
232 for ( $i = 0 ; $i < @Backups ; $i++ ) {
233 my %b = %{$Backups[$i]};
234 printf(BK_INFO "%s\n", join("\t", @b{@{$bpc->{BackupFields}}}));
243 my($bpc, $host) = @_;
244 local(*RESTORE_INFO, *LOCK);
247 flock(LOCK, LOCK_EX) if open(LOCK, "$bpc->{TopDir}/pc/$host/LOCK");
248 if ( open(RESTORE_INFO, "$bpc->{TopDir}/pc/$host/restores") ) {
249 binmode(RESTORE_INFO);
250 while ( <RESTORE_INFO> ) {
252 next if ( !/^(\d+.*)/ );
254 @{$Restores[@Restores]}{@{$bpc->{RestoreFields}}} = split(/\t/);
264 my($bpc, $host, @Restores) = @_;
265 local(*RESTORE_INFO, *LOCK);
268 flock(LOCK, LOCK_EX) if open(LOCK, "$bpc->{TopDir}/pc/$host/LOCK");
269 if ( -s "$bpc->{TopDir}/pc/$host/restores" ) {
270 unlink("$bpc->{TopDir}/pc/$host/restores.old")
271 if ( -f "$bpc->{TopDir}/pc/$host/restores.old" );
272 rename("$bpc->{TopDir}/pc/$host/restores",
273 "$bpc->{TopDir}/pc/$host/restores.old")
274 if ( -f "$bpc->{TopDir}/pc/$host/restores" );
276 if ( open(RESTORE_INFO, ">$bpc->{TopDir}/pc/$host/restores") ) {
277 binmode(RESTORE_INFO);
278 for ( $i = 0 ; $i < @Restores ; $i++ ) {
279 my %b = %{$Restores[$i]};
280 printf(RESTORE_INFO "%s\n",
281 join("\t", @b{@{$bpc->{RestoreFields}}}));
290 my($bpc, $host) = @_;
291 local(*ARCHIVE_INFO, *LOCK);
294 flock(LOCK, LOCK_EX) if open(LOCK, "$bpc->{TopDir}/pc/$host/LOCK");
295 if ( open(ARCHIVE_INFO, "$bpc->{TopDir}/pc/$host/archives") ) {
296 binmode(ARCHIVE_INFO);
297 while ( <ARCHIVE_INFO> ) {
299 next if ( !/^(\d+.*)/ );
301 @{$Archives[@Archives]}{@{$bpc->{ArchiveFields}}} = split(/\t/);
311 my($bpc, $host, @Archives) = @_;
312 local(*ARCHIVE_INFO, *LOCK);
315 flock(LOCK, LOCK_EX) if open(LOCK, "$bpc->{TopDir}/pc/$host/LOCK");
316 if ( -s "$bpc->{TopDir}/pc/$host/archives" ) {
317 unlink("$bpc->{TopDir}/pc/$host/archives.old")
318 if ( -f "$bpc->{TopDir}/pc/$host/archives.old" );
319 rename("$bpc->{TopDir}/pc/$host/archives",
320 "$bpc->{TopDir}/pc/$host/archives.old")
321 if ( -f "$bpc->{TopDir}/pc/$host/archives" );
323 if ( open(ARCHIVE_INFO, ">$bpc->{TopDir}/pc/$host/archives") ) {
324 binmode(ARCHIVE_INFO);
325 for ( $i = 0 ; $i < @Archives ; $i++ ) {
326 my %b = %{$Archives[$i]};
327 printf(ARCHIVE_INFO "%s\n",
328 join("\t", @b{@{$bpc->{ArchiveFields}}}));
337 my($bpc, $host) = @_;
338 my($ret, $mesg, $config, @configs);
341 push(@configs, "$bpc->{TopDir}/conf/config.pl");
342 push(@configs, "$bpc->{TopDir}/conf/$host.pl")
343 if ( $host ne "config" && -f "$bpc->{TopDir}/conf/$host.pl" );
344 push(@configs, "$bpc->{TopDir}/pc/$host/config.pl")
345 if ( defined($host) && -f "$bpc->{TopDir}/pc/$host/config.pl" );
346 foreach $config ( @configs ) {
348 if ( !defined($ret = do $config) && ($! || $@) ) {
349 $mesg = "Couldn't open $config: $!" if ( $! );
350 $mesg = "Couldn't execute $config: $@" if ( $@ );
351 $mesg =~ s/[\n\r]+//;
354 %{$bpc->{Conf}} = ( %{$bpc->{Conf} || {}}, %Conf );
356 return if ( !defined($bpc->{Conf}{Language}) );
357 if ( defined($bpc->{Conf}{PerlModuleLoad}) ) {
359 # Load any user-specified perl modules. This is for
360 # optional user-defined extensions.
362 $bpc->{Conf}{PerlModuleLoad} = [$bpc->{Conf}{PerlModuleLoad}]
363 if ( ref($bpc->{Conf}{PerlModuleLoad}) ne "ARRAY" );
364 foreach my $module ( @{$bpc->{Conf}{PerlModuleLoad}} ) {
365 eval("use $module;");
368 my $langFile = "$bpc->{LibDir}/BackupPC/Lang/$bpc->{Conf}{Language}.pm";
369 if ( !defined($ret = do $langFile) && ($! || $@) ) {
370 $mesg = "Couldn't open language file $langFile: $!" if ( $! );
371 $mesg = "Couldn't execute language file $langFile: $@" if ( $@ );
372 $mesg =~ s/[\n\r]+//;
375 $bpc->{Lang} = \%Lang;
380 # Return the mtime of the config file
385 return (stat("$bpc->{TopDir}/conf/config.pl"))[9];
389 # Returns information from the host file in $bpc->{TopDir}/conf/hosts.
390 # With no argument a ref to a hash of hosts is returned. Each
391 # hash contains fields as specified in the hosts file. With an
392 # argument a ref to a single hash is returned with information
393 # for just that host.
397 my($bpc, $host) = @_;
398 my(%hosts, @hdr, @fld);
401 if ( !open(HOST_INFO, "$bpc->{TopDir}/conf/hosts") ) {
402 print(STDERR $bpc->timeStamp,
403 "Can't open $bpc->{TopDir}/conf/hosts\n");
407 while ( <HOST_INFO> ) {
411 next if ( /^\s*$/ || !/^([\w\.\\-]+\s+.*)/ );
413 # Split on white space, except if preceded by \
414 # using zero-width negative look-behind assertion
415 # (always wanted to use one of those).
417 @fld = split(/(?<!\\)\s+/, $1);
425 if ( defined($host) ) {
426 next if ( lc($fld[0]) ne $host );
427 @{$hosts{lc($fld[0])}}{@hdr} = @fld;
431 @{$hosts{lc($fld[0])}}{@hdr} = @fld;
442 # Return the mtime of the hosts file
447 return (stat("$bpc->{TopDir}/conf/hosts"))[9];
451 # Stripped down from File::Path. In particular we don't print
452 # many warnings and we try three times to delete each directory
453 # and file -- for some reason the original File::Path rmtree
454 # didn't always completely remove a directory tree on the NetApp.
456 # Warning: this routine changes the cwd.
460 my($bpc, $pwd, $roots) = @_;
463 if ( defined($roots) && length($roots) ) {
464 $roots = [$roots] unless ref $roots;
466 print(STDERR "RmTreeQuiet: No root path(s) specified\n");
469 foreach $root (@{$roots}) {
470 $root = $1 if ( $root =~ m{(.*?)/*$} );
472 # Try first to simply unlink the file: this avoids an
473 # extra stat for every file. If it fails (which it
474 # will for directories), check if it is a directory and
477 if ( !unlink($root) ) {
479 my $d = DirHandle->new($root);
480 if ( !defined($d) ) {
481 print(STDERR "Can't read $pwd/$root: $!\n");
485 @files = grep $_!~/^\.{1,2}$/, @files;
486 $bpc->RmTreeQuiet("$pwd/$root", \@files);
488 rmdir($root) || rmdir($root);
491 unlink($root) || unlink($root);
498 # Move a directory or file away for later deletion
502 my($bpc, $trashDir, $file) = @_;
505 return if ( !-e $file );
506 mkpath($trashDir, 0, 0777) if ( !-d $trashDir );
507 for ( $i = 0 ; $i < 1000 ; $i++ ) {
508 $f = sprintf("%s/%d_%d_%d", $trashDir, time, $$, $i);
510 return if ( rename($file, $f) );
512 # shouldn't get here, but might if you tried to call this
513 # across file systems.... just remove the tree right now.
514 if ( $file =~ /(.*)\/([^\/]*)/ ) {
517 my($cwd) = Cwd::fastcwd();
518 $cwd = $1 if ( $cwd =~ /(.*)/ );
519 $bpc->RmTreeQuiet($d, $f);
520 chdir($cwd) if ( $cwd );
525 # Empty the trash directory. Returns 0 if it did nothing, 1 if it
526 # did something, -1 if it failed to remove all the files.
530 my($bpc, $trashDir) = @_;
532 my($cwd) = Cwd::fastcwd();
534 $cwd = $1 if ( $cwd =~ /(.*)/ );
535 return if ( !-d $trashDir );
536 my $d = DirHandle->new($trashDir) or carp "Can't read $trashDir: $!";
539 @files = grep $_!~/^\.{1,2}$/, @files;
540 return 0 if ( !@files );
541 $bpc->RmTreeQuiet($trashDir, \@files);
542 foreach my $f ( @files ) {
543 return -1 if ( -e $f );
545 chdir($cwd) if ( $cwd );
550 # Open a connection to the server. Returns an error string on failure.
551 # Returns undef on success.
555 my($bpc, $host, $port, $justConnect) = @_;
558 return if ( defined($bpc->{ServerFD}) );
560 # First try the unix-domain socket
562 my $sockFile = "$bpc->{TopDir}/log/BackupPC.sock";
563 socket(*FH, PF_UNIX, SOCK_STREAM, 0) || return "unix socket: $!";
564 if ( !connect(*FH, sockaddr_un($sockFile)) ) {
565 my $err = "unix connect: $!";
568 my $proto = getprotobyname('tcp');
569 my $iaddr = inet_aton($host) || return "unknown host $host";
570 my $paddr = sockaddr_in($port, $iaddr);
572 socket(*FH, PF_INET, SOCK_STREAM, $proto)
573 || return "inet socket: $!";
574 connect(*FH, $paddr) || return "inet connect: $!";
579 my($oldFH) = select(*FH); $| = 1; select($oldFH);
580 $bpc->{ServerFD} = *FH;
581 return if ( $justConnect );
583 # Read the seed that we need for our MD5 message digest. See
586 sysread($bpc->{ServerFD}, $bpc->{ServerSeed}, 1024);
587 $bpc->{ServerMesgCnt} = 0;
592 # Check that the server connection is still ok
598 return 0 if ( !defined($bpc->{ServerFD}) );
599 vec(my $FDread, fileno($bpc->{ServerFD}), 1) = 1;
601 return 0 if ( select(my $rout = $FDread, undef, $ein, 0.0) < 0 );
602 return 1 if ( !vec($rout, fileno($bpc->{ServerFD}), 1) );
606 # Disconnect from the server
611 return if ( !defined($bpc->{ServerFD}) );
612 close($bpc->{ServerFD});
613 delete($bpc->{ServerFD});
617 # Sends a message to the server and returns with the reply.
619 # To avoid possible attacks via the TCP socket interface, every client
620 # message is protected by an MD5 digest. The MD5 digest includes four
622 # - a seed that is sent to us when we first connect
623 # - a sequence number that increments for each message
624 # - a shared secret that is stored in $Conf{ServerMesgSecret}
625 # - the message itself.
626 # The message is sent in plain text preceded by the MD5 digest. A
627 # snooper can see the plain-text seed sent by BackupPC and plain-text
628 # message, but cannot construct a valid MD5 digest since the secret in
629 # $Conf{ServerMesgSecret} is unknown. A replay attack is not possible
630 # since the seed changes on a per-connection and per-message basis.
634 my($bpc, $mesg) = @_;
635 return if ( !defined(my $fh = $bpc->{ServerFD}) );
636 my $md5 = Digest::MD5->new;
637 $md5->add($bpc->{ServerSeed} . $bpc->{ServerMesgCnt}
638 . $bpc->{Conf}{ServerMesgSecret} . $mesg);
639 print($fh $md5->b64digest . " $mesg\n");
640 $bpc->{ServerMesgCnt}++;
645 # Do initialization for child processes
651 open(STDERR, ">&STDOUT");
652 select(STDERR); $| = 1;
653 select(STDOUT); $| = 1;
654 $ENV{PATH} = $bpc->{Conf}{MyPath};
658 # Compute the MD5 digest of a file. For efficiency we don't
659 # use the whole file for big files:
660 # - for files <= 256K we use the file size and the whole file.
661 # - for files <= 1M we use the file size, the first 128K and
663 # - for files > 1M, we use the file size, the first 128K and
664 # the 8th 128K (ie: the 128K up to 1MB).
665 # See the documentation for a discussion of the tradeoffs in
666 # how much data we use and how many collisions we get.
668 # Returns the MD5 digest (a hex string) and the file size.
672 my($bpc, $md5, $name) = @_;
673 my($data, $fileSize);
676 $fileSize = (stat($name))[7];
677 return ("", -1) if ( !-f _ );
678 $name = $1 if ( $name =~ /(.*)/ );
679 return ("", 0) if ( $fileSize == 0 );
680 return ("", -1) if ( !open(N, $name) );
683 $md5->add($fileSize);
684 if ( $fileSize > 262144 ) {
686 # read the first and last 131072 bytes of the file,
689 my $seekPosn = ($fileSize > 1048576 ? 1048576 : $fileSize) - 131072;
690 $md5->add($data) if ( sysread(N, $data, 131072) );
691 $md5->add($data) if ( sysseek(N, $seekPosn, 0)
692 && sysread(N, $data, 131072) );
695 # read the whole file
697 $md5->add($data) if ( sysread(N, $data, $fileSize) );
700 return ($md5->hexdigest, $fileSize);
704 # Compute the MD5 digest of a buffer (string). For efficiency we don't
705 # use the whole string for big strings:
706 # - for files <= 256K we use the file size and the whole file.
707 # - for files <= 1M we use the file size, the first 128K and
709 # - for files > 1M, we use the file size, the first 128K and
710 # the 8th 128K (ie: the 128K up to 1MB).
711 # See the documentation for a discussion of the tradeoffs in
712 # how much data we use and how many collisions we get.
714 # Returns the MD5 digest (a hex string).
718 my($bpc, $md5, $fileSize, $dataRef) = @_;
721 $md5->add($fileSize);
722 if ( $fileSize > 262144 ) {
724 # add the first and last 131072 bytes of the string,
727 my $seekPosn = ($fileSize > 1048576 ? 1048576 : $fileSize) - 131072;
728 $md5->add(substr($$dataRef, 0, 131072));
729 $md5->add(substr($$dataRef, $seekPosn, 131072));
732 # add the whole string
734 $md5->add($$dataRef);
736 return $md5->hexdigest;
740 # Given an MD5 digest $d and a compress flag, return the full
745 my($bpc, $d, $compress, $poolDir) = @_;
747 return if ( $d !~ m{(.)(.)(.)(.*)} );
748 $poolDir = ($compress ? $bpc->{CPoolDir} : $bpc->{PoolDir})
749 if ( !defined($poolDir) );
750 return "$poolDir/$1/$2/$3/$1$2$3$4";
754 # For each file, check if the file exists in $bpc->{TopDir}/pool.
755 # If so, remove the file and make a hardlink to the file in
756 # the pool. Otherwise, if the newFile flag is set, make a
757 # hardlink in the pool to the new file.
759 # Returns 0 if a link should be made to a new file (ie: when the file
760 # is a new file but the newFile flag is 0).
761 # Returns 1 if a link to an existing file is made,
762 # Returns 2 if a link to a new file is made (only if $newFile is set)
763 # Returns negative on error.
767 my($bpc, $name, $d, $newFile, $compress) = @_;
770 return -1 if ( !-f $name );
771 for ( $i = -1 ; ; $i++ ) {
772 return -2 if ( !defined($rawFile = $bpc->MD52Path($d, $compress)) );
773 $rawFile .= "_$i" if ( $i >= 0 );
775 if ( (stat(_))[3] < $bpc->{Conf}{HardLinkMax}
776 && !compare($name, $rawFile) ) {
778 return -3 if ( !link($rawFile, $name) );
781 } elsif ( $newFile && -f $name && (stat($name))[3] == 1 ) {
783 ($newDir = $rawFile) =~ s{(.*)/.*}{$1};
784 mkpath($newDir, 0, 0777) if ( !-d $newDir );
785 return -4 if ( !link($name, $rawFile) );
795 my($bpc, $host) = @_;
796 my($s, $pingCmd, $ret);
799 # Return success if the ping cmd is undefined or empty.
801 if ( $bpc->{Conf}{PingCmd} eq "" ) {
802 print(STDERR "CheckHostAlive: return ok because \$Conf{PingCmd}"
803 . " is empty\n") if ( $bpc->{verbose} );
808 pingPath => $bpc->{Conf}{PingPath},
811 $pingCmd = $bpc->cmdVarSubstitute($bpc->{Conf}{PingCmd}, $args);
814 # Do a first ping in case the PC needs to wakeup
816 $s = $bpc->cmdSystemOrEval($pingCmd, undef, $args);
818 print(STDERR "CheckHostAlive: first ping failed ($?, $!)\n")
819 if ( $bpc->{verbose} );
824 # Do a second ping and get the round-trip time in msec
826 $s = $bpc->cmdSystemOrEval($pingCmd, undef, $args);
828 print(STDERR "CheckHostAlive: second ping failed ($?, $!)\n")
829 if ( $bpc->{verbose} );
832 if ( $s =~ /time=([\d\.]+)\s*ms/i ) {
834 } elsif ( $s =~ /time=([\d\.]+)\s*usec/i ) {
837 print(STDERR "CheckHostAlive: can't extract round-trip time"
838 . " (not fatal)\n") if ( $bpc->{verbose} );
841 print(STDERR "CheckHostAlive: returning $ret\n") if ( $bpc->{verbose} );
845 sub CheckFileSystemUsage
848 my($topDir) = $bpc->{TopDir};
851 return 0 if ( $bpc->{Conf}{DfCmd} eq "" );
853 dfPath => $bpc->{Conf}{DfPath},
854 topDir => $bpc->{TopDir},
856 $dfCmd = $bpc->cmdVarSubstitute($bpc->{Conf}{DfCmd}, $args);
857 $s = $bpc->cmdSystemOrEval($dfCmd, undef, $args);
858 return 0 if ( $? || $s !~ /(\d+)%/s );
863 # Given an IP address, return the host name and user name via
868 my($bpc, $host) = @_;
869 my($netBiosHostName, $netBiosUserName);
873 # Skip NetBios check if NmbLookupCmd is emtpy
875 if ( $bpc->{Conf}{NmbLookupCmd} eq "" ) {
876 print(STDERR "NetBiosInfoGet: return $host because \$Conf{NmbLookupCmd}"
877 . " is empty\n") if ( $bpc->{verbose} );
878 return ($host, undef);
882 nmbLookupPath => $bpc->{Conf}{NmbLookupPath},
885 $nmbCmd = $bpc->cmdVarSubstitute($bpc->{Conf}{NmbLookupCmd}, $args);
886 foreach ( split(/[\n\r]+/, $bpc->cmdSystemOrEval($nmbCmd, undef, $args)) ) {
887 next if ( !/^\s*([\w\s-]+?)\s*<(\w{2})\> - .*<ACTIVE>/i );
888 $netBiosHostName ||= $1 if ( $2 eq "00" ); # host is first 00
889 $netBiosUserName = $1 if ( $2 eq "03" ); # user is last 03
891 if ( !defined($netBiosHostName) ) {
892 print(STDERR "NetBiosInfoGet: failed: can't parse return string\n")
893 if ( $bpc->{verbose} );
896 $netBiosHostName = lc($netBiosHostName);
897 $netBiosUserName = lc($netBiosUserName);
898 print(STDERR "NetBiosInfoGet: success, returning host $netBiosHostName,"
899 . " user $netBiosUserName\n") if ( $bpc->{verbose} );
900 return ($netBiosHostName, $netBiosUserName);
904 # Given a NetBios name lookup the IP address via NetBios.
905 # In the case of a host returning multiple interfaces we
906 # return the first IP address that matches the subnet mask.
907 # If none match the subnet mask (or nmblookup doesn't print
908 # the subnet mask) then just the first IP address is returned.
910 sub NetBiosHostIPFind
912 my($bpc, $host) = @_;
913 my($netBiosHostName, $netBiosUserName);
914 my($s, $nmbCmd, $subnet, $ipAddr, $firstIpAddr);
917 # Skip NetBios lookup if NmbLookupFindHostCmd is emtpy
919 if ( $bpc->{Conf}{NmbLookupFindHostCmd} eq "" ) {
920 print(STDERR "NetBiosHostIPFind: return $host because"
921 . " \$Conf{NmbLookupFindHostCmd} is empty\n")
922 if ( $bpc->{verbose} );
927 nmbLookupPath => $bpc->{Conf}{NmbLookupPath},
930 $nmbCmd = $bpc->cmdVarSubstitute($bpc->{Conf}{NmbLookupFindHostCmd}, $args);
931 foreach my $resp ( split(/[\n\r]+/, $bpc->cmdSystemOrEval($nmbCmd, undef,
933 if ( $resp =~ /querying\s+\Q$host\E\s+on\s+(\d+\.\d+\.\d+\.\d+)/i ) {
935 $subnet = $1 if ( $subnet =~ /^(.*?)(\.255)+$/ );
936 } elsif ( $resp =~ /^\s*(\d+\.\d+\.\d+\.\d+)\s+\Q$host/ ) {
938 $firstIpAddr = $ip if ( !defined($firstIpAddr) );
939 $ipAddr = $ip if ( !defined($ipAddr) && $ip =~ /^\Q$subnet/ );
942 $ipAddr = $firstIpAddr if ( !defined($ipAddr) );
943 if ( defined($ipAddr) ) {
944 print(STDERR "NetBiosHostIPFind: found IP address $ipAddr for"
945 . " host $host\n") if ( $bpc->{verbose} );
948 print(STDERR "NetBiosHostIPFind: couldn't find IP address for"
949 . " host $host\n") if ( $bpc->{verbose} );
954 sub fileNameEltMangle
956 my($bpc, $name) = @_;
958 return "" if ( $name eq "" );
959 $name =~ s{([%/\n\r])}{sprintf("%%%02x", ord($1))}eg;
964 # We store files with every name preceded by "f". This
965 # avoids possible name conflicts with other information
966 # we store in the same directories (eg: attribute info).
967 # The process of turning a normal path into one with each
968 # node prefixed with "f" is called mangling.
972 my($bpc, $name) = @_;
974 $name =~ s{/([^/]+)}{"/" . $bpc->fileNameEltMangle($1)}eg;
975 $name =~ s{^([^/]+)}{$bpc->fileNameEltMangle($1)}eg;
980 # This undoes FileNameMangle
984 my($bpc, $name) = @_;
988 $name =~ s{%(..)}{chr(hex($1))}eg;
993 # Escape shell meta-characters with backslashes.
994 # This should be applied to each argument seperately, not an
995 # entire shell command.
1001 $cmd =~ s/([][;&()<>{}|^\n\r\t *\$\\'"`?])/\\$1/g;
1006 # For printing exec commands (which don't use a shell) so they look like
1007 # a valid shell command this function should be called with the exec
1008 # args. The shell command string is returned.
1010 sub execCmd2ShellCmd
1012 my($bpc, @args) = @_;
1015 foreach my $a ( @args ) {
1016 $str .= " " if ( $str ne "" );
1017 $str .= $bpc->shellEscape($a);
1023 # Do a URI-style escape to protect/encode special characters
1028 $s =~ s{([^\w.\/-])}{sprintf("%%%02X", ord($1));}eg;
1033 # Do a URI-style unescape to restore special characters
1038 $s =~ s{%(..)}{chr(hex($1))}eg;
1043 # Do variable substitution prior to execution of a command.
1045 sub cmdVarSubstitute
1047 my($bpc, $template, $vars) = @_;
1051 # Return without any substitution if the first entry starts with "&",
1052 # indicating this is perl code.
1054 if ( (ref($template) eq "ARRAY" ? $template->[0] : $template) =~ /^\&/ ) {
1057 if ( ref($template) ne "ARRAY" ) {
1059 # Split at white space, except if escaped by \
1061 $template = [split(/(?<!\\)\s+/, $template)];
1063 # Remove the \ that escaped white space.
1065 foreach ( @$template ) {
1070 # Merge variables into @tarClientCmd
1072 foreach my $arg ( @$template ) {
1074 # Replace scalar variables first
1076 $arg =~ s{\$(\w+)(\+?)}{
1077 exists($vars->{$1}) && ref($vars->{$1}) ne "ARRAY"
1078 ? ($2 eq "+" ? $bpc->shellEscape($vars->{$1}) : $vars->{$1})
1082 # Now replicate any array arguments; this just works for just one
1083 # array var in each argument.
1085 if ( $arg =~ m{(.*)\$(\w+)(\+?)(.*)} && ref($vars->{$2}) eq "ARRAY" ) {
1090 foreach my $v ( @{$vars->{$var}} ) {
1091 $v = $bpc->shellEscape($v) if ( $esc eq "+" );
1092 push(@cmd, "$pre$v$post");
1102 # Exec or eval a command. $cmd is either a string on an array ref.
1104 # @args are optional arguments for the eval() case; they are not used
1109 my($bpc, $cmd, @args) = @_;
1111 if ( (ref($cmd) eq "ARRAY" ? $cmd->[0] : $cmd) =~ /^\&/ ) {
1112 $cmd = join(" ", $cmd) if ( ref($cmd) eq "ARRAY" );
1113 print(STDERR "cmdExecOrEval: about to eval perl code $cmd\n")
1114 if ( $bpc->{verbose} );
1116 print(STDERR "Perl code fragment for exec shouldn't return!!\n");
1119 $cmd = [split(/\s+/, $cmd)] if ( ref($cmd) ne "ARRAY" );
1120 print(STDERR "cmdExecOrEval: about to exec ",
1121 $bpc->execCmd2ShellCmd(@$cmd), "\n")
1122 if ( $bpc->{verbose} );
1124 $cmd = [map { m/(.*)/ } @$cmd]; # untaint
1126 # force list-form of exec(), ie: no shell even for 1 arg
1128 exec { $cmd->[0] } @$cmd;
1129 print(STDERR "Exec failed for @$cmd\n");
1135 # System or eval a command. $cmd is either a string on an array ref.
1136 # $stdoutCB is a callback for output generated by the command. If it
1137 # is undef then output is returned. If it is a code ref then the function
1138 # is called with each piece of output as an argument. If it is a scalar
1139 # ref the output is appended to this variable.
1141 # @args are optional arguments for the eval() case; they are not used
1144 # Also, $? should be set when the CHILD pipe is closed.
1146 sub cmdSystemOrEvalLong
1148 my($bpc, $cmd, $stdoutCB, $ignoreStderr, $pidHandlerCB, @args) = @_;
1149 my($pid, $out, $allOut);
1152 if ( (ref($cmd) eq "ARRAY" ? $cmd->[0] : $cmd) =~ /^\&/ ) {
1153 $cmd = join(" ", $cmd) if ( ref($cmd) eq "ARRAY" );
1154 print(STDERR "cmdSystemOrEval: about to eval perl code $cmd\n")
1155 if ( $bpc->{verbose} );
1157 $$stdoutCB .= $out if ( ref($stdoutCB) eq 'SCALAR' );
1158 &$stdoutCB($out) if ( ref($stdoutCB) eq 'CODE' );
1159 print(STDERR "cmdSystemOrEval: finished: got output $out\n")
1160 if ( $bpc->{verbose} );
1161 return $out if ( !defined($stdoutCB) );
1164 $cmd = [split(/\s+/, $cmd)] if ( ref($cmd) ne "ARRAY" );
1165 print(STDERR "cmdSystemOrEval: about to system ",
1166 $bpc->execCmd2ShellCmd(@$cmd), "\n")
1167 if ( $bpc->{verbose} );
1168 if ( !defined($pid = open(CHILD, "-|")) ) {
1169 my $err = "Can't fork to run @$cmd\n";
1171 $$stdoutCB .= $err if ( ref($stdoutCB) eq 'SCALAR' );
1172 &$stdoutCB($err) if ( ref($stdoutCB) eq 'CODE' );
1173 return $err if ( !defined($stdoutCB) );
1182 if ( $ignoreStderr ) {
1183 open(STDERR, ">", "/dev/null");
1185 open(STDERR, ">&STDOUT");
1188 $cmd = [map { m/(.*)/ } @$cmd]; # untaint
1190 # force list-form of exec(), ie: no shell even for 1 arg
1192 exec { $cmd->[0] } @$cmd;
1193 print(STDERR "Exec of @$cmd failed\n");
1198 # Notify caller of child's pid
1200 &$pidHandlerCB($pid) if ( ref($pidHandlerCB) eq "CODE" );
1203 # The parent gathers the output from the child
1206 $$stdoutCB .= $_ if ( ref($stdoutCB) eq 'SCALAR' );
1207 &$stdoutCB($_) if ( ref($stdoutCB) eq 'CODE' );
1208 $out .= $_ if ( !defined($stdoutCB) );
1209 $allOut .= $_ if ( $bpc->{verbose} );
1214 print(STDERR "cmdSystemOrEval: finished: got output $allOut\n")
1215 if ( $bpc->{verbose} );
1220 # The shorter version that sets $ignoreStderr = 0, ie: merges stdout
1221 # and stderr together.
1225 my($bpc, $cmd, $stdoutCB, @args) = @_;
1227 return $bpc->cmdSystemOrEvalLong($cmd, $stdoutCB, 0, undef, @args);
1232 # Promotes $conf->{BackupFilesOnly}, $conf->{BackupFilesExclude}
1233 # to hashes and $conf->{$shareName} to an array
1235 sub backupFileConfFix
1237 my($bpc, $conf, $shareName) = @_;
1239 $conf->{$shareName} = [ $conf->{$shareName} ]
1240 if ( ref($conf->{$shareName}) ne "ARRAY" );
1241 foreach my $param qw(BackupFilesOnly BackupFilesExclude) {
1242 next if ( !defined($conf->{$param}) || ref($conf->{$param}) eq "HASH" );
1243 $conf->{$param} = [ $conf->{$param} ]
1244 if ( ref($conf->{$param}) ne "ARRAY" );
1245 $conf->{$param} = { map { $_ => $conf->{$param} } @{$conf->{$shareName}} };