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

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

  ViewVC Help
Powered by ViewVC 1.1.26