/[psinib]/psinib.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /psinib.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (hide annotations)
Sat Jan 4 15:59:14 2003 UTC (21 years, 3 months ago) by dpavlin
Branch: MAIN
Changes since 1.3: +97 -22 lines
File MIME type: text/plain
creates .md5sum files (but still doesn't use them)
better documentation

1 dpavlin 1.1 #!/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 dpavlin 1.4 # $ psinib.pl mountscript
16 dpavlin 1.1
17     use strict 'vars';
18     use Data::Dumper;
19     use Net::Ping;
20     use POSIX qw(strftime);
21     use List::Compare;
22     use Filesys::SmbClient;
23     #use Taint;
24 dpavlin 1.2 use Fcntl qw(LOCK_EX LOCK_NB);
25 dpavlin 1.4 use Digest::MD5;
26     use File::Basename;
27 dpavlin 1.1
28     # configuration
29     my $LOG_TIME_FMT = '%Y-%m-%d %H:%M:%S'; # strftime format for logfile
30     my $DIR_TIME_FMT = '%Y%m%d'; # strftime format for backup dir
31    
32     my $LOG = '/var/log/backup.log'; # add path here...
33     $LOG = '/tmp/backup.log';
34    
35     # store backups in which directory
36     my $BACKUP_DEST = '/data/isis_backup';
37    
38     # files to ignore in backup
39     my @ignore = ('.md5sum', '.backupignore', 'backupignore.txt');
40    
41     # open log
42     open(L, "> $LOG") || die "can't open log $LOG: $!";
43     select((select(L), $|=1)[0]); # flush output
44 dpavlin 1.2
45     # make a lock on logfile
46    
47     my $c = 0;
48     {
49     flock L, LOCK_EX | LOCK_NB and last;
50     sleep 1;
51     redo if ++$c < 10;
52     # no response for 10 sec, bail out
53     print STDERR "can't take lock on $LOG -- another $0 running?\n";
54     exit 1;
55     }
56 dpavlin 1.1
57     # taint path: nmblookup should be there!
58     $ENV{'PATH'} = "/usr/bin:/bin";
59    
60     my $mounts = shift @ARGV ||
61     'mountscript';
62     # die "usage: $0 mountscript";
63    
64    
65     my @in_backup; # shares which are backeduped this run
66    
67     my $p = new Net::Ping->new();
68    
69     my $backup_ok = 0;
70    
71     my $smb;
72     my %smb_atime;
73     my %smb_mtime;
74 dpavlin 1.4 my %file_md5;
75 dpavlin 1.1
76     open(M, $mounts) || die "can't open $mounts: $!";
77     while(<M>) {
78     chomp;
79     next if !/^\s*smbmount\s/;
80     my (undef,$share,undef,$opt) = split(/\s+/,$_,4);
81    
82     my ($user,$passwd,$workgroup);
83    
84     foreach (split(/,/,$opt)) {
85     my ($n,$v) = split(/=/,$_,2);
86     if ($n =~ m/username/i) {
87     if ($v =~ m#^(.+)/(.+)%(.+)$#) {
88     ($user,$passwd,$workgroup) = ($1,$2,$3);
89     } elsif ($v =~ m#^(.+)/(.+)$#) {
90     ($user,$workgroup) = ($1,$2);
91     } elsif ($v =~ m#^(.+)%(.+)$#) {
92     ($user,$passwd) = ($1,$2);
93     } else {
94     $user = $v;
95     }
96     } elsif ($n =~ m#workgroup#i) {
97     $workgroup = $v;
98     }
99     }
100    
101     push @in_backup,$share;
102    
103 dpavlin 1.4
104     my ($host,$dir,$date_dir) = share2host_dir($share);
105     my $bl = "$BACKUP_DEST/$host/$dir/latest"; # latest backup
106     my $bc = "$BACKUP_DEST/$host/$dir/$date_dir"; # current one
107     my $real_bl;
108     if (-e $bl) {
109     $real_bl=readlink($bl) || die "can't read link $bl: $!";
110     $real_bl="$BACKUP_DEST/$host/$dir/$real_bl" if (substr($real_bl,0,1) ne "/");
111     if (-e $bc && $real_bl eq $bc) {
112     print "$share allready backuped...\n";
113     $backup_ok++;
114     next;
115     }
116    
117     }
118    
119    
120 dpavlin 1.1 print "working on $share\n";
121    
122 dpavlin 1.4
123 dpavlin 1.1 my $ip = get_ip($share);
124    
125     if ($ip) {
126     xlog($share,"IP is $ip");
127     if ($p->ping($ip)) {
128     snap_share($share,$user,$passwd,$workgroup);
129     $backup_ok++;
130     }
131     }
132     }
133     close(M);
134    
135     xlog("","$backup_ok backups completed of total ".($#in_backup+1)." this time (".int($backup_ok*100/($#in_backup+1))." %)");
136    
137     1;
138    
139     #-------------------------------------------------------------------------
140    
141 dpavlin 1.4
142 dpavlin 1.1 # get IP number from share
143     sub get_ip {
144     my $share = shift;
145    
146     my $host = $1 if ($share =~ m#//([^/]+)/#);
147    
148     my $ip = `nmblookup $host`;
149     if ($ip =~ m/(\d+\.\d+\.\d+\.\d+)\s$host/i) {
150     return $1;
151     }
152     }
153    
154 dpavlin 1.4
155     # write entry to screen and log
156 dpavlin 1.1 sub xlog {
157     my $share = shift;
158     my $t = strftime $LOG_TIME_FMT, localtime;
159     my $m = shift || '[no log entry]';
160     print STDERR $m,"\n";
161     print L "$t $share\t$m\n";
162     }
163    
164    
165 dpavlin 1.4 # split share name to host, dir and currnet date dir
166     sub share2host_dir {
167 dpavlin 1.1 my $share = shift;
168     my ($host,$dir);
169     if ($share =~ m#//([^/]+)/(.+)$#) {
170     ($host,$dir) = ($1,$2);
171     $dir =~ s/\W/_/g;
172     $dir =~ s/^_+//;
173     $dir =~ s/_+$//;
174     } else {
175     print "Can't parse share $share into host and directory!\n";
176     return;
177     }
178 dpavlin 1.4 return ($host,$dir,strftime $DIR_TIME_FMT, localtime);
179     }
180    
181 dpavlin 1.1
182 dpavlin 1.4 # make a snapshot of a share
183     sub snap_share {
184    
185     my $share = shift;
186    
187     my %param = ( debug => 0 );
188    
189     $param{username} = shift;
190     $param{password} = shift;
191     $param{workgroup} = shift;
192    
193     my ($host,$dir,$date_dir) = share2host_dir($share);
194 dpavlin 1.1
195     # latest backup directory
196     my $bl = "$BACKUP_DEST/$host/$dir/latest";
197     # current backup directory
198     my $bc = "$BACKUP_DEST/$host/$dir/$date_dir";
199    
200     my $real_bl;
201     if (-e $bl) {
202     $real_bl=readlink($bl) || die "can't read link $bl: $!";
203     $real_bl="$BACKUP_DEST/$host/$dir/$real_bl" if (substr($real_bl,0,1) ne "/");
204     } else {
205     print "no old backup, this is first run...\n";
206     }
207    
208     if (-e $bc && $real_bl && $real_bl eq $bc) {
209     print "$share allready backuped...\n";
210     return;
211     }
212    
213     die "You should really create BACKUP_DEST [$BACKUP_DEST] by hand! " if (!-e $BACKUP_DEST);
214    
215     if (! -e "$BACKUP_DEST/$host") {
216     mkdir "$BACKUP_DEST/$host" || die "can't make dir for host $host, $BACKUP_DEST/$host: $!";
217     print "created host directory $BACKUP_DEST/$host...\n";
218     }
219    
220     if (! -e "$BACKUP_DEST/$host/$dir") {
221     mkdir "$BACKUP_DEST/$host/$dir" || die "can't make dir for share $share, $BACKUP_DEST/$host/$dir $!";
222     print "created dir for share $share, $BACKUP_DEST/$host/$dir...\n";
223     }
224    
225     mkdir $bc || die "can't make dir for current backup $bc: $!";
226    
227     my @dirs = ( "/" );
228     my @smb_dirs = ( "/" );
229    
230     my $transfer = 0; # bytes transfered over network
231    
232     # this will store all available files and sizes
233     my @files;
234     my %file_size;
235     my %file_atime;
236     my %file_mtime;
237 dpavlin 1.4 #my %file_md5;
238 dpavlin 1.1
239     my @smb_files;
240     my %smb_size;
241     #my %smb_atime;
242     #my %smb_mtime;
243    
244     sub norm_dir {
245     my $foo = shift;
246     my $prefix = shift;
247     $foo =~ s#//+#/#g;
248     $foo =~ s#/+$##g;
249     $foo =~ s#^/+##g;
250     return $prefix.$foo if ($prefix);
251     return $foo;
252     }
253    
254     # read local filesystem
255     my $di = 0;
256     while ($di <= $#dirs && $real_bl) {
257     my $d=$dirs[$di++];
258     opendir(DIR,"$bl/$d") || warn "opendir($bl/$d): $!\n";
259    
260     # read .backupignore if exists
261     if (-f "$bl/$d/.backupignore") {
262     open(I,"$bl/$d/.backupignore");
263     while(<I>) {
264     chomp;
265     push @ignore,norm_dir("$d/$_");
266     }
267     close(I);
268     print STDERR "ignore: ",join("|",@ignore),"\n";
269     link "$bl/$d/.backupignore","$bc/$d/.backupignore" ||
270     warn "can't copy $bl/$d/.backupignore to current backup dir: $!\n";
271     }
272    
273     # read .md5sum if exists
274     if (-f "$bl/$d/.md5sum") {
275     open(I,"$bl/$d/.md5sum");
276     while(<I>) {
277     chomp;
278     my ($md5,$f) = split(/\s+/,$_,2);
279     $file_md5{$f}=$md5;
280     }
281     close(I);
282     }
283    
284     my @clutter = readdir(DIR);
285     foreach my $f (@clutter) {
286     next if ($f eq '.');
287     next if ($f eq '..');
288     my $pr = norm_dir("$d/$f"); # path relative
289     my $pf = norm_dir("$d/$f","$bl/"); # path full
290     if (grep(/^\Q$pr\E$/,@ignore) == 0) {
291     if (-f $pf) {
292     push @files,$pr;
293     $file_size{$pr}=(stat($pf))[7];
294     $file_atime{$pr}=(stat($pf))[8];
295     $file_mtime{$pr}=(stat($pf))[9];
296     } elsif (-d $pf) {
297     push @dirs,$pr;
298     } else {
299     print STDERR "unknown type: $pf\n";
300     }
301     } else {
302     print STDERR "ignored: $pr\n";
303     }
304     }
305     }
306    
307     xlog($share,($#files+1)." files and ".($#dirs+1)." dirs on local disk before backup");
308    
309     # read smb filesystem
310    
311     xlog($share,"smb to $share as $param{username}/$param{workgroup}");
312    
313     # FIX: how to aviod creation of ~/.smb/smb.conf ?
314     $smb = new Filesys::SmbClient(%param) || die "SmbClient :$!\n";
315    
316     $di = 0;
317     while ($di <= $#smb_dirs) {
318     my $d=$smb_dirs[$di++];
319     my $pf = norm_dir($d,"smb:$share/"); # path full
320     my $D = $smb->opendir($pf) || warn "smb->opendir($pf): $!\n";
321    
322     my @clutter = $smb->readdir_struct($D);
323     foreach my $item (@clutter) {
324     my $f = $item->[1];
325     next if ($f eq '.');
326     next if ($f eq '..');
327     my $pr = norm_dir("$d/$f"); # path relative
328     my $pf = norm_dir("$d/$f","smb:$share/"); # path full
329     if (grep(/^\Q$pr\E$/,@ignore) == 0) {
330     if ($item->[0] == main::SMBC_FILE) {
331     push @smb_files,$pr;
332     $smb_size{$pr}=($smb->stat($pf))[7];
333     $smb_atime{$pr}=($smb->stat($pf))[10];
334     $smb_mtime{$pr}=($smb->stat($pf))[11];
335     } elsif ($item->[0] == main::SMBC_DIR) {
336     push @smb_dirs,$pr;
337     } else {
338     print STDERR "unknown type: $pf\n";
339     }
340     } else {
341     print STDERR "smb ignored: $pr\n";
342     }
343     }
344     }
345    
346     xlog($share,($#smb_files+1)." files and ".($#smb_dirs+1)." dirs on remote share");
347    
348     # sync dirs
349     my $lc = List::Compare->new(\@dirs, \@smb_dirs);
350    
351     my @dirs2erase = $lc->get_Lonly;
352     my @dirs2create = $lc->get_Ronly;
353     xlog($share,($#dirs2erase+1)." dirs to erase and ".($#dirs2create+1)." dirs to create");
354    
355     # create new dirs
356     foreach (sort @smb_dirs) {
357     mkdir "$bc/$_" || warn "mkdir $_: $!\n";
358     }
359    
360     # sync files
361     $lc = List::Compare->new(\@files, \@smb_files);
362    
363     my @files2erase = $lc->get_Lonly;
364     my @files2create = $lc->get_Ronly;
365     xlog($share,($#files2erase+1)." files to erase and ".($#files2create+1)." files to create");
366    
367     sub smb_copy {
368     my $smb = shift;
369    
370     my $from = shift;
371     my $to = shift;
372    
373    
374     my $l = 0;
375    
376     foreach my $f (@_) {
377     #print "smb_copy $from/$f -> $to/$f\n";
378     if (! open(F,"> $to/$f")) {
379     print STDERR "can't open new file $to/$f: $!\n";
380     next;
381     }
382    
383 dpavlin 1.4 my $md5 = Digest::MD5->new;
384    
385 dpavlin 1.1 my $fd = $smb->open("$from/$f");
386     if (! $fd) {
387     print STDERR "can't open smb file $from/$f: $!\n";
388     next;
389     }
390    
391     while (defined(my $b=$smb->read($fd,4096))) {
392     print F $b;
393     $l += length($b);
394 dpavlin 1.4 $md5->add($b);
395 dpavlin 1.1 }
396    
397     $smb->close($fd);
398     close(F);
399    
400 dpavlin 1.4 $file_md5{$f} = $md5->hexdigest;
401    
402 dpavlin 1.1 # FIX: this fails with -T
403     my ($a,$m) = ($smb->stat("$from/$f"))[10,11];
404     utime $a, $m, "$to/$f" ||
405     warn "can't update utime on $to/$f: $!\n";
406    
407     }
408     return $l;
409     }
410    
411     # copy new files
412     foreach (@files2create) {
413     $transfer += smb_copy($smb,"smb:$share",$bc,$_);
414     }
415    
416     my $size_sync = 0;
417     my $atime_sync = 0;
418     my $mtime_sync = 0;
419     my @sync_files;
420     my @ln_files;
421    
422     foreach ($lc->get_intersection) {
423    
424     my $f;
425    
426     if ($file_size{$_} != $smb_size{$_}) {
427     $f=$_;
428     $size_sync++;
429     }
430     if ($file_atime{$_} != $smb_atime{$_}) {
431     $f=$_;
432     $atime_sync++;
433     }
434     if ($file_mtime{$_} != $smb_mtime{$_}) {
435     $f=$_;
436     $mtime_sync++;
437     }
438    
439     if ($f) {
440     push @sync_files, $f;
441     } else {
442     push @ln_files, $_;
443     }
444     }
445    
446     xlog($share,($#sync_files+1)." files will be updated (diff: $size_sync size, $atime_sync atime, $mtime_sync mtime), ".($#ln_files+1)." will be linked.");
447    
448     foreach (@sync_files) {
449     $transfer += smb_copy($smb,"smb:$share",$bc,$_);
450     }
451    
452     xlog($share,"$transfer bytes transfered...");
453    
454     foreach (@ln_files) {
455     link "$bl/$_","$bc/$_" || warn "link $bl/$_ -> $bc/$_: $!\n";
456     }
457    
458     # remove files
459     foreach (sort @files2erase) {
460     unlink "$bc/$_" || warn "unlink $_: $!\n";
461     }
462    
463     # remove not needed dirs (after files)
464     foreach (sort @dirs2erase) {
465     rmdir "$bc/$_" || warn "rmdir $_: $!\n";
466     }
467    
468 dpavlin 1.4 # remove old .md5sum
469     foreach (sort @dirs) {
470     unlink "$bc/$_/.md5sum" if (-e "$bc/$_/.md5sum");
471     }
472    
473     # create .md5sum
474     my $last_dir = '';
475     my $md5;
476     foreach my $f (sort { $file_md5{$a}<=>$file_md5{$b} } keys %file_md5) {
477     my $dir = dirname($f);
478     my $file = basename($f);
479     print "$f -- $dir / $file<--\n";
480     if ($dir ne $last_dir) {
481     close($md5) if ($md5);
482     open($md5, ">> $bc/$dir/.md5sum") || warn "can't create $bc/$dir/.md5sum: $!";
483     $last_dir = $dir;
484     print STDERR "writing $last_dir/.md5sum\n";
485     }
486     print $md5 $file_md5{$f}," $file\n";
487     }
488     close($md5);
489 dpavlin 1.1
490     # create leatest link
491 dpavlin 1.4 # symlink $bc,$bl || warn "can't create latest symlink $bl -> $bc: $!\n";
492 dpavlin 1.1
493     xlog($share,"backup completed...");
494     }
495    
496 dpavlin 1.3 __END__
497 dpavlin 1.1 #-------------------------------------------------------------------------
498    
499 dpavlin 1.3
500     =head1 NAME
501    
502     psinib - Perl Snapshot Is Not Incremental Backup
503    
504     =head1 SYNOPSIS
505    
506     ./psinib.pl
507    
508     =head1 DESCRIPTION
509    
510     This script in current version support just backup of Samba (or Micro$oft
511     Winblowz) shares to central disk space. Central disk space is organized in
512     multiple directories named after:
513    
514     =over 4
515    
516     =item *
517     server which is sharing files to be backed up
518    
519     =item *
520     name of share on server
521    
522     =item *
523     dated directory named like standard ISO date format (YYYYMMDD).
524    
525     =back
526    
527     In each dated directory you will find I<snapshot> of all files on
528     exported share on that particular date.
529    
530     You can also use symlink I<latest> which will lead you to
531     last completed backup. After that you can use some other backup
532     software to transfer I<snapshot> to tape, CD-ROM or some other media.
533    
534     =head2 Design considerations
535    
536     Since taking of share snapshot every day requires a lot of disk space and
537     network bandwidth, B<psinib> uses several techniques to keep disk usage and
538     network traffic at acceptable level:
539    
540     =over 3
541    
542     =item - usage of hard-links to provide same files in each snapshot (as opposed
543     to have multiple copies of same file)
544    
545     =item - usage of file size, atime and mtime to find changes of files without
546     transferring whole file over network (just share browsing is transfered
547     over network)
548    
549     =item - usage of C<.md5sum> files (compatible with command-line utility
550     C<md5sum> to keep file between snapshots hard-linked
551    
552     =back
553    
554     =head1 CONFIGURATION
555    
556     This section is not yet written.
557    
558 dpavlin 1.4 =head1 HACKS, TRICKS, BUGS and LIMITATIONS
559    
560     This chapter will have all content that doesn't fit anywhere else.
561    
562     =head2 Can snapshots be more frequent than daily?
563 dpavlin 1.3
564     There is not real reason why you can't take snapshot more often than
565 dpavlin 1.4 once a day. Actually, if you are using B<psinib> to backup Windows
566     workstations you already know that they tend to come-and-go during the day
567     (reboots probably ;-), so running B<psinib> several times a day increases
568     your chance of having up-to-date backup (B<psinib> will not make multiple
569     snapshots for same day, nor will it update snapshot for current day if
570     it already exists).
571 dpavlin 1.3
572 dpavlin 1.4 However, changing B<psinib> to produce snapshots which are, for example, hourly
573 dpavlin 1.3 is a simple change of C<$DIR_TIME_FMT> which is currently set to
574     C<'%Y%m%d'> (see I<strftime> documentation for explanation of that
575     format). If you change that to C<'%Y%m%d-%H> you can have hourly snapshots
576     (if your network is fast enough, that is...). Also, some of messages in
577     program will sound strange, but other than that it should work.
578     I<You have been warned>.
579 dpavlin 1.4
580     =head2 Do I really need to share every directory which I want to snapshot?
581    
582     Actually, no. Due to usage of C<Filesys::SmbClient> module, you can also
583     specify sub-directory inside your share that you want to backup. This feature
584     is most useful if you want to use administrative shares (but, have in mind
585     that you have to enter your Win administrator password in unencrypted file on
586     disk to do that) like this:
587    
588     smbmount //server/c$/WinNT/fonts /mnt -o username=administrator%win
589    
590     After that you will get directories with snapshots like:
591    
592     server/c_WinNT_fonts/yyyymmdd/....
593    
594 dpavlin 1.3
595     =head1 AUTHOR
596    
597     Dobrica Pavlinusic <dpavlin@rot13.org>
598    
599     L<http://www.rot13.org/~dpavlin/>
600    
601     =head1 LICENSE
602    
603     This product is licensed under GNU Public License (GPL) v2 or later.
604    
605     =cut

  ViewVC Help
Powered by ViewVC 1.1.26