/[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.1.1.1 - (show annotations) (vendor branch)
Sat Jan 4 11:42:56 2003 UTC (21 years, 3 months ago) by dpavlin
Branch: DbP
CVS Tags: r0
Changes since 1.1: +0 -0 lines
File MIME type: text/plain
initial import of first working version

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