lib/BackupPC/Xfer/Smb.pm

   1 #============================================================= -*-perl-*-
   2 #
   3 # BackupPC::Xfer::Smb package
   4 #
   5 # DESCRIPTION
   6 #
   7 #   This library defines a BackupPC::Xfer::Smb class for managing
   8 #   the SMB (smbclient) transport of backup data from the client.
   9 #
  10 # AUTHOR
  11 #   Craig Barratt  <cbarratt@users.sourceforge.net>
  12 #
  13 # COPYRIGHT
  14 #   Copyright (C) 2001-2003  Craig Barratt
  15 #
  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.
  20 #
  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.
  25 #
  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
  29 #
  30 #========================================================================
  31 #
  32 # Version 3.1.0beta0, released 3 Sep 2007.
  33 #
  34 # See http://backuppc.sourceforge.net.
  35 #
  36 #========================================================================
  37
  38 package BackupPC::Xfer::Smb;
  39
  40 use strict;
  41 use Encode qw/from_to encode/;
  42
  43 sub new
  44 {
  45     my($class, $bpc, $args) = @_;
  46
  47     $args ||= {};
  48     my $t = bless {
  49         bpc       => $bpc,
  50         conf      => { $bpc->Conf },
  51         host      => "",
  52         hostIP    => "",
  53         shareName => "",
  54         pipeRH    => undef,
  55         pipeWH    => undef,
  56         badFiles  => [],
  57         %$args,
  58     }, $class;
  59
  60     return $t;
  61 }
  62
  63 sub args
  64 {
  65     my($t, $args) = @_;
  66
  67     foreach my $arg ( keys(%$args) ) {
  68         $t->{$arg} = $args->{$arg};
  69     }
  70 }
  71
  72 sub useTar
  73 {
  74     return 1;
  75 }
  76
  77 sub start
  78 {
  79     my($t) = @_;
  80     my $bpc = $t->{bpc};
  81     my $conf = $t->{conf};
  82     my $I_option = $t->{hostIP} eq $t->{host} ? [] : ['-I', $t->{hostIP}];
  83     my(@fileList, $X_option, $smbClientCmd, $logMsg);
  84     my($timeStampFile);
  85     local(*SMB);
  86
  87     #
  88     # First propagate the PASSWD setting
  89     #
  90     $ENV{PASSWD} = $ENV{BPC_SMB_PASSWD} if ( defined($ENV{BPC_SMB_PASSWD}) );
  91     $ENV{PASSWD} = $conf->{SmbSharePasswd}
  92                                  if ( defined($conf->{SmbSharePasswd}) );
  93     if ( !defined($ENV{PASSWD}) ) {
  94         $t->{_errStr} = "passwd not set for smbclient";
  95         return;
  96     }
  97     if ( !defined($conf->{SmbClientPath}) || !-x $conf->{SmbClientPath} ) {
  98         $t->{_errStr} = '$Conf{SmbClientPath} is not a valid executable';
  99         return;
 100     }
 101     if ( $t->{type} eq "restore" ) {
 102         $smbClientCmd = $conf->{SmbClientRestoreCmd};
 103         $logMsg = "restore started for share $t->{shareName}";
 104     } else {
 105         #
 106         # Turn $conf->{BackupFilesOnly} and $conf->{BackupFilesExclude}
 107         # into a hash of arrays of files, and $conf->{SmbShareName}
 108         # to an array
 109         #
 110         $bpc->backupFileConfFix($conf, "SmbShareName");
 111
 112         $t->{fileIncludeHash} = {};
 113         if ( defined($conf->{BackupFilesOnly}{$t->{shareName}}) ) {
 114             foreach my $file ( @{$conf->{BackupFilesOnly}{$t->{shareName}}} ) {
 115                 $file = encode($conf->{ClientCharset}, $file)
 116                             if ( $conf->{ClientCharset} ne "" );
 117                 push(@fileList, $file);
 118                 $t->{fileIncludeHash}{$file} = 1;
 119             }
 120         } elsif ( defined($conf->{BackupFilesExclude}{$t->{shareName}}) ) {
 121             foreach my $file ( @{$conf->{BackupFilesExclude}{$t->{shareName}}} )
 122             {
 123                 $file = encode($conf->{ClientCharset}, $file)
 124                             if ( $conf->{ClientCharset} ne "" );
 125                 push(@fileList, $file);
 126             }
 127             #
 128             # Allow simple wildcards in exclude list by specifying "r" option.
 129             #
 130             $X_option = "rX";
 131         }
 132         if ( $t->{type} eq "full" ) {
 133             $smbClientCmd = $conf->{SmbClientFullCmd};
 134             $logMsg = "full backup started for share $t->{shareName}";
 135         } else {
 136             $timeStampFile = "$t->{outDir}/timeStamp.level0";
 137             open(LEV0, ">", $timeStampFile) && close(LEV0);
 138             utime($t->{incrBaseTime} - 3600, $t->{incrBaseTime} - 3600,
 139                   $timeStampFile);
 140             $smbClientCmd = $conf->{SmbClientIncrCmd};
 141             $logMsg = "incr backup started back to "
 142                     . $bpc->timeStamp($t->{incrBaseTime} - 3600, 0)
 143                     . " (backup #$t->{incrBaseBkupNum}) for share"
 144                     . " $t->{shareName}";
 145         }
 146     }
 147     my $args = {
 148         smbClientPath => $conf->{SmbClientPath},
 149         host          => $t->{host},
 150         hostIP        => $t->{hostIP},
 151         client        => $t->{client},
 152         shareName     => $t->{shareName},
 153         userName      => $conf->{SmbShareUserName},
 154         fileList      => \@fileList,
 155         I_option      => $I_option,
 156         X_option      => $X_option,
 157         timeStampFile => $timeStampFile,
 158     };
 159     from_to($args->{shareName}, "utf8", $conf->{ClientCharset})
 160                             if ( $conf->{ClientCharset} ne "" );
 161     $smbClientCmd = $bpc->cmdVarSubstitute($smbClientCmd, $args);
 162
 163     if ( !defined($t->{xferPid} = open(SMB, "-|")) ) {
 164         $t->{_errStr} = "Can't fork to run smbclient";
 165         return;
 166     }
 167     $t->{pipeSMB} = *SMB;
 168     if ( !$t->{xferPid} ) {
 169         #
 170         # This is the smbclient child.
 171         #
 172         setpgrp 0,0;
 173         if ( $t->{type} eq "restore" ) {
 174             #
 175             # For restores close the write end of the pipe,
 176             # clone STDIN from RH, and STDERR to STDOUT
 177             #
 178             close($t->{pipeWH});
 179             close(STDERR);
 180             open(STDERR, ">&STDOUT");
 181             close(STDIN);
 182             open(STDIN, "<&$t->{pipeRH}");
 183         } else {
 184             #
 185             # For backups close the read end of the pipe,
 186             # clone STDOUT to WH, STDERR to STDOUT
 187             #
 188             close($t->{pipeRH});
 189             close(STDERR);
 190             open(STDERR, ">&STDOUT");
 191             open(STDOUT, ">&$t->{pipeWH}");
 192         }
 193         #
 194         # Run smbclient.
 195         #
 196         alarm(0);
 197         $bpc->cmdExecOrEval($smbClientCmd, $args);
 198         # should not be reached, but just in case...
 199         $t->{_errStr} = "Can't exec $conf->{SmbClientPath}";
 200         return;
 201     }
 202     my $str = "Running: " . $bpc->execCmd2ShellCmd(@$smbClientCmd) . "\n";
 203     from_to($str, $conf->{ClientCharset}, "utf8")
 204                             if ( $conf->{ClientCharset} ne "" );
 205     $t->{XferLOG}->write(\$str);
 206     alarm($conf->{ClientTimeout});
 207     $t->{_errStr} = undef;
 208     return $logMsg;
 209 }
 210
 211 sub readOutput
 212 {
 213     my($t, $FDreadRef, $rout) = @_;
 214     my $conf = $t->{conf};
 215
 216     if ( vec($rout, fileno($t->{pipeSMB}), 1) ) {
 217         my $mesg;
 218         if ( sysread($t->{pipeSMB}, $mesg, 8192) <= 0 ) {
 219             vec($$FDreadRef, fileno($t->{pipeSMB}), 1) = 0;
 220             close($t->{pipeSMB});
 221         } else {
 222             $t->{smbOut} .= $mesg;
 223         }
 224     }
 225     while ( $t->{smbOut} =~ /(.*?)[\n\r]+(.*)/s ) {
 226         $_ = $1;
 227         $t->{smbOut} = $2;
 228         #
 229         # ignore the log file time stamps from smbclient introduced
 230         # in version 3.0.0 - don't even write them to the log file.
 231         #
 232         if ( m{^\[\d+/\d+/\d+ +\d+:\d+:\d+.*\] +(client/cli|lib/util_unistr).*\(\d+\)} ) {
 233             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 5 );
 234             next;
 235         }
 236         #
 237         # refresh our inactivity alarm
 238         #
 239         alarm($conf->{ClientTimeout}) if ( !$t->{abort} );
 240         $t->{lastOutputLine} = $_ if ( !/^$/ );
 241
 242         from_to($_, $conf->{ClientCharset}, "utf8")
 243                             if ( $conf->{ClientCharset} ne "" );
 244         #
 245         # This section is highly dependent on the version of smbclient.
 246         # If you upgrade Samba, make sure that these regexp are still valid.
 247         #
 248         if ( /^\s*(-?\d+) \(\s*\d+[.,]\d kb\/s\) (.*)$/ ) {
 249             my $sambaFileSize = $1;
 250             my $pcFileName    = $2;
 251             (my $fileName = $pcFileName) =~ s/\\/\//g;
 252             $sambaFileSize += 1024 * 1024 * 4096 if ( $sambaFileSize < 0 );
 253             $fileName =~ s/^\/*//;
 254             $t->{byteCnt} += $sambaFileSize;
 255             $t->{fileCnt}++;
 256             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 2 );
 257         } elsif ( /restore tar file (.*) of size (\d+) bytes/ ) {
 258             $t->{byteCnt} += $2;
 259             $t->{fileCnt}++;
 260             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 1 );
 261         } elsif ( /^\s*tar: dumped \d+ files/ ) {
 262             $t->{xferOK} = 1;
 263             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 0 );
 264         } elsif ( /^\s*tar: restored \d+ files/ ) {
 265             $t->{xferOK} = 1;
 266             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 0 );
 267         } elsif ( /^\s*read_socket_with_timeout: timeout read. /i ) {
 268             $t->{hostAbort} = 1;
 269             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 0 );
 270         } elsif ( /^code 0 listing /
 271                     || /^\s*code 0 opening /
 272                     || /^\s*abandoning restore/i
 273                     || /^\s*Error: Looping in FIND_NEXT/i
 274                     || /^\s*SUCCESS - 0/i
 275                     || /^\s*Call timed out: server did not respond/i
 276                     || /^\s*tree connect failed: ERRDOS - ERRnoaccess \(Access denied\.\)/
 277                     || /^\s*tree connect failed: NT_STATUS_BAD_NETWORK_NAME/
 278                     || /^\s*NT_STATUS_INSUFF_SERVER_RESOURCES listing /
 279                  ) {
 280             if ( $t->{hostError} eq "" ) {
 281                 $t->{XferLOG}->write(\"This backup will fail because: $_\n");
 282                 $t->{hostError} = $_;
 283             }
 284             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 0 );
 285         } elsif ( /^\s*NT_STATUS_ACCESS_DENIED listing (.*)/
 286                || /^\s*ERRDOS - ERRnoaccess \(Access denied\.\) listing (.*)/ ) {
 287             my $badDir = $1;
 288             $badDir =~ s{\\}{/}g;
 289             $badDir =~ s{/+}{/}g;
 290             $badDir =~ s{/\*$}{};
 291             if ( $t->{hostError} eq ""
 292                     && ($badDir eq "" || $t->{fileIncludeHash}{$badDir}) ) {
 293                 $t->{XferLOG}->write(\"This backup will fail because: $_\n");
 294                 $t->{hostError} ||= $_;
 295             }
 296             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 0 );
 297         } elsif ( /^\s*directory \\/i ) {
 298             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 2 );
 299         } elsif ( /smb: \\>/
 300                 || /^\s*added interface/i
 301                 || /^\s*tarmode is now/i
 302                 || /^\s*Total bytes written/i
 303                 || /^\s*Domain=/i
 304                 || /^\([\d\.]* kb\/s\) \(average [\d\.]* kb\/s\)$/i
 305                 || /^\s*Getting files newer than/i
 306                 || /^\s*restore directory \\/i
 307                 || /^\s*Output is \/dev\/null/i
 308                 || /^\s*Timezone is/i
 309                 || /^\s*tar_re_search set/i
 310                 || /^\s*creating lame (up|low)case table/i
 311             ) {
 312             # ignore these messages
 313             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 1 );
 314         } else {
 315             $t->{xferErrCnt}++;
 316             $t->{xferBadShareCnt}++ if ( /^ERRDOS - ERRbadshare/ );
 317             $t->{xferBadFileCnt}++  if ( /^ERRDOS - ERRbadfile/ );
 318             if ( $t->{xferErrCnt} > 50000 ) {
 319                 $t->logMsg(
 320                       "Too many smbtar errors ($t->{xferErrCnt})... giving up");
 321                 $t->{hostError} = "Too many smbtar errors ($t->{xferErrCnt})";
 322                 return;
 323             }
 324             if ( /^Error reading file (.*)\. Got 0 bytes/ ) {
 325                 #
 326                 # This happens when a Windoze application has
 327                 # locked the file.  This is a particular problem
 328                 # with MS-Outlook.  smbclient has already written
 329                 # the tar header to stdout, so all it can do is to
 330                 # write a dummy file with the correct size, but all
 331                 # zeros. BackupPC_tarExtract stores these
 332                 # zero-content files efficiently as a sparse file,
 333                 # or if compression is on the file will be small
 334                 # anyhow.  After the dump is done we simply delete
 335                 # the file (it is no use) and try to link it to same
 336                 # file in any recent backup.
 337                 #
 338                 my $badFile = $1;
 339                 $badFile =~ s{\\}{/}g;
 340                 $badFile =~ s{^/}{};
 341                 push(@{$t->{badFiles}}, {
 342                         share => $t->{shareName},
 343                         file  => $badFile
 344                     });
 345             }
 346             $t->{XferLOG}->write(\"$_\n") if ( $t->{logLevel} >= 1 );
 347         }
 348     }
 349     return 1;
 350 }
 351
 352 sub abort
 353 {
 354     my($t, $reason) = @_;
 355
 356     $t->{abort} = 1;
 357     $t->{abortReason} = $reason;
 358 }
 359
 360 sub setSelectMask
 361 {
 362     my($t, $FDreadRef) = @_;
 363
 364     vec($$FDreadRef, fileno($t->{pipeSMB}), 1) = 1;
 365 }
 366
 367 sub errStr
 368 {
 369     my($t) = @_;
 370
 371     return $t->{_errStr};
 372 }
 373
 374 sub xferPid
 375 {
 376     my($t) = @_;
 377
 378     return ($t->{xferPid});
 379 }
 380
 381 sub logMsg
 382 {
 383     my($t, $msg) = @_;
 384
 385     push(@{$t->{_logMsg}}, $msg);
 386 }
 387
 388 sub logMsgGet
 389 {
 390     my($t) = @_;
 391
 392     return shift(@{$t->{_logMsg}});
 393 }
 394
 395 #
 396 # Returns a hash ref giving various status information about
 397 # the transfer.
 398 #
 399 sub getStats
 400 {
 401     my($t) = @_;
 402
 403     return { map { $_ => $t->{$_} }
 404             qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt
 405                xferOK hostAbort hostError lastOutputLine)
 406     };
 407 }
 408
 409 sub getBadFiles
 410 {
 411     my($t) = @_;
 412
 413     return @{$t->{badFiles}};
 414 }
 415
 416 1;