/[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.1 - (hide annotations)
Sat Jan 4 11:42:56 2003 UTC (21 years, 3 months ago) by dpavlin
Branch: MAIN
Branch point for: DbP
File MIME type: text/plain
Initial revision

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    
25     # configuration
26     my $LOG_TIME_FMT = '%Y-%m-%d %H:%M:%S'; # strftime format for logfile
27     my $DIR_TIME_FMT = '%Y%m%d'; # strftime format for backup dir
28    
29     my $LOG = '/var/log/backup.log'; # add path here...
30     $LOG = '/tmp/backup.log';
31    
32     # store backups in which directory
33     my $BACKUP_DEST = '/data/isis_backup';
34    
35     # files to ignore in backup
36     my @ignore = ('.md5sum', '.backupignore', 'backupignore.txt');
37    
38     # open log
39     open(L, "> $LOG") || die "can't open log $LOG: $!";
40     select((select(L), $|=1)[0]); # flush output
41    
42     # taint path: nmblookup should be there!
43     $ENV{'PATH'} = "/usr/bin:/bin";
44    
45     my $mounts = shift @ARGV ||
46     'mountscript';
47     # die "usage: $0 mountscript";
48    
49    
50     my @in_backup; # shares which are backeduped this run
51    
52     my $p = new Net::Ping->new();
53    
54     my $backup_ok = 0;
55    
56     my $smb;
57     my %smb_atime;
58     my %smb_mtime;
59    
60     open(M, $mounts) || die "can't open $mounts: $!";
61     while(<M>) {
62     chomp;
63     next if !/^\s*smbmount\s/;
64     my (undef,$share,undef,$opt) = split(/\s+/,$_,4);
65    
66     my ($user,$passwd,$workgroup);
67    
68     foreach (split(/,/,$opt)) {
69     my ($n,$v) = split(/=/,$_,2);
70     if ($n =~ m/username/i) {
71     if ($v =~ m#^(.+)/(.+)%(.+)$#) {
72     ($user,$passwd,$workgroup) = ($1,$2,$3);
73     } elsif ($v =~ m#^(.+)/(.+)$#) {
74     ($user,$workgroup) = ($1,$2);
75     } elsif ($v =~ m#^(.+)%(.+)$#) {
76     ($user,$passwd) = ($1,$2);
77     } else {
78     $user = $v;
79     }
80     } elsif ($n =~ m#workgroup#i) {
81     $workgroup = $v;
82     }
83     }
84    
85     push @in_backup,$share;
86    
87     print "working on $share\n";
88    
89     my $ip = get_ip($share);
90    
91     if ($ip) {
92     xlog($share,"IP is $ip");
93     if ($p->ping($ip)) {
94     snap_share($share,$user,$passwd,$workgroup);
95     $backup_ok++;
96     }
97     }
98     }
99     close(M);
100    
101     xlog("","$backup_ok backups completed of total ".($#in_backup+1)." this time (".int($backup_ok*100/($#in_backup+1))." %)");
102    
103     1;
104    
105     #-------------------------------------------------------------------------
106    
107     # get IP number from share
108     sub get_ip {
109     my $share = shift;
110    
111     my $host = $1 if ($share =~ m#//([^/]+)/#);
112    
113     my $ip = `nmblookup $host`;
114     if ($ip =~ m/(\d+\.\d+\.\d+\.\d+)\s$host/i) {
115     return $1;
116     }
117     }
118    
119     sub xlog {
120     my $share = shift;
121     my $t = strftime $LOG_TIME_FMT, localtime;
122     my $m = shift || '[no log entry]';
123     print STDERR $m,"\n";
124     print L "$t $share\t$m\n";
125     }
126    
127     sub snap_share {
128    
129     my $share = shift;
130    
131     my %param = ( debug => 0 );
132    
133     $param{username} = shift;
134     $param{password} = shift;
135     $param{workgroup} = shift;
136    
137     my ($host,$dir);
138     if ($share =~ m#//([^/]+)/(.+)$#) {
139     ($host,$dir) = ($1,$2);
140     $dir =~ s/\W/_/g;
141     $dir =~ s/^_+//;
142     $dir =~ s/_+$//;
143     } else {
144     print "Can't parse share $share into host and directory!\n";
145     return;
146     }
147    
148     my $date_dir = strftime $DIR_TIME_FMT, localtime;
149    
150     # latest backup directory
151     my $bl = "$BACKUP_DEST/$host/$dir/latest";
152     # current backup directory
153     my $bc = "$BACKUP_DEST/$host/$dir/$date_dir";
154    
155     my $real_bl;
156     if (-e $bl) {
157     $real_bl=readlink($bl) || die "can't read link $bl: $!";
158     $real_bl="$BACKUP_DEST/$host/$dir/$real_bl" if (substr($real_bl,0,1) ne "/");
159     } else {
160     print "no old backup, this is first run...\n";
161     }
162    
163     if (-e $bc && $real_bl && $real_bl eq $bc) {
164     print "$share allready backuped...\n";
165     return;
166     }
167    
168     die "You should really create BACKUP_DEST [$BACKUP_DEST] by hand! " if (!-e $BACKUP_DEST);
169    
170     if (! -e "$BACKUP_DEST/$host") {
171     mkdir "$BACKUP_DEST/$host" || die "can't make dir for host $host, $BACKUP_DEST/$host: $!";
172     print "created host directory $BACKUP_DEST/$host...\n";
173     }
174    
175     if (! -e "$BACKUP_DEST/$host/$dir") {
176     mkdir "$BACKUP_DEST/$host/$dir" || die "can't make dir for share $share, $BACKUP_DEST/$host/$dir $!";
177     print "created dir for share $share, $BACKUP_DEST/$host/$dir...\n";
178     }
179    
180     mkdir $bc || die "can't make dir for current backup $bc: $!";
181    
182     my @dirs = ( "/" );
183     my @smb_dirs = ( "/" );
184    
185     my $transfer = 0; # bytes transfered over network
186    
187     # this will store all available files and sizes
188     my @files;
189     my %file_size;
190     my %file_atime;
191     my %file_mtime;
192     my %file_md5;
193    
194     my @smb_files;
195     my %smb_size;
196     #my %smb_atime;
197     #my %smb_mtime;
198     my %smb_md5;
199    
200    
201     sub norm_dir {
202     my $foo = shift;
203     my $prefix = shift;
204     $foo =~ s#//+#/#g;
205     $foo =~ s#/+$##g;
206     $foo =~ s#^/+##g;
207     return $prefix.$foo if ($prefix);
208     return $foo;
209     }
210    
211     # read local filesystem
212     my $di = 0;
213     while ($di <= $#dirs && $real_bl) {
214     my $d=$dirs[$di++];
215     opendir(DIR,"$bl/$d") || warn "opendir($bl/$d): $!\n";
216    
217     # read .backupignore if exists
218     if (-f "$bl/$d/.backupignore") {
219     open(I,"$bl/$d/.backupignore");
220     while(<I>) {
221     chomp;
222     push @ignore,norm_dir("$d/$_");
223     }
224     close(I);
225     print STDERR "ignore: ",join("|",@ignore),"\n";
226     link "$bl/$d/.backupignore","$bc/$d/.backupignore" ||
227     warn "can't copy $bl/$d/.backupignore to current backup dir: $!\n";
228     }
229    
230     # read .md5sum if exists
231     if (-f "$bl/$d/.md5sum") {
232     open(I,"$bl/$d/.md5sum");
233     while(<I>) {
234     chomp;
235     my ($md5,$f) = split(/\s+/,$_,2);
236     $file_md5{$f}=$md5;
237     }
238     close(I);
239     }
240    
241     my @clutter = readdir(DIR);
242     foreach my $f (@clutter) {
243     next if ($f eq '.');
244     next if ($f eq '..');
245     my $pr = norm_dir("$d/$f"); # path relative
246     my $pf = norm_dir("$d/$f","$bl/"); # path full
247     if (grep(/^\Q$pr\E$/,@ignore) == 0) {
248     if (-f $pf) {
249     push @files,$pr;
250     $file_size{$pr}=(stat($pf))[7];
251     $file_atime{$pr}=(stat($pf))[8];
252     $file_mtime{$pr}=(stat($pf))[9];
253     } elsif (-d $pf) {
254     push @dirs,$pr;
255     } else {
256     print STDERR "unknown type: $pf\n";
257     }
258     } else {
259     print STDERR "ignored: $pr\n";
260     }
261     }
262     }
263    
264     xlog($share,($#files+1)." files and ".($#dirs+1)." dirs on local disk before backup");
265    
266     # read smb filesystem
267    
268     xlog($share,"smb to $share as $param{username}/$param{workgroup}");
269    
270     # FIX: how to aviod creation of ~/.smb/smb.conf ?
271     $smb = new Filesys::SmbClient(%param) || die "SmbClient :$!\n";
272    
273     $di = 0;
274     while ($di <= $#smb_dirs) {
275     my $d=$smb_dirs[$di++];
276     my $pf = norm_dir($d,"smb:$share/"); # path full
277     my $D = $smb->opendir($pf) || warn "smb->opendir($pf): $!\n";
278    
279     my @clutter = $smb->readdir_struct($D);
280     foreach my $item (@clutter) {
281     my $f = $item->[1];
282     next if ($f eq '.');
283     next if ($f eq '..');
284     my $pr = norm_dir("$d/$f"); # path relative
285     my $pf = norm_dir("$d/$f","smb:$share/"); # path full
286     if (grep(/^\Q$pr\E$/,@ignore) == 0) {
287     if ($item->[0] == main::SMBC_FILE) {
288     push @smb_files,$pr;
289     $smb_size{$pr}=($smb->stat($pf))[7];
290     $smb_atime{$pr}=($smb->stat($pf))[10];
291     $smb_mtime{$pr}=($smb->stat($pf))[11];
292     } elsif ($item->[0] == main::SMBC_DIR) {
293     push @smb_dirs,$pr;
294     } else {
295     print STDERR "unknown type: $pf\n";
296     }
297     } else {
298     print STDERR "smb ignored: $pr\n";
299     }
300     }
301     }
302    
303     xlog($share,($#smb_files+1)." files and ".($#smb_dirs+1)." dirs on remote share");
304    
305     # sync dirs
306     my $lc = List::Compare->new(\@dirs, \@smb_dirs);
307    
308     my @dirs2erase = $lc->get_Lonly;
309     my @dirs2create = $lc->get_Ronly;
310     xlog($share,($#dirs2erase+1)." dirs to erase and ".($#dirs2create+1)." dirs to create");
311    
312     # create new dirs
313     foreach (sort @smb_dirs) {
314     mkdir "$bc/$_" || warn "mkdir $_: $!\n";
315     }
316    
317     # sync files
318     $lc = List::Compare->new(\@files, \@smb_files);
319    
320     my @files2erase = $lc->get_Lonly;
321     my @files2create = $lc->get_Ronly;
322     xlog($share,($#files2erase+1)." files to erase and ".($#files2create+1)." files to create");
323    
324     sub smb_copy {
325     my $smb = shift;
326    
327     my $from = shift;
328     my $to = shift;
329    
330    
331     my $l = 0;
332    
333     foreach my $f (@_) {
334     #print "smb_copy $from/$f -> $to/$f\n";
335     if (! open(F,"> $to/$f")) {
336     print STDERR "can't open new file $to/$f: $!\n";
337     next;
338     }
339    
340     my $fd = $smb->open("$from/$f");
341     if (! $fd) {
342     print STDERR "can't open smb file $from/$f: $!\n";
343     next;
344     }
345    
346     while (defined(my $b=$smb->read($fd,4096))) {
347     print F $b;
348     $l += length($b);
349     }
350    
351     $smb->close($fd);
352     close(F);
353    
354     # FIX: this fails with -T
355     my ($a,$m) = ($smb->stat("$from/$f"))[10,11];
356     utime $a, $m, "$to/$f" ||
357     warn "can't update utime on $to/$f: $!\n";
358    
359     }
360     return $l;
361     }
362    
363     # copy new files
364     foreach (@files2create) {
365     $transfer += smb_copy($smb,"smb:$share",$bc,$_);
366     }
367    
368     my $size_sync = 0;
369     my $atime_sync = 0;
370     my $mtime_sync = 0;
371     my @sync_files;
372     my @ln_files;
373    
374     foreach ($lc->get_intersection) {
375    
376     my $f;
377    
378     if ($file_size{$_} != $smb_size{$_}) {
379     $f=$_;
380     $size_sync++;
381     }
382     if ($file_atime{$_} != $smb_atime{$_}) {
383     $f=$_;
384     $atime_sync++;
385     }
386     if ($file_mtime{$_} != $smb_mtime{$_}) {
387     $f=$_;
388     $mtime_sync++;
389     }
390    
391     if ($f) {
392     push @sync_files, $f;
393     } else {
394     push @ln_files, $_;
395     }
396     }
397    
398     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.");
399    
400     foreach (@sync_files) {
401     $transfer += smb_copy($smb,"smb:$share",$bc,$_);
402     }
403    
404     xlog($share,"$transfer bytes transfered...");
405    
406     foreach (@ln_files) {
407     link "$bl/$_","$bc/$_" || warn "link $bl/$_ -> $bc/$_: $!\n";
408     }
409    
410     # remove files
411     foreach (sort @files2erase) {
412     unlink "$bc/$_" || warn "unlink $_: $!\n";
413     }
414    
415     # remove not needed dirs (after files)
416     foreach (sort @dirs2erase) {
417     rmdir "$bc/$_" || warn "rmdir $_: $!\n";
418     }
419    
420    
421     # FIX: create .md5sum
422    
423     # create leatest link
424     symlink $bc,$bl || warn "can't create latest symlink $bl -> $bc: $!\n";
425    
426     xlog($share,"backup completed...");
427     }
428    
429     #-------------------------------------------------------------------------
430    

  ViewVC Help
Powered by ViewVC 1.1.26