/[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.2 - (hide annotations)
Sat Jan 4 12:14:54 2003 UTC (21 years, 2 months ago) by dpavlin
Branch: MAIN
Changes since 1.1: +13 -0 lines
File MIME type: text/plain
added locking using logfile

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     #-------------------------------------------------------------------------
443    

  ViewVC Help
Powered by ViewVC 1.1.26