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  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 1.5.0, released 2 Aug 2002.
  33 #
  34 # See http://backuppc.sourceforge.net.
  35 #
  36 #========================================================================
  37
  38 package BackupPC::Xfer::Smb;
  39
  40 use strict;
  41
  42 sub new
  43 {
  44     my($class, $bpc, $args) = @_;
  45
  46     my $t = bless {
  47         bpc       => $bpc,
  48         conf      => { $bpc->Conf },
  49         host      => "",
  50         hostIP    => "",
  51         shareName => "",
  52         pipeRH    => undef,
  53         pipeWH    => undef,
  54         badFiles  => [],
  55         %$args,
  56     }, $class;
  57
  58     return $t;
  59 }
  60
  61 sub start
  62 {
  63     my($t) = @_;
  64     my $bpc = $t->{bpc};
  65     my $conf = $t->{conf};
  66     my $I_option = $t->{hostIP} eq $t->{host} ? "" : " -I $t->{hostIP}";
  67     my($fileList, $optX, $smbClientCmd, $logMsg);
  68     local(*SMB);
  69
  70     #
  71     # First propagate the PASSWD setting
  72     #
  73     $ENV{PASSWD} = $conf->{SmbSharePasswd}
  74                                  if ( defined($conf->{SmbSharePasswd}) );
  75     if ( !defined($ENV{PASSWD}) ) {
  76         $t->{_errStr} = "passwd not set for smbclient";
  77         return;
  78     }
  79     if ( $t->{type} eq "restore" ) {
  80         $smbClientCmd =
  81               "$conf->{SmbClientPath} '\\\\$t->{host}\\$t->{shareName}'"
  82             . "$I_option -U '$conf->{SmbShareUserName}' -E -N -d 1"
  83             . " $conf->{SmbClientArgs}"
  84             . " -c 'tarmode full' -Tx -";
  85         $logMsg = "restore started for share $t->{shareName}";
  86     } else {
  87         #
  88         # Turn $conf->{BackupFilesOnly} and $conf->{BackupFilesExclude}
  89         # into a hash of arrays of files
  90         #
  91         $conf->{SmbShareName} = [ $conf->{SmbShareName} ]
  92                         unless ref($conf->{SmbShareName}) eq "ARRAY";
  93         foreach my $param qw(BackupFilesOnly BackupFilesExclude) {
  94             next if ( !defined($conf->{$param}) );
  95             if ( ref($conf->{$param}) eq "ARRAY" ) {
  96                 $conf->{$param} = {
  97                         $conf->{SmbShareName}[0] => $conf->{$param}
  98                 };
  99             } elsif ( ref($conf->{$param}) eq "HASH" ) {
 100                 # do nothing
 101             } else {
 102                 $conf->{$param} = {
 103                         $conf->{SmbShareName}[0] => [ $conf->{$param} ]
 104                 };
 105             }
 106         }
 107         if ( defined($conf->{BackupFilesOnly}{$t->{shareName}}) ) {
 108             foreach my $file ( @{$conf->{BackupFilesOnly}{$t->{shareName}}} ) {
 109                 $file =~ s/'/\\'/g;
 110                 $fileList .= "'$file' ";
 111             }
 112         } elsif ( defined($conf->{BackupFilesExclude}{$t->{shareName}}) ) {
 113             foreach my $file ( @{$conf->{BackupFilesExclude}{$t->{shareName}}} )
 114             {
 115                 $file =~ s/'/\\'/g;
 116                 $fileList .= "'$file' ";
 117             }
 118             #
 119             # Allow simple wildcards in exclude list by specifying "r" option.
 120             #
 121             $optX = "rX";
 122         }
 123         if ( $t->{type} eq "full" ) {
 124             $smbClientCmd =
 125                   "$conf->{SmbClientPath} '\\\\$t->{host}\\$t->{shareName}'"
 126                 . "$I_option -U '$conf->{SmbShareUserName}' -E -N -d 1"
 127                 . " $conf->{SmbClientArgs}"
 128                 . " -c 'tarmode full'"
 129                 . " -Tc$optX - $fileList";
 130             $logMsg = "full backup started for share $t->{shareName}";
 131         } else {
 132             my $timeStampFile = "$t->{outDir}/timeStamp.level0";
 133             open(LEV0, ">$timeStampFile") && close(LEV0);
 134             utime($t->{lastFull} - 3600, $t->{lastFull} - 3600, $timeStampFile);
 135             $smbClientCmd =
 136                   "$conf->{SmbClientPath} '\\\\$t->{host}\\$t->{shareName}'"
 137                 . "$I_option -U '$conf->{SmbShareUserName}' -E -N -d 1"
 138                 . " $conf->{SmbClientArgs}"
 139                 . " -c 'tarmode full'"
 140                 . " -TcN$optX $timeStampFile - $fileList";
 141             $logMsg = "incr backup started back to "
 142                         . $bpc->timeStamp($t->{lastFull} - 3600, 0)
 143                         . "for share $t->{shareName}";
 144         }
 145     }
 146     if ( !defined($t->{xferPid} = open(SMB, "-|")) ) {
 147         $t->{_errStr} = "Can't fork to run smbclient";
 148         return;
 149     }
 150     $t->{pipeSMB} = *SMB;
 151     if ( !$t->{xferPid} ) {
 152         #
 153         # This is the smbclient child.
 154         #
 155         setpgrp 0,0;
 156         if ( $t->{type} eq "restore" ) {
 157             #
 158             # For restores close the write end of the pipe,
 159             # clone STDIN from RH, and STDERR to STDOUT
 160             #
 161             close($t->{pipeWH});
 162             close(STDERR);
 163             open(STDERR, ">&STDOUT");
 164             close(STDIN);
 165             open(STDIN, "<&$t->{pipeRH}");
 166         } else {
 167             #
 168             # For backups close the read end of the pipe,
 169             # clone STDOUT to WH, STDERR to STDOUT
 170             #
 171             close($t->{pipeRH});
 172             close(STDERR);
 173             open(STDERR, ">&STDOUT");
 174             open(STDOUT, ">&$t->{pipeWH}");
 175         }
 176         #
 177         # exec smbclient.
 178         #
 179         exec($smbClientCmd);
 180         # should not be reached, but just in case...
 181         $t->{_errStr} = "Can't exec $conf->{SmbClientPath}";
 182         return;
 183     }
 184     $t->{XferLOG}->write(\"Running: $smbClientCmd\n");
 185     alarm($conf->{SmbClientTimeout});
 186     $t->{_errStr} = undef;
 187     return $logMsg;
 188 }
 189
 190 sub readOutput
 191 {
 192     my($t, $FDreadRef, $rout) = @_;
 193     my $conf = $t->{conf};
 194
 195     if ( vec($rout, fileno($t->{pipeSMB}), 1) ) {
 196         my $mesg;
 197         if ( sysread($t->{pipeSMB}, $mesg, 8192) <= 0 ) {
 198             vec($$FDreadRef, fileno($t->{pipeSMB}), 1) = 0;
 199             close($t->{pipeSMB});
 200         } else {
 201             $t->{smbOut} .= $mesg;
 202         }
 203     }
 204     while ( $t->{smbOut} =~ /(.*?)[\n\r]+(.*)/s ) {
 205         $_ = $1;
 206         $t->{smbOut} = $2;
 207         $t->{XferLOG}->write(\"$_\n");
 208         #
 209         # refresh our inactivity alarm
 210         #
 211         alarm($conf->{SmbClientTimeout});
 212         $t->{lastOutputLine} = $_ if ( !/^$/ );
 213         #
 214         # This section is highly dependent on the version of smbclient.
 215         # If you upgrade Samba, make sure that these regexp are still valid.
 216         #
 217         if ( /^\s*(-?\d+) \(\s*\d+\.\d kb\/s\) (.*)$/ ) {
 218             my $sambaFileSize = $1;
 219             my $pcFileName    = $2;
 220             (my $fileName = $pcFileName) =~ s/\\/\//g;
 221             $sambaFileSize += 1024 * 1024 * 4096 if ( $sambaFileSize < 0 );
 222             $fileName =~ s/^\/*//;
 223             $t->{byteCnt} += $sambaFileSize;
 224             $t->{fileCnt}++;
 225         } elsif ( /restore tar file (.*) of size (\d+) bytes/ ) {
 226             $t->{byteCnt} += $2;
 227             $t->{fileCnt}++;
 228         } elsif ( /tar: dumped \d+ files/ ) {
 229             $t->{xferOK} = 1;
 230         } elsif ( /^tar: restored \d+ files/ ) {
 231             $t->{xferOK} = 1;
 232         } elsif ( /^read_socket_with_timeout: timeout read. /i ) {
 233             $t->{hostAbort} = 1;
 234         } elsif ( /^code 0 listing /
 235                     || /^code 0 opening /
 236                     || /^abandoning restore/i
 237                     || /^Error: Looping in FIND_NEXT/i ) {
 238             $t->{hostError} ||= $_;
 239         } elsif ( /smb: \\>/
 240                 || /^added interface/i
 241                 || /^tarmode is now/i
 242                 || /^Total bytes written/i
 243                 || /^Domain=/i
 244                 || /^\([\d\.]* kb\/s\) \(average [\d\.]* kb\/s\)$/i
 245                 || /^Getting files newer than/i
 246                 || /^\s+directory \\/i
 247                 || /^Output is \/dev\/null/i
 248                 || /^Timezone is/i ) {
 249             # ignore these messages
 250         } else {
 251             $t->{xferErrCnt}++;
 252             $t->{xferBadShareCnt}++ if ( /^ERRDOS - ERRbadshare/ );
 253             $t->{xferBadFileCnt}++  if ( /^ERRDOS - ERRbadfile/ );
 254             if ( $t->{xferErrCnt} > 50000 ) {
 255                 $t->logMsg(
 256                       "Too many smbtar errors ($t->{xferErrCnt})... giving up");
 257                 $t->{hostError} = "Too many smbtar errors ($t->{xferErrCnt})";
 258                 return;
 259             }
 260             if ( /^Error reading file (.*)\. Got 0 bytes/ ) {
 261                 #
 262                 # This happens when a Windoze application has
 263                 # locked the file.  This is a particular problem
 264                 # with MS-Outlook.  smbclient has already written
 265                 # the tar header to stdout, so all it can do is to
 266                 # write a dummy file with the correct size, but all
 267                 # zeros. BackupPC_tarExtract stores these
 268                 # zero-content files efficiently as a sparse file,
 269                 # or if compression is on the file will be small
 270                 # anyhow.  After the dump is done we simply delete
 271                 # the file (it is no use) and try to link it to same
 272                 # file in any recent backup.
 273                 #
 274                 my $badFile = $1;
 275                 $badFile =~ s{\\}{/}g;
 276                 $badFile =~ s{^/}{};
 277                 push(@{$t->{badFiles}}, "$t->{shareName}/$badFile");
 278             }
 279         }
 280     }
 281     return 1;
 282 }
 283
 284 sub setSelectMask
 285 {
 286     my($t, $FDreadRef) = @_;
 287
 288     vec($$FDreadRef, fileno($t->{pipeSMB}), 1) = 1;
 289 }
 290
 291 sub errStr
 292 {
 293     my($t) = @_;
 294
 295     return $t->{_errStr};
 296 }
 297
 298 sub xferPid
 299 {
 300     my($t) = @_;
 301
 302     return $t->{xferPid};
 303 }
 304
 305 sub logMsg
 306 {
 307     my($t, $msg) = @_;
 308
 309     push(@{$t->{_logMsg}}, $msg);
 310 }
 311
 312 sub logMsgGet
 313 {
 314     my($t) = @_;
 315
 316     return shift(@{$t->{_logMsg}});
 317 }
 318
 319 #
 320 # Returns a hash ref giving various status information about
 321 # the transfer.
 322 #
 323 sub getStats
 324 {
 325     my($t) = @_;
 326
 327     return { map { $_ => $t->{$_} }
 328             qw(byteCnt fileCnt xferErrCnt xferBadShareCnt xferBadFileCnt
 329                xferOK hostAbort hostError lastOutputLine)
 330     };
 331 }
 332
 333 sub getBadFiles
 334 {
 335     my($t) = @_;
 336
 337     return @{$t->{badFiles}};
 338 }
 339
 340 1;