Line # Revision Author
1 1 dpavlin #!/usr/bin/perl -w
2 #
3 # psinib - Perl Snapshot Is Not Incremental Backup
4 #
5 # written by Dobrica Pavlinusic <dpavlin@rot13.org> 2003-01-03
6 # released under GPL v2 or later.
7 #
8 # Backup SMB directories using file produced by LinNeighbourhood (or some
9 # other program [vi :-)] which produces file in format:
10 #
11 # smbmount service mountpoint options
12 #
13 #
14 # usage:
15 8 dpavlin # $ psinib.pl mountscript
16 1 dpavlin
17 use strict 'vars';
18 use Data::Dumper;
19 use Net::Ping;
20 use POSIX qw(strftime);
21 34 dpavlin use List::Compare 0.30;
22 1 dpavlin use Filesys::SmbClient;
23 #use Taint;
24 5 dpavlin use Fcntl qw(LOCK_EX LOCK_NB);
25 8 dpavlin use Digest::MD5;
26 use File::Basename;
27 19 dpavlin use Getopt::Long;
28 28 dpavlin use File::Path;
29 31 dpavlin use Pod::Usage;
30 use Filesys::Df;
31 1 dpavlin
32 50 dpavlin my $VERSION = '1.0-rc4';
33 29 dpavlin
34 1 dpavlin # configuration
35 my $LOG_TIME_FMT = '%Y-%m-%d %H:%M:%S'; # strftime format for logfile
36 my $DIR_TIME_FMT = '%Y%m%d'; # strftime format for backup dir
37
38 21 dpavlin # define timeout for ping
39 my $PING_TIMEOUT = 5;
40
41 1 dpavlin my $LOG = '/var/log/backup.log'; # add path here...
42 9 dpavlin #$LOG = '/tmp/backup.log';
43 1 dpavlin
44 # store backups in which directory
45 31 dpavlin my $BACKUP_DEST = '/backup/';
46 1 dpavlin
47 # files to ignore in backup
48 my @ignore = ('.md5sum', '.backupignore', 'backupignore.txt');
49
50 35 dpavlin my %ip_cache;
51
52 1 dpavlin # open log
53 45 dpavlin open(my $log_fh, '>>', $LOG) or die "can't open log $LOG: $!";
54 select((select($log_fh), $|=1)[0]); # flush output
55 1 dpavlin
56 31 dpavlin # dump warn and dies into log
57 $SIG{'__WARN__'} = sub { xlog('WARN',$_[0],1) ; exit 1 };
58 $SIG{'__DIE__'} = sub { xlog('DIE',$_[0],0) ; exit 1 };
59
60 5 dpavlin # make a lock on logfile
61
62 my $c = 0;
63 {
64 45 dpavlin flock $log_fh, LOCK_EX | LOCK_NB and last;
65 5 dpavlin sleep 1;
66 37 dpavlin # warn "waiting for lock\n";
67 5 dpavlin redo if ++$c < 10;
68 # no response for 10 sec, bail out
69 17 dpavlin xlog("ABORT","can't take lock on $LOG -- another $0 running?");
70 5 dpavlin exit 1;
71 }
72
73 1 dpavlin # taint path: nmblookup should be there!
74 $ENV{'PATH'} = "/usr/bin:/bin";
75
76 22 dpavlin my $use_ping = 1; # default: use syn tcp ping to verify that host is up
77 my $verbose = 1; # default verbosity level
78 my $quiet = 0;
79 44 dpavlin my $diff = 0;
80 25 dpavlin my $email;
81 31 dpavlin my $max_share_size; # don't limit maximum size of share to backup
82 my $max_file_size; # don't limit maximum file size to backup
83 my $min_free_space = 100000; # leave 100Mb on backup destination
84 48 dpavlin my $only;
85 19 dpavlin
86 31 dpavlin my $help;
87
88 19 dpavlin my $result = GetOptions(
89 33 dpavlin "ping!" => \$use_ping, "backupdest=s" => \$BACKUP_DEST,
90 22 dpavlin "verbose+" => \$verbose, "quiet+" => \$quiet,
91 25 dpavlin "email=s" => \$email,
92 31 dpavlin "max_share_size=i" => \$max_share_size,
93 "max_file_size=i" => \$max_file_size,
94 "min_free_space=i" => \$min_free_space,
95 "help!" => \$help,
96 44 dpavlin "diff!" => \$diff,
97 48 dpavlin "only=s", => \$only,
98 19 dpavlin );
99
100 31 dpavlin if ($help) {
101 pod2usage(-verbose => 2);
102 }
103
104 22 dpavlin $verbose -= $quiet;
105
106 44 dpavlin # diff mode settings
107 ($verbose,$quiet) = (0,1) if ($diff);
108
109 1 dpavlin my $mounts = shift @ARGV ||
110 'mountscript';
111 # die "usage: $0 mountscript";
112
113 25 dpavlin my $basedir = $0;
114 $basedir =~ s,/?[^/]+$,,g;
115 1 dpavlin
116 25 dpavlin # default subject for e-mail messages
117 my @subjects = ('Backup needs your attention!');
118 my $sub_nr = 0;
119 my $email_body;
120
121 27 dpavlin my $home_dir=$ENV{'HOME'};
122 $home_dir = '/tmp' if (! -w $home_dir);
123
124 25 dpavlin if ($email) {
125 # It will use (and require) Tie::File only if --email=foo@bar.com
126 # arguement is used!
127 use Tie::File;
128 tie @subjects, 'Tie::File', "$basedir/subjects.txt" || xlog("CONFIG","Can't find $basedir/subjects.txt... using default (only one)");
129 chdir; # this will change directory to HOME
130 45 dpavlin if (open(my $sn, '<', "$home_dir/.psinib.subject")) {
131 $sub_nr = <$sn>;
132 25 dpavlin chomp($sub_nr);
133 45 dpavlin close($sn);
134 25 dpavlin }
135 $sub_nr++;
136 # skip comments in subjects.txt
137 26 dpavlin while($subjects[$sub_nr] && $subjects[$sub_nr] =~ m/^#/) {
138 25 dpavlin $sub_nr++;
139 }
140 $sub_nr = 0 if (! $subjects[$sub_nr]);
141
142 45 dpavlin if (open(my $sn, '>', "$home_dir/.psinib.subject")) {
143 print $sn "$sub_nr\n";
144 close ($sn);
145 25 dpavlin } else {
146 27 dpavlin xlog("CONFIG","Can't open $home_dir/.psinib.subject -- I can't cycle subjects...");
147 25 dpavlin };
148 }
149
150 1 dpavlin my @in_backup; # shares which are backeduped this run
151
152 21 dpavlin # init Net::Ping object
153 19 dpavlin my $ping;
154 35 dpavlin $ping = new Net::Ping->new("syn", 2) if ($use_ping);
155 1 dpavlin
156 21 dpavlin # do syn ping to cifs port
157 sub host_up {
158 my $ping = shift || return;
159 my $host_ip = shift || xlog("host_up didn't get IP");
160 my $timeout = shift;
161 return 1 if (! $use_ping);
162
163 35 dpavlin # check various ports to see if host if up
164 foreach my $port (qw(netbios-ns netbios-dgm netbios-ssn microsoft-ds)) {
165 $ping->{port_num} = getservbyname($port, "tcp");
166 $ping->ping($host_ip);
167 }
168
169 21 dpavlin my $return = 0;
170
171 while (my ($host,$rtt,$ip) = $ping->ack) {
172 35 dpavlin $return++ if ($ip eq $host_ip);
173 21 dpavlin }
174 35 dpavlin
175 xlog("","HOST: $host_ip ACKed $return times") if ($return);
176
177 21 dpavlin return $return;
178 }
179
180 1 dpavlin my $backup_ok = 0;
181
182 my $smb;
183 my %smb_atime;
184 my %smb_mtime;
185 8 dpavlin my %file_md5;
186 1 dpavlin
187 45 dpavlin open(my $m_fh, '<', $mounts) || die "can't open mountscript '$mounts': $!";
188 while(<$m_fh>) {
189 1 dpavlin chomp;
190 next if !/^\s*smbmount\s/;
191 my (undef,$share,undef,$opt) = split(/\s+/,$_,4);
192
193 48 dpavlin next if ($only && $share !~ m/\Q$only\E/);
194
195 16 dpavlin my ($user,$passwd,$workgroup,$ip);
196 1 dpavlin
197 foreach (split(/,/,$opt)) {
198 my ($n,$v) = split(/=/,$_,2);
199 if ($n =~ m/username/i) {
200 if ($v =~ m#^(.+)/(.+)%(.+)$#) {
201 ($user,$passwd,$workgroup) = ($1,$2,$3);
202 } elsif ($v =~ m#^(.+)/(.+)$#) {
203 ($user,$workgroup) = ($1,$2);
204 } elsif ($v =~ m#^(.+)%(.+)$#) {
205 ($user,$passwd) = ($1,$2);
206 } else {
207 $user = $v;
208 }
209 } elsif ($n =~ m#workgroup#i) {
210 $workgroup = $v;
211 16 dpavlin } elsif ($n =~ m#ip#i) {
212 $ip = $v;
213 1 dpavlin }
214 }
215
216 push @in_backup,$share;
217
218 8 dpavlin
219 my ($host,$dir,$date_dir) = share2host_dir($share);
220 my $bl = "$BACKUP_DEST/$host/$dir/latest"; # latest backup
221 my $bc = "$BACKUP_DEST/$host/$dir/$date_dir"; # current one
222 my $real_bl;
223 14 dpavlin if (-l $bl) {
224 8 dpavlin $real_bl=readlink($bl) || die "can't read link $bl: $!";
225 $real_bl="$BACKUP_DEST/$host/$dir/$real_bl" if (substr($real_bl,0,1) ne "/");
226 14 dpavlin if (-l $bc && $real_bl eq $bc) {
227 22 dpavlin xlog($share,"allready backuped...");
228 8 dpavlin $backup_ok++;
229 next;
230 }
231
232 }
233
234
235 22 dpavlin xlog($share,"working on $share...");
236 1 dpavlin
237 16 dpavlin # try to nmblookup IP
238 $ip = get_ip($share) if (! $ip);
239 8 dpavlin
240 1 dpavlin if ($ip) {
241 xlog($share,"IP is $ip");
242 21 dpavlin if (host_up($ping, $ip,$PING_TIMEOUT)) {
243 17 dpavlin if (snap_share($share,$user,$passwd,$workgroup)) {
244 $backup_ok++;
245 }
246 1 dpavlin }
247 }
248 }
249 45 dpavlin close($m_fh);
250 1 dpavlin
251 25 dpavlin my $total = ($#in_backup + 1) || 0;
252 my $pcnt = "";
253 $pcnt = "(".int($backup_ok*100/$total)." %)" if ($total > 0);
254 xlog("","$backup_ok backups completed of total $total this time".$pcnt);
255 1 dpavlin
256 25 dpavlin send_email();
257
258 1 dpavlin 1;
259
260 #-------------------------------------------------------------------------
261
262 8 dpavlin
263 1 dpavlin # get IP number from share
264 sub get_ip {
265 my $share = shift;
266
267 45 dpavlin my $host;
268 if ($share =~ m#//([^/]+)/#) {
269 $host = lc($1);
270 } else {
271 die "can't find host in share $share\n";
272 }
273 1 dpavlin
274 35 dpavlin return $ip_cache{$host} if (defined($ip_cache{$host}));
275
276 1 dpavlin my $ip = `nmblookup $host`;
277 if ($ip =~ m/(\d+\.\d+\.\d+\.\d+)\s$host/i) {
278 35 dpavlin $ip_cache{$host} = $1;
279 1 dpavlin return $1;
280 }
281 35 dpavlin
282 $ip = `host $host`;
283 if ($ip =~ m/^$host.+\s+(\d+\.\d+\.\d+\.\d+)$/i) {
284 $ip_cache{$host} = $1;
285 return $1;
286 }
287 1 dpavlin }
288
289 25 dpavlin # send e-mail with all messages
290 sub send_email {
291 return if (! $email || $email eq "" || !$email_body);
292 require Mail::Send;
293 my $msg = new Mail::Send;
294 $msg->to($email);
295 $msg->subject($subjects[$sub_nr]);
296 my $fn=$msg->open;
297 print $fn $email_body;
298 $fn->close;
299 }
300
301 8 dpavlin
302 # write entry to screen and log
303 1 dpavlin sub xlog {
304 my $share = shift;
305 my $t = strftime $LOG_TIME_FMT, localtime;
306 my $m = shift || '[no log entry]';
307 23 dpavlin my $l = shift;
308 36 dpavlin $l = 1 unless (defined $l); # default verbosity is 1
309 $verbose = 0 unless (defined $verbose);
310 25 dpavlin if ($verbose >= $l) {
311 if (! $email) {
312 print STDERR $m,"\n";
313 # don't e-mail mesages with verbosity < 1
314 } elsif ($l < 1) {
315 $email_body .= $m."\n";
316 }
317 }
318 45 dpavlin print $log_fh "$t $share\t$m\n";
319 1 dpavlin }
320
321
322 8 dpavlin # split share name to host, dir and currnet date dir
323 sub share2host_dir {
324 1 dpavlin my $share = shift;
325 my ($host,$dir);
326 if ($share =~ m#//([^/]+)/(.+)$#) {
327 ($host,$dir) = ($1,$2);
328 $dir =~ s/\W/_/g;
329 $dir =~ s/^_+//;
330 $dir =~ s/_+$//;
331 } else {
332 22 dpavlin xlog($share,"Can't parse share $share into host and directory!",1);
333 1 dpavlin return;
334 }
335 8 dpavlin return ($host,$dir,strftime $DIR_TIME_FMT, localtime);
336 }
337 1 dpavlin
338
339 8 dpavlin # make a snapshot of a share
340 sub snap_share {
341
342 my $share = shift;
343
344 my %param = ( debug => 0 );
345
346 13 dpavlin $param{username} = shift || warn "can't find username for share $share";
347 $param{password} = shift || warn "can't find passwod for share $share";
348 $param{workgroup} = shift || warn "can't find workgroup for share $share";
349 8 dpavlin
350 my ($host,$dir,$date_dir) = share2host_dir($share);
351
352 1 dpavlin # latest backup directory
353 my $bl = "$BACKUP_DEST/$host/$dir/latest";
354 # current backup directory
355 my $bc = "$BACKUP_DEST/$host/$dir/$date_dir";
356
357 my $real_bl;
358 14 dpavlin if (-l $bl) {
359 1 dpavlin $real_bl=readlink($bl) || die "can't read link $bl: $!";
360 $real_bl="$BACKUP_DEST/$host/$dir/$real_bl" if (substr($real_bl,0,1) ne "/");
361 24 dpavlin if (! -e $real_bl) {
362 xlog($share,"latest link $bl -> $real_bl not valid, removing it");
363 unlink $bl || die "can't remove link $bl: $!";
364 undef $real_bl;
365 }
366 23 dpavlin }
367 if (! $real_bl) {
368 24 dpavlin xlog($share,"no old backup, trying to find last backup");
369 11 dpavlin if (opendir(BL_DIR, "$BACKUP_DEST/$host/$dir")) {
370 my @bl_dirs = sort grep { !/^\./ && -d "$BACKUP_DEST/$host/$dir/$_" } readdir(BL_DIR);
371 closedir(BL_DIR);
372 50 dpavlin if ( $real_bl=pop @bl_dirs ) {
373 xlog($share,"using $real_bl as latest...");
374 $real_bl="$BACKUP_DEST/$host/$dir/$real_bl" if (substr($real_bl,0,1) ne "/");
375 if ($real_bl eq $bc) {
376 xlog($share,"latest from today (possible partial backup)");
377 rename $real_bl,$real_bl.".partial" || warn "can't reaname partial backup: $!";
378 $real_bl .= ".partial";
379 }
380 } else {
381 xlog($share,"can't find last backup, assuming this is first one...\n");
382 11 dpavlin }
383 } else {
384 22 dpavlin xlog($share,"this is first run...");
385 11 dpavlin }
386 1 dpavlin }
387
388 14 dpavlin if (-l $bc && $real_bl && $real_bl eq $bc) {
389 22 dpavlin xlog($share,"allready backuped...");
390 17 dpavlin return 1;
391 1 dpavlin }
392
393 die "You should really create BACKUP_DEST [$BACKUP_DEST] by hand! " if (!-e $BACKUP_DEST);
394
395 if (! -e "$BACKUP_DEST/$host") {
396 mkdir "$BACKUP_DEST/$host" || die "can't make dir for host $host, $BACKUP_DEST/$host: $!";
397 22 dpavlin xlog($share,"created host directory $BACKUP_DEST/$host...");
398 1 dpavlin }
399
400 if (! -e "$BACKUP_DEST/$host/$dir") {
401 mkdir "$BACKUP_DEST/$host/$dir" || die "can't make dir for share $share, $BACKUP_DEST/$host/$dir $!";
402 22 dpavlin xlog($share,"created dir for this share $BACKUP_DEST/$host/$dir...");
403 1 dpavlin }
404
405 mkdir $bc || die "can't make dir for current backup $bc: $!";
406
407 my @dirs = ( "/" );
408 my @smb_dirs = ( "/" );
409
410 my $transfer = 0; # bytes transfered over network
411
412 # this will store all available files and sizes
413 my @files;
414 my %file_size;
415 my %file_atime;
416 my %file_mtime;
417 18 dpavlin %file_md5 = ();
418 1 dpavlin
419 my @smb_files;
420 my %smb_size;
421 #my %smb_atime;
422 #my %smb_mtime;
423
424 sub norm_dir {
425 35 dpavlin my $dir = shift;
426 1 dpavlin my $prefix = shift;
427 35 dpavlin $dir =~ s#//+#/#g;
428 $dir =~ s#/+$##g;
429 $dir =~ s#^/+##g;
430 $dir = $prefix.$dir if ($prefix);
431 if ($dir =~ m!^smb://([^/]+)/!) {
432 if (my $ip=get_ip($dir)) {
433 $dir =~ s!^smb://$1/!smb://$ip/!;
434 }
435 }
436 return $dir;
437 1 dpavlin }
438
439 # read local filesystem
440 my $di = 0;
441 while ($di <= $#dirs && $real_bl) {
442 my $d=$dirs[$di++];
443 11 dpavlin opendir(DIR,"$real_bl/$d") || warn "opendir($real_bl/$d): $!\n";
444 1 dpavlin
445 # read .backupignore if exists
446 11 dpavlin if (-f "$real_bl/$d/.backupignore") {
447 45 dpavlin open(my $i,'<',"$real_bl/$d/.backupignore");
448 while(<$i>) {
449 1 dpavlin chomp;
450 push @ignore,norm_dir("$d/$_");
451 }
452 45 dpavlin close($i);
453 14 dpavlin #print STDERR "ignore: ",join("|",@ignore),"\n";
454 11 dpavlin link "$real_bl/$d/.backupignore","$bc/$d/.backupignore" ||
455 warn "can't copy $real_bl/$d/.backupignore to current backup dir: $!\n";
456 1 dpavlin }
457
458 # read .md5sum if exists
459 11 dpavlin if (-f "$real_bl/$d/.md5sum") {
460 45 dpavlin open(my $m,'<',"$real_bl/$d/.md5sum");
461 while(<$m>) {
462 1 dpavlin chomp;
463 my ($md5,$f) = split(/\s+/,$_,2);
464 $file_md5{$f}=$md5;
465 }
466 45 dpavlin close($m);
467 1 dpavlin }
468
469 my @clutter = readdir(DIR);
470 foreach my $f (@clutter) {
471 next if ($f eq '.');
472 next if ($f eq '..');
473 my $pr = norm_dir("$d/$f"); # path relative
474 11 dpavlin my $pf = norm_dir("$d/$f","$real_bl/"); # path full
475 1 dpavlin if (grep(/^\Q$pr\E$/,@ignore) == 0) {
476 if (-f $pf) {
477 31 dpavlin my $size = (stat($pf))[7];
478 32 dpavlin if ($max_file_size && ($size/1024) > $max_file_size) {
479 33 dpavlin xlog($share,"local file '$pf' (".int($size/1024)." Kb) larger than $max_file_size Kb, skipping",0);
480 31 dpavlin xlog("INFO","strictly speaking, this shouldn't happend and it will trigger backup of remote file if it's smaller than $max_file_size Kb, but if you changed --max-file-size option it's expected.",1);
481 } else {
482 push @files,$pr;
483 $file_size{$pr}= $size;
484 $file_atime{$pr}=(stat($pf))[8];
485 $file_mtime{$pr}=(stat($pf))[9];
486 }
487 1 dpavlin } elsif (-d $pf) {
488 push @dirs,$pr;
489 } else {
490 22 dpavlin xlog($share,"not file or directory: $pf",0);
491 44 dpavlin print "? $share $pf\n" if ($diff);
492 1 dpavlin }
493 } else {
494 22 dpavlin xlog($share,"ignored: $pr");
495 49 dpavlin print "I $share $pf\n" if ($diff && $verbose);
496 1 dpavlin }
497 }
498 }
499
500 17 dpavlin # local dir always include /
501 xlog($share,($#files+1)." files and ".($#dirs)." dirs on local disk before backup");
502 1 dpavlin
503 # read smb filesystem
504
505 xlog($share,"smb to $share as $param{username}/$param{workgroup}");
506
507 # FIX: how to aviod creation of ~/.smb/smb.conf ?
508 $smb = new Filesys::SmbClient(%param) || die "SmbClient :$!\n";
509
510 31 dpavlin my $share_size = 0;
511
512 1 dpavlin $di = 0;
513 while ($di <= $#smb_dirs) {
514 14 dpavlin my $d=$smb_dirs[$di];
515 1 dpavlin my $pf = norm_dir($d,"smb:$share/"); # path full
516 14 dpavlin my $D = $smb->opendir($pf);
517 if (! $D) {
518 23 dpavlin xlog($share,"FATAL: $share [$pf] as $param{username}/$param{workgroup}: $!",0);
519 14 dpavlin # remove failing dir
520 delete $smb_dirs[$di];
521 17 dpavlin return 0; # failed
522 14 dpavlin }
523 $di++;
524 1 dpavlin
525 my @clutter = $smb->readdir_struct($D);
526 foreach my $item (@clutter) {
527 my $f = $item->[1];
528 next if ($f eq '.');
529 next if ($f eq '..');
530 my $pr = norm_dir("$d/$f"); # path relative
531 my $pf = norm_dir("$d/$f","smb:$share/"); # path full
532 if (grep(/^\Q$pr\E$/,@ignore) == 0) {
533 if ($item->[0] == main::SMBC_FILE) {
534 31 dpavlin my $size = ($smb->stat($pf))[7];
535 32 dpavlin if ($max_file_size && ($size/1024) > $max_file_size) {
536 33 dpavlin xlog($share,"file '$pf' (".int($size/1024)." Kb) larger than $max_file_size Kb, skipping",0);
537 31 dpavlin } else {
538 push @smb_files,$pr;
539 $smb_size{$pr}= $size;
540 $smb_atime{$pr}=($smb->stat($pf))[10];
541 $smb_mtime{$pr}=($smb->stat($pf))[11];
542 $share_size += $size;
543 }
544 1 dpavlin } elsif ($item->[0] == main::SMBC_DIR) {
545 push @smb_dirs,$pr;
546 } else {
547 22 dpavlin xlog($share,"not file or directory [".$item->[0]."]: $pf",0);
548