/[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.3 - (hide annotations)
Sat Jan 4 13:29:12 2003 UTC (21 years, 3 months ago) by dpavlin
Branch: MAIN
Changes since 1.2: +87 -0 lines
File MIME type: text/plain
start of POD documentation -- use 'perldoc psinib.pl' to read it

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

  ViewVC Help
Powered by ViewVC 1.1.26