"Fossies" - the Fresh Open Source Software Archive 
Member "dirvish-1.2.1/dirvish.pl" (19 Feb 2005, 23381 Bytes) of package /linux/privat/old/dirvish-1.2.1.tgz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "dirvish.pl" see the
Fossies "Dox" file reference documentation.
1
2 # $Id: dirvish.pl,v 12.0 2004/02/25 02:42:15 jw Exp $ $Name: Dirvish-1_2 $
3
4 $VERSION = ('$Name: Dirvish-1_2 $' =~ /Dirvish/i)
5 ? ('$Name: Dirvish-1_2 $' =~ m/^.*:\s+dirvish-(.*)\s*\$$/i)[0]
6 : '1.1.2 patch' . ('$Id: dirvish.pl,v 12.0 2004/02/25 02:42:15 jw Exp $'
7 =~ m/^.*,v(.*:\d\d)\s.*$/)[0];
8 $VERSION =~ s/_/./g;
9
10 #########################################################################
11 # #
12 # Copyright 2002 and $Date: 2004/02/25 02:42:15 $
13 # Pegasystems Technologies and J.W. Schultz #
14 # #
15 # Licensed under the Open Software License version 2.0 #
16 # #
17 # This program is free software; you can redistribute it #
18 # and/or modify it under the terms of the Open Software #
19 # License, version 2.0 by Lauwrence E. Rosen. #
20 # #
21 # This program is distributed in the hope that it will be #
22 # useful, but WITHOUT ANY WARRANTY; without even the implied #
23 # warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR #
24 # PURPOSE. See the Open Software License for details. #
25 # #
26 #########################################################################
27
28
29
30 #########################################################
31 # EXIT CODES
32 #
33 # 0 success
34 # 1-19 warnings
35 # 20-39 finalization error
36 # 40-49 post-* error
37 # 50-59 post-client error code % 10forwarded
38 # 60-69 post-server error code % 10forwarded
39 # 70-79 pre-* error
40 # 80-89 pre-server error code % 10 forwarded
41 # 90-99 pre-client error code % 10 forwarded
42 # 100-149 non-fatal error
43 # 150-199 fatal error
44 # 200-219 loadconfig error.
45 # 220-254 configuration error
46 # 255 usage error
47
48
49 use POSIX qw(strftime);
50 use Getopt::Long;
51 use Time::ParseDate;
52 use Time::Period;
53
54 @rsyncargs = qw(-vrltH --delete);
55
56 %RSYNC_CODES = (
57 0 => [ 'success', "No errors" ],
58 1 => [ 'fatal', "syntax or usage error" ],
59 2 => [ 'fatal', "protocol incompatibility" ],
60 3 => [ 'fatal', "errors selecting input/output files, dirs" ],
61 4 => [ 'fatal', "requested action not supported" ],
62 5 => [ 'fatal', "error starting client-server protocol" ],
63
64 10 => [ 'error', "error in socket IO" ],
65 11 => [ 'error', "error in file IO" ],
66 12 => [ 'check', "error in rsync protocol data stream" ],
67 13 => [ 'check', "errors with program diagnostics" ],
68 14 => [ 'error', "error in IPC code" ],
69
70 20 => [ 'error', "status returned when sent SIGUSR1, SIGINT" ],
71 21 => [ 'error', "some error returned by waitpid()" ],
72 22 => [ 'error', "error allocating core memory buffers" ],
73 23 => [ 'error', "partial transfer" ],
74 #KHL 2005/02/18: rsync code 24 changed from 'error' to 'warning'
75 24 => [ 'warning', "file vanished on sender" ],
76
77 30 => [ 'error', "timeout in data send/receive" ],
78
79 124 => [ 'fatal', "remote shell failed" ],
80 125 => [ 'error', "remote shell killed" ],
81 126 => [ 'fatal', "command could not be run" ],
82 127 => [ 'fatal', "command not found" ],
83 );
84
85 @BOOLEAN_FIELDS = qw(
86 permissions
87 checksum
88 devices
89 init
90 numeric-ids
91 sparse
92 stats
93 whole-file
94 xdev
95 zxfer
96 );
97
98 %RSYNC_OPT = ( # simple options
99 permissions => '-pgo',
100 devices => '-D',
101 sparse => '-S',
102 checksum => '-c',
103 'whole-file' => '-W',
104 xdev => '-x',
105 zxfer => '-z',
106 stats => '--stats',
107 'numeric-ids' => '--numeric-ids',
108 );
109
110 %RSYNC_POPT = ( # parametered options
111 'password-file' => '--password-file',
112 'rsync-client' => '--rsync-path',
113 );
114
115 sub errorscan;
116 sub logappend;
117 sub scriptrun;
118 sub seppuku;
119
120 sub usage
121 {
122 my $message = shift(@_);
123
124 length($message) and print STDERR $message, "\n\n";
125
126 $! and exit(255); # because getopt seems to send us here for death
127
128 print STDERR <<EOUSAGE;
129 USAGE
130 dirvish --vault vault OPTIONS [ file_list ]
131
132 OPTIONS
133 --image image_name
134 --config configfile
135 --branch branch_name
136 --reference branch_name|image_name
137 --expire expire_date
138 --init
139 --reset option
140 --summary short|long
141 --no-run
142 EOUSAGE
143
144 exit 255;
145 }
146
147 $Options = {
148 'Command-Args' => join(' ', @ARGV),
149 'numeric-ids' => 1,
150 'devices' => 1,
151 permissions => 1,
152 'stats' => 1,
153 exclude => [ ],
154 'expire-rule' => [ ],
155 'rsync-option' => [ ],
156 bank => [ ],
157 'image-default' => '%Y%m%d%H%M%S',
158 rsh => 'ssh',
159 summary => 'short',
160 config =>
161 sub {
162 loadconfig('f', $_[1], $Options);
163 },
164 client =>
165 sub {
166 $$Options{$_[0]} = $_[1];
167 loadconfig('fog', "$CONFDIR/$_[1]", $Options);
168 },
169 branch =>
170 sub {
171 if ($_[1] =~ /:/)
172 {
173 ($$Options{vault}, $$Options{branch})
174 = split(/:/, $_[1]);
175 } else {
176 $$Options{$_[0]} = $_[1];
177 }
178 loadconfig('f', "$$Options{branch}", $Options);
179 },
180 vault =>
181 sub {
182 if ($_[1] =~ /:/)
183 {
184 ($$Options{vault}, $$Options{branch})
185 = split(/:/, $_[1]);
186 loadconfig('f', "$$Options{branch}", $Options);
187 } else {
188 $$Options{$_[0]} = $_[1];
189 loadconfig('f', 'default.conf', $Options);
190 }
191 },
192 reset =>
193 sub {
194 $$Options{$_[1]} = ref($$Options{$_[1]}) eq 'ARRAY'
195 ? [ ]
196 : undef;
197 },
198 version => sub {
199 print STDERR "dirvish version $VERSION\n";
200 exit(0);
201 },
202 help => \&usage,
203 };
204
205 if ($CONFDIR =~ /dirvish$/ && -f "$CONFDIR.conf")
206 {
207 loadconfig('f', "$CONFDIR.conf", $Options);
208 }
209 elsif (-f "$CONFDIR/master.conf")
210 {
211 loadconfig('f', "$CONFDIR/master.conf", $Options);
212 }
213 elsif (-f "$CONFDIR/dirvish.conf")
214 {
215 seppuku 250, <<EOERR;
216 ERROR: no master configuration file.
217 An old $CONFDIR/dirvish.conf file found.
218 Please read the dirvish release notes.
219 EOERR
220 }
221 else
222 {
223 seppuku 251, "ERROR: no master configuration file";
224 }
225
226 GetOptions($Options, qw(
227 config=s
228 vault=s
229 client=s
230 tree=s
231 image=s
232 image-time=s
233 expire=s
234 branch=s
235 reference=s
236 exclude=s@
237 sparse!
238 zxfer!
239 checksum!
240 whole-file!
241 xdev!
242 speed-limit=s
243 file-exclude|fexclude=s
244 reset=s
245 index=s
246 init!
247 summary=s
248 no-run|dry-run
249 help|?
250 version
251 )) or usage;
252
253 chomp($$Options{Server} = `hostname`);
254
255 if ($$Options{image})
256 {
257 $image = $$Options{Image} = $$Options{image};
258 }
259 elsif ($$Options{'image-temp'})
260 {
261 $image = $$Options{'image-temp'};
262 $$Options{Image} = $$Options{'image-default'};
263 }
264 else
265 {
266 $image = $$Options{Image} = $$Options{'image-default'};
267 }
268
269 $$Options{branch} =~ /:/
270 and ($$Options{vault}, $$Options{branch})
271 = split(/:/, $Options{branch});
272 $$Options{vault} =~ /:/
273 and ($$Options{vault}, $$Options{branch})
274 = split(/:/, $Options{vault});
275
276 for $key (qw(vault Image client tree))
277 {
278 length($$Options{$key}) or usage("$key undefined");
279 ref($$Options{$key}) eq 'CODE' and usage("$key undefined");
280 }
281
282 if(!$$Options{Bank})
283 {
284 my $bank;
285 for $bank (@{$$Options{bank}})
286 {
287 if (-d "$bank/$$Options{vault}")
288 {
289 $$Options{Bank} = $bank;
290 last;
291 }
292 }
293 $$Options{Bank} or seppuku 220, "ERROR: cannot find vault $$Options{vault}";
294 }
295 $vault = join('/', $$Options{Bank}, $$Options{vault});
296 -d $vault or seppuku 221, "ERROR: cannot find vault $$Options{vault}";
297
298 my $now = time;
299
300 if ($$Options{'image-time'})
301 {
302 my $n = $now;
303
304 $now = parsedate($$Options{'image-time'},
305 DATE_REQUIRED => 1, NOW => $n);
306 if (!$now)
307 {
308 $now = parsedate($$Options{'image-time'}, NOW => $n);
309 $now > $n && $$Options{'image-time'} !~ /\+/ and $now -= 24*60*60;
310 }
311 $now or seppuku 222, "ERROR: image-time unparseable: $$Options{'image-time'}";
312 }
313 $$Options{'Image-now'} = strftime('%Y-%m-%d %H:%M:%S', localtime($now));
314
315 $$Options{Image} =~ /%/
316 and $$Options{Image} = strftime($$Options{Image}, localtime($now));
317 $image =~ /%/
318 and $image = strftime($image, localtime($now));
319
320 !$$Options{branch} || ref($$Options{branch})
321 and $$Options{branch} = $$Options{'branch-default'} || 'default';
322
323 $seppuku_prefix = join(':', $$Options{vault}, $$Options{branch}, $image);
324
325 if (-d "$vault/$$Options{'image-temp'}" && $image eq $$Options{'image-temp'})
326 {
327 my $iinfo;
328 $iinfo = loadconfig('R', "$vault/$image/summary");
329 $$iinfo{Image} or seppuku 223, "cannot cope with existing $image";
330 if ($$Options{'no-run'})
331 {
332 print "ACTION: rename $vault/$image $vault/$$iinfo{Image}\n\n";
333 $have_temp = 1;
334 } else {
335 rename ("$vault/$image", "$vault/$$iinfo{Image}");
336 }
337 }
338
339 -d "$vault/$$Options{Image}" and seppuku 224, "ERROR: image $$Options{Image} already exists in $vault";
340 -d "$vault/$image" && !$have_temp and seppuku 225, "ERROR: image $image already exists in $vault";
341
342 $$Options{Reference} = $$Options{reference} || $$Options{branch};
343 if (!$$Options{init} && -f "$vault/dirvish/$$Options{Reference}.hist")
344 {
345 my (@images, $i, $s);
346 open(IMAGES, "$vault/dirvish/$$Options{Reference}.hist");
347 @images = <IMAGES>;
348 close IMAGES;
349 while ($i = pop(@images))
350 {
351 $i =~ s/\s.*$//s;
352 -d "$vault/$i/tree" or next;
353
354 $$Options{Reference} = $i;
355 last;
356 }
357 }
358 $$Options{init} || -d "$vault/$$Options{Reference}"
359 or seppuku 227, "ERROR: no images for branch $$Options{branch} found";
360
361 if(!$$Options{expire} && $$Options{expire} !~ /never/i
362 && scalar(@{$$Options{'expire-rule'}}))
363 {
364 my ($rule, $p, $t, $e);
365 my @cron;
366 my @pnames = qw(min hr md mo wd);
367
368 for $rule (reverse(@{$$Options{'expire-rule'}}))
369 {
370 if ($rule =~ /\{.*\}/)
371 {
372 ($p, $e) = $rule =~ m/^(.*\175)\s*([^\175]*)$/;
373 } else {
374 @cron = split(/\s+/, $rule, 6);
375 $e = $cron[5] || '';
376 $p = '';
377 for ($t = 0; $t < @pnames; $t++)
378 {
379 $cron[$t] eq '*' and next;
380 ($p .= "$pnames[$t] { $cron[$t] } ")
381 =~ tr/,/ /;
382 }
383 }
384 if (!$p)
385 {
386 $$Options{'Expire-rule'} = $rule;
387 $$Options{Expire} = $e;
388 last;
389 }
390 $t = inPeriod($now, $p);
391 if ($t == 1)
392 {
393 $e ||= 'Never';
394 $$Options{'Expire-rule'} = $rule;
395 $$Options{Expire} = $e;
396 last;
397 }
398 $t == -1 and printf STDERR "WARNING: invalid expire rule %s\n", $rule;
399 next;
400 }
401 } else {
402 $$Options{Expire} = $$Options{expire};
403 }
404
405 $$Options{Expire} ||= $$Options{'expire-default'};
406
407 if ($$Options{Expire} && $$Options{Expire} !~ /Never/i)
408 {
409 $$Options{Expire} .= strftime(' == %Y-%m-%d %H:%M:%S',
410 localtime(parsedate($$Options{Expire}, NOW => $now)));
411 } else {
412 $$Options{Expire} = 'Never';
413 }
414
415 #+SIS: KHL 2005-02-18 SpacesInSource fix
416 #-SIS: ($srctree, $aliastree) = split(/\s+/, $$Options{tree})
417 ($srctree, $aliastree) = split(/[^\\]\s+/, $$Options{tree})
418 or seppuku 228, "ERROR: no source tree defined";
419 $srctree =~ s(\\ )( )g; #+SIS
420 $srctree =~ s(/+$)();
421 $aliastree =~ s(/+$)();
422 $aliastree ||= $srctree;
423
424 $destree = join("/", $vault, $image, 'tree');
425 $reftree = join('/', $vault, $$Options{Reference}, 'tree');
426 $err_temp = join("/", $vault, $image, 'rsync_error.tmp');
427 $err_file = join("/", $vault, $image, 'rsync_error');
428 $log_file = join("/", $vault, $image, 'log');
429 $log_temp = join("/", $vault, $image, 'log.tmp');
430 $exl_file = join("/", $vault, $image, 'exclude');
431 $fsb_file = join("/", $vault, $image, 'fsbuffer');
432
433 while (($k, $v) = each %RSYNC_OPT)
434 {
435 $$Options{$k} and push @rsyncargs, $v;
436 }
437
438 while (($k, $v) = each %RSYNC_POPT)
439 {
440 $$Options{$k} and push @rsyncargs, $v . '=' . $$Options{$k};
441 }
442
443 $$Options{'speed-limit'}
444 and push @rsyncargs, '--bwlimit=' . $$Options{'speed-limit'} * 100;
445
446 scalar @{$$Options{'rsync-option'}}
447 and push @rsyncargs, @{$$Options{'rsync-option'}};
448
449 scalar @{$$Options{exclude}}
450 and push @rsyncargs, '--exclude-from=' . $exl_file;
451
452 if (!$$Options{'no-run'})
453 {
454 mkdir "$vault/$image", 0700
455 or seppuku 230, "mkdir $vault/$image failed";
456 mkdir $destree, 0755;
457
458 open(SUMMARY, ">$vault/$image/summary")
459 or seppuku 231, "cannot create $vault/$image/summary";
460 } else {
461 open(SUMMARY, ">-");
462 }
463
464 $Set = $Unset = '';
465 for (@BOOLEAN_FIELDS)
466 {
467 $$Options{$_}
468 and $Set .= $_ . ' '
469 or $Unset .= $_ . ' ';
470 }
471
472 @summary_fields = qw(
473 client tree rsh
474 Server Bank vault branch
475 Image image-temp Reference
476 Image-now Expire Expire-rule
477 exclude
478 rsync-option
479 Enabled
480 );
481 $summary_reset = 0;
482 for $key (@summary_fields, 'RESET', sort(keys(%$Options)))
483 {
484 if ($key eq 'RESET')
485 {
486 $summary_reset++;
487 $Set and print SUMMARY "SET $Set\n";
488 $Unset and print SUMMARY "UNSET $Unset\n";
489 print SUMMARY "\n";
490 $$Options{summary} ne 'long' && !$$Options{'no-run'} and last;
491 next;
492 }
493 grep(/^$key$/, @BOOLEAN_FIELDS) and next;
494 $summary_reset && grep(/^$key$/, @summary_fields) and next;
495
496 $val = $$Options{$key};
497 if(ref($val) eq 'ARRAY')
498 {
499 my $v;
500 scalar(@$val) or next;
501 print SUMMARY "$key:\n";
502 for $v (@$val)
503 {
504 printf SUMMARY "\t%s\n", $v;
505 }
506 }
507 ref($val) and next;
508 $val or next;
509 printf SUMMARY "%s: %s\n", $key, $val;
510 }
511
512 $$Options{init} or push @rsyncargs, "--link-dest=$reftree";
513
514 $rclient = undef;
515 $$Options{client} ne $$Options{Server}
516 and $rclient = $$Options{client} . ':';
517
518 $ENV{RSYNC_RSH} = $$Options{rsh};
519
520 @cmd = (
521 ($$Options{rsync} ? $$Options{rsync} : 'rsync'),
522 @rsyncargs,
523 $rclient . $srctree . '/',
524 $destree
525 );
526 printf SUMMARY "\n%s: %s\n", 'ACTION', join (' ', @cmd);
527
528 $$Options{'no-run'} and exit 0;
529
530 printf SUMMARY "%s: %s\n", 'Backup-begin', strftime('%Y-%m-%d %H:%M:%S', localtime);
531
532 $env_srctree = $srctree; #+SIS:
533 $env_srctree =~ s/ /\\ /g; #+SIS:
534
535 $WRAPPER_ENV = sprintf (" %s=%s" x 5,
536 'DIRVISH_SERVER', $$Options{Server},
537 'DIRVISH_CLIENT', $$Options{client},
538 #-SIS: 'DIRVISH_SRC', $srctree,
539 'DIRVISH_SRC', $env_srctree, #+SIS:
540 'DIRVISH_DEST', $destree,
541 'DIRVISH_IMAGE', join(':',
542 $$Options{vault},
543 $$Options{branch},
544 $$Options{Image}),
545 );
546
547 if(scalar @{$$Options{exclude}})
548 {
549 open(EXCLUDE, ">$exl_file");
550 for (@{$$Options{exclude}})
551 {
552 print EXCLUDE $_, "\n";
553 }
554 close(EXCLUDE);
555 $ENV{DIRVISH_EXCLUDE} = $exl_file;
556 }
557
558 if ($$Options{'pre-server'})
559 {
560 $status{'pre-server'} = scriptrun(
561 lable => 'Pre-Server',
562 cmd => $$Options{'pre-server'},
563 now => $now,
564 log => $log_file,
565 dir => $destree,
566 env => $WRAPPER_ENV,
567 );
568
569 if ($status{'pre-server'})
570 {
571 my $s = $status{'pre-server'} >> 8;
572 printf SUMMARY "pre-server failed (%d)\n", $s;
573 printf STDERR "%s:%s pre-server failed (%d)\n",
574 $$Options{vault}, $$Options{branch},
575 $s;
576 exit 80 + ($s % 10);
577 }
578 }
579
580 if ($$Options{'pre-client'})
581 {
582 $status{'pre-client'} = scriptrun(
583 lable => 'Pre-Client',
584 cmd => $$Options{'pre-client'},
585 now => $now,
586 log => $log_file,
587 dir => $srctree,
588 env => $WRAPPER_ENV,
589 shell => (($$Options{client} eq $$Options{Server})
590 ? undef
591 : "$$Options{rsh} $$Options{client}"),
592 );
593 if ($status{'pre-client'})
594 {
595 my $s = $status{'pre-client'};
596 printf SUMMARY "pre-client failed (%d)\n", $s;
597 printf STDERR "%s:%s pre-client failed (%d)\n",
598 $$Options{vault}, $$Options{branch},
599 $s;
600
601 ($$Options{'pre-server'}) && scriptrun(
602 lable => 'Post-Server',
603 cmd => $$Options{'post-server'},
604 now => $now,
605 log => $log_file,
606 dir => $destree,
607 env => $WRAPPER_ENV . ' DIRVISH_STATUS=fail',
608 );
609 exit 90 + ($s % 10);
610 }
611 }
612
613 # create a buffer to allow logging to work after full fileystem
614 open (FSBUF, ">$fsb_file");
615 print FSBUF " \n" x 6553;
616 close FSBUF;
617
618 for ($runloops = 0; $runloops < 5; ++$runloops)
619 {
620 logappend($log_file, sprintf("\n%s: %s\n", 'ACTION', join(' ', @cmd)));
621
622 # create error file and connect rsync STDERR to it.
623 # preallocate 64KB so there will be space if rsync
624 # fills the filesystem.
625 open (INHOLD, "<&STDIN");
626 open (ERRHOLD, ">&STDERR");
627 open (STDERR, ">$err_temp");
628 print STDERR " \n" x 6553;
629 seek STDERR, 0, 0;
630
631 open (OUTHOLD, ">&STDOUT");
632 open (STDOUT, ">$log_temp");
633
634 $status{code} = (system(@cmd) >> 8) & 255;
635
636 open (STDERR, ">&ERRHOLD");
637 open (STDOUT, ">&OUTHOLD");
638 open (STDIN, "<&INHOLD");
639
640 open (LOG_FILE, ">>$log_file");
641 open (LOG_TEMP, "<$log_temp");
642 while (<LOG_TEMP>)
643 {
644 chomp;
645 m(/$) and next;
646 m( [-=]> ) and next;
647 print LOG_FILE $_, "\n";
648 }
649 close (LOG_TEMP);
650 close (LOG_FILE);
651 unlink $log_temp;
652
653 $status{code} and errorscan(\%status, $err_file, $err_temp);
654
655 $status{warning} || $status{error}
656 and logappend($log_file, sprintf(
657 "RESULTS: warnings = %d, errors = %d",
658 $status{warning}, $status{error}
659 )
660 );
661 if ($RSYNC_CODES{$status{code}}[0] eq 'check')
662 {
663 $status{fatal} and last;
664 $status{error} or last;
665 } else {
666 $RSYNC_CODES{$status{code}}[0] eq 'fatal' and last;
667 $RSYNC_CODES{$status{code}}[0] eq 'error' or last;
668 }
669 }
670
671 scalar @{$$Options{exclude}} && unlink $exl_file;
672 -f $fsb_file and unlink $fsb_file;
673
674 if ($status{code})
675 {
676 if ($RSYNC_CODES{$status{code}}[0] eq 'check')
677 {
678 if ($status{fatal}) { $Status = 'fatal'; }
679 elsif ($status{error}) { $Status = 'error'; }
680 elsif ($status{warning}) { $Status = 'warning'; }
681 $Status_msg = sprintf "%s (%d) -- %s",
682 ($Status eq 'fatal' ? 'fatal error' : $Status),
683 $status{code},
684 $status{message}{$Status};
685 } elsif ($RSYNC_CODES{$status{code}}[0] eq 'fatal')
686 {
687 $Status_msg = sprintf "fatal error (%d) -- %s",
688 $status{code},
689 $RSYNC_CODES{$status{code}}[1];
690 }
691
692 if (!$Status_msg)
693 {
694 $RSYNC_CODES{$status{code}}[0] eq 'fatal' and $Status = 'fatal';
695 $RSYNC_CODES{$status{code}}[0] eq 'error' and $Status = 'error';
696 $RSYNC_CODES{$status{code}}[0] eq 'warning' and $Status = 'warning';
697 $RSYNC_CODES{$status{code}}[0] eq 'check' and $Status = 'unknown';
698 exists $RSYNC_CODES{$status{code}} or $Status = 'unknown';
699 $Status_msg = sprintf "%s (%d) -- %s",
700 ($Status eq 'fatal' ? 'fatal error' : $Status),
701 $status{code},
702 $RSYNC_CODES{$status{code}}[1];
703 }
704 if ($Status eq 'fatal' || $Status eq 'error' || $status eq 'unknown')
705 {
706 printf STDERR "dirvish %s:%s %s\n",
707 $$Options{vault}, $$Options{branch},
708 $Status_msg;
709 }
710 } else {
711 $Status = $Status_msg = 'success';
712 }
713 $WRAPPER_ENV .= ' DIRVISH_STATUS=' . $Status;
714
715 if ($$Options{'post-client'})
716 {
717 $status{'post-client'} = scriptrun(
718 lable => 'Post-Client',
719 cmd => $$Options{'post-client'},
720 now => $now,
721 log => $log_file,
722 dir => $srctree,
723 env => $WRAPPER_ENV,
724 shell => (($$Options{client} eq $$Options{Server})
725 ? undef
726 : "$$Options{rsh} $$Options{client}"),
727 );
728 if ($status{'post-client'})
729 {
730 my $s = $status{'post-client'} >> 8;
731 printf SUMMARY "post-client failed (%d)\n", $s;
732 printf STDERR "%s:%s post-client failed (%d)\n",
733 $$Options{vault}, $$Options{branch},
734 $s;
735 }
736 }
737
738 if ($$Options{'post-server'})
739 {
740 $status{'post-server'} = scriptrun(
741 lable => 'Post-Server',
742 cmd => $$Options{'post-server'},
743 now => $now,
744 log => $log_file,
745 dir => $destree,
746 env => $WRAPPER_ENV,
747 );
748 if ($status{'post-server'})
749 {
750 my $s = $status{'post-server'} >> 8;
751 printf SUMMARY "post-server failed (%d)\n", $s;
752 printf STDERR "%s:%s post-server failed (%d)\n",
753 $$Options{vault}, $$Options{branch},
754 $s;
755 }
756 }
757
758 if($status{fatal})
759 {
760 system ("rm -rf $destree");
761 unlink $err_temp;
762 printf SUMMARY "%s: %s\n", 'Status', $Status_msg;
763 exit 199;
764 } else {
765 unlink $err_temp;
766 -z $err_file and unlink $err_file;
767 }
768
769 printf SUMMARY "%s: %s\n",
770 'Backup-complete', strftime('%Y-%m-%d %H:%M:%S', localtime);
771
772 printf SUMMARY "%s: %s\n", 'Status', $Status_msg;
773
774 # We assume warning and unknown produce useful results
775 $Status eq 'warning' || $Status eq 'unknown' and $Status = 'success';
776
777 if ($Status eq 'success')
778 {
779 -s "$vault/dirvish/$$Options{branch}.hist" or $newhist = 1;
780 if (open(HIST, ">>$vault/dirvish/$$Options{branch}.hist"))
781 {
782 $newhist == 1 and printf HIST ("#%s\t%s\t%s\t%s\n",
783 qw(IMAGE CREATED REFERECE EXPIRES));
784 printf HIST ("%s\t%s\t%s\t%s\n",
785 $$Options{Image},
786 strftime('%Y-%m-%d %H:%M:%S', localtime),
787 $$Options{Reference} || '-',
788 $$Options{Expire}
789 );
790 close (HIST);
791 }
792 } else {
793 printf STDERR "dirvish error: branch %s:%s image %s failed\n",
794 $vault, $$Options{branch}, $$Options{Image};
795 }
796
797 length($$Options{'meta-perm'})
798 and chmod oct($$Options{'meta-perm'}),
799 "$vault/$image/summary",
800 "$vault/$image/rsync_error",
801 "$vault/$image/log";
802
803 $Status eq 'success' or exit 149;
804
805 $$Options{log} =~ /.*(gzip)|(bzip2)/
806 and system "$$Options{log} $vault/$image/log";
807
808 if ($$Options{index} && $$Options{index} !~/^no/i)
809 {
810
811 open(INDEX, ">$vault/$image/index");
812 open(FIND, "find $destree -ls|") or seppuku 21, "dirvish $vault:$image cannot build index";
813 while (<FIND>)
814 {
815 s/ $destree\// $aliastree\//g;
816 print INDEX $_ or seppuku 22, "dirvish $vault:$image error writing index";
817 }
818 close FIND;
819 close INDEX;
820
821 length($$Options{'meta-perm'})
822 and chmod oct($$Options{'meta-perm'}), "$vault/$image/index";
823 $$Options{index} =~ /.*(gzip)|(bzip2)/
824 and system "$$Options{index} $vault/$image/index";
825 }
826
827 chmod oct($$Options{'image-perm'}) || 0755, "$vault/$image";
828
829 exit 0;
830
831 sub errorscan
832 {
833 my ($status, $err_file, $err_temp) = @_;
834 my $err_this_loop = 0;
835 my ($action, $pattern, $severity, $message);
836 my @erraction = (
837 [ 'fatal', '^ssh:.*nection refused', ],
838 [ 'fatal', '^\S*sh: .* No such file', ],
839 [ 'fatal', '^ssh:.*No route to host', ],
840 [ 'error', '^file has vanished: ', ],
841 [ 'warning', 'readlink .*: no such file or directory', ],
842
843 [ 'fatal', 'failed to write \d+ bytes:',
844 'write error, filesystem probably full' ],
845 [ 'fatal', 'write failed',
846 'write error, filesystem probably full' ],
847 [ 'error', 'error: partial transfer',
848 'partial transfer' ],
849 [ 'error', 'error writing .* exiting: Broken pipe',
850 'broken pipe' ],
851 );
852
853 open (ERR_FILE, ">>$err_file");
854 open (ERR_TEMP, "<$err_temp");
855 while (<ERR_TEMP>)
856 {
857 chomp;
858 s/\s+$//;
859 length or next;
860 if (!$err_this_loop)
861 {
862 printf ERR_FILE "\n\n*** Execution cycle %d ***\n\n",
863 $runloops;
864 $err_this_loop++
865 }
866 print ERR_FILE $_, "\n";
867
868 $$status{code} or next;
869
870 for $action (@erraction)
871 {
872 ($severity, $pattern, $message) = @$action;
873 /$pattern/ or next;
874
875 ++$$status{$severity};
876 $msg = $message || $_;
877 $$status{message}{$severity} ||= $msg;
878 logappend($log_file, $msg);
879 $severity eq 'fatal'
880 and printf STDERR "dirvish %s:%s fatal error: %s\n",
881 $$Options{vault}, $$Options{branch},
882 $msg;
883 last;
884 }
885 if (/No space left on device/)
886 {
887 $msg = 'filesystem full';
888 $$status{message}{fatal} eq $msg and next;
889
890 -f $fsb_file and unlink $fsb_file;
891 ++$$status{fatal};
892 $$status{message}{fatal} = $msg;
893 logappend($log_file, $msg);
894 printf STDERR "dirvish %s:%s fatal error: %s\n",
895 $$Options{vault}, $$Options{branch},
896 $msg;
897 }
898 if (/error: error in rsync protocol data stream/)
899 {
900 ++$$status{error};
901 $msg = $message || $_;
902 $$status{message}{error} ||= $msg;
903 logappend($log_file, $msg);
904 }
905 }
906 close ERR_TEMP;
907 close ERR_FILE;
908 }
909
910 sub logappend
911 {
912 my ($file, @messages) = @_;
913 my $message;
914
915 open (LOGFILE, '>>' . $file) or seppuku 20, "cannot open log file $file";
916 for $message (@messages)
917 {
918 print LOGFILE $message, "\n";
919 }
920 close LOGFILE;
921 }
922
923 sub scriptrun
924 {
925 my (%A) = @_;
926 my ($cmd, $rcmd, $return);
927
928 $A{now} ||= time;
929 $A{log} or seppuku 229, "must specify logfile for scriptrun()";
930 ref($A{cmd}) and seppuku 232, "$A{lable} option specification error";
931
932 $cmd = strftime($A{cmd}, localtime($A{now}));
933
934 #KHL 2005-02-18 BadShellCommandCWD: fix inverted logic
935 # if ($A{dir} =~ /^:/)
936 if ($A{dir} !~ /^:/)
937 {
938 $rcmd = sprintf ("%s 'cd %s; %s %s' >>%s",
939 ("$A{shell}" || "/bin/sh -c"),
940 $A{dir}, $A{env},
941 $cmd,
942 $A{log}
943 );
944 } else {
945 $rcmd = sprintf ("%s '%s %s' >>%s",
946 ("$A{shell}" || "/bin/sh -c"),
947 $A{env},
948 $cmd,
949 $A{log}
950 );
951 }
952
953 $A{lable} =~ /^Post/ and logappend($A{log}, "\n");
954
955 logappend($A{log}, "$A{lable}: $cmd");
956
957 $return = system($rcmd);
958
959 $A{lable} =~ /^Pre/ and logappend($A{log}, "\n");
960
961 return $return;
962 }
963