/[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

Contents of /psinib.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Sat Jan 4 13:29:12 2003 UTC (21 years, 2 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 #!/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 use Fcntl qw(LOCK_EX LOCK_NB);
25
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
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
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 __END__
443 #-------------------------------------------------------------------------
444
445
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