Annotation of foxridge-archiver/archiver.pl, revision 1.1
1.1 ! casties 1: #!/usr/local/bin/perl -w
! 2:
! 3: use strict;
! 4:
! 5: use XML::LibXML;
! 6:
! 7: # MPIWG libraries
! 8: use lib '/usr/local/mpiwg/archive';
! 9: use MPIWGStor;
! 10:
! 11: # make output unbuffered
! 12: $|=1;
! 13:
! 14: #######################################################
! 15: # internal parameters
! 16: #
! 17:
! 18: # program version
! 19: my $version = "0.5 (15.1.2004)";
! 20:
! 21: # rewrite XML file (necessary for archive date!)
! 22: my $fix_xml = 1;
! 23: my $xml_changed = 0;
! 24: # XML namespace (not really implemented!)
! 25: my $namespace = "";
! 26:
! 27: # archive name (archive-path element, usually == $docdir)
! 28: my $archname;
! 29: # archive storage date (now)
! 30: my $archdate = stime(time);
! 31:
! 32: # delete "junk" files before archiving
! 33: my $delete_junk_files = 1;
! 34:
! 35: # delete data files after archiving
! 36: my $delete_data_files = 1;
! 37:
! 38:
! 39: #######################################################
! 40: # external programs
! 41: #
! 42: my $archprog = "/opt/tivoli/tsm/client/ba/bin/dsmc";
! 43: if (! -x $archprog) {
! 44: print "ABORT: TSM client program '$archprog' missing!!\n";
! 45: exit 1;
! 46: }
! 47: my $checkprog = "/usr/local/mpiwg/archive/metacheck";
! 48: if (! -x $checkprog) {
! 49: print "ABORT: meta data checking program '$checkprog' missing!!\n";
! 50: exit 1;
! 51: }
! 52: # log file for archiver
! 53: my $log_file = "/var/log/mpiwg-archiver.log";
! 54: if (! open LOG, ">>$log_file") {
! 55: print "ABORT: unable to write log file '$log_file'!!\n";
! 56: exit 1;
! 57: }
! 58:
! 59: #######################################################
! 60: # check parameters that were passed to the program
! 61: #
! 62: if ($#ARGV < 0) {
! 63: print "ABORT: no document directory given!\n";
! 64: exit 1;
! 65: }
! 66: my $docdir = $ARGV[0];
! 67: # strip trailing slashes
! 68: $docdir =~ s/\/$//;
! 69: if (! -d $docdir) {
! 70: print "ABORT: document directory \'$docdir\' doesn't exist!\n";
! 71: exit 1;
! 72: }
! 73: if (($#ARGV > 0)&&($ARGV[1] eq "-premigrate")) {
! 74: $delete_data_files = 0;
! 75: }
! 76:
! 77: my $metafile = "$docdir/index.meta";
! 78: if (! -f $metafile) {
! 79: print "ABORT: metadata index file \'$metafile\' doesn't exist!\n";
! 80: exit 1;
! 81: }
! 82:
! 83: #######################################################
! 84: # internal variables
! 85: #
! 86:
! 87: # number of errors
! 88: my $errcnt = 0;
! 89: # number of warnings
! 90: my $warncnt = 0;
! 91:
! 92: #######################################################
! 93: # subroutines
! 94: #
! 95:
! 96: #
! 97: # $files = read_resource_meta($rootnode)
! 98: #
! 99: # checks general resource meta information and reads the list of files
! 100: #
! 101: sub read_resource_meta {
! 102: my ($rootnode) = @_;
! 103: my %files;
! 104: #
! 105: # archive path
! 106: #
! 107: # get archive-path
! 108: $archname = MPIWGStor::sstrip($rootnode->findvalue('child::archive-path'));
! 109: if (! $archname) {
! 110: print "ABORT: archive-name element missing!!\n";
! 111: exit 1;
! 112: }
! 113:
! 114: #
! 115: # files
! 116: #
! 117: my @filenodes = $rootnode->findnodes('child::file');
! 118: foreach my $fn (@filenodes) {
! 119: my $name = MPIWGStor::sstrip($fn->findvalue('child::name'));
! 120: my $path = MPIWGStor::sstrip($fn->findvalue('child::path'));
! 121: print "FILE: ($path)$name\n";
! 122: my $f = ($path) ? "$path/$name" : "$name";
! 123: $files{$f} = $name;
! 124: }
! 125:
! 126: #
! 127: # archive-storage-date
! 128: #
! 129: my $stordatenode = ($rootnode->find('child::archive-storage-date'))->get_node(1);
! 130: if ($stordatenode) {
! 131: print "WARNING: archive storage date exists! Resource already archived?\n";
! 132: $warncnt++;
! 133: # delete old date
! 134: $stordatenode->removeChildNodes;
! 135: } else {
! 136: # create new storage date node
! 137: $stordatenode = $rootnode->addNewChild($namespace, "archive-storage-date");
! 138: # move after archive-path
! 139: $rootnode->insertAfter($stordatenode, ($rootnode->find('child::archive-path'))->get_node(1));
! 140: }
! 141: $stordatenode->appendTextNode($archdate);
! 142: $xml_changed++;
! 143: return \%files;
! 144: }
! 145:
! 146:
! 147: #
! 148: # $%files = run_archive
! 149: #
! 150: # runs the archiver program on $docdir and returns a list of archived files
! 151: #
! 152: sub run_archive {
! 153: my %files;
! 154: print LOG "START archiver $version $archdate\n";
! 155: my $archcmd = $archprog;
! 156: $archcmd .= " archive -archsymlinkasfile=no -subdir=yes";
! 157: $archcmd .= " -description='$archname'";
! 158: $archcmd .= " '$docdir/'";
! 159:
! 160: print LOG "CMD: $archcmd\n";
! 161: if (open ARCH, "$archcmd 2>&1 |") {
! 162: while (<ARCH>) {
! 163: chomp;
! 164: print LOG "ARCH: $_\n";
! 165: if (/Normal File-->\s+[\d,]+\s+(.*)\s+\[Sent\]/) {
! 166: print " ARCH: file '$1'\n";
! 167: $files{$1} = "ok";
! 168: }
! 169: if (/^Archive processing of .* finished without failure./) {
! 170: print " ARCH: OK\n";
! 171: }
! 172: }
! 173: } else {
! 174: print "ABORT: unable to start archive command '$archcmd'!!\n";
! 175: exit 1;
! 176: }
! 177:
! 178: return \%files;
! 179: }
! 180:
! 181:
! 182: #
! 183: # check_files(\%files_to_archive, \%archived_files)
! 184: #
! 185: # compares the list of archived and to be archived files
! 186: #
! 187: sub check_files {
! 188: my ($to_archive, $archived) = @_;
! 189:
! 190: my $nt = scalar keys %$to_archive;
! 191: my $na = scalar keys %$archived;
! 192:
! 193: foreach my $ft (sort keys %$to_archive) {
! 194: my $fp = "$docdir/$ft";
! 195: #print " fp: $fp\n";
! 196: if ($$archived{$fp}) {
! 197: print "DEBUG: $ft archived OK\n";
! 198: $$archived{$fp} = "OK";
! 199: } else {
! 200: print "ERROR: file '$ft' missing from archive!\n";
! 201: $errcnt++;
! 202: }
! 203: }
! 204:
! 205: foreach my $fa (sort keys %$archived) {
! 206: if ($$archived{$fa} ne "OK") {
! 207: my ($fn, $fp) = MPIWGStor::split_file_path($fa);
! 208: if ($MPIWGStor::index_files{$fn}) {
! 209: print "DEBUG: $fa ignored\n";
! 210: $na--;
! 211: } else {
! 212: print "WARNING: $fa archived but not in list!\n";
! 213: $warncnt++;
! 214: }
! 215: }
! 216: }
! 217:
! 218: if ($nt > $na) {
! 219: print "WARNING: less files were archived ($na vs. $nt)!\n";
! 220: } elsif ($na > $nt) {
! 221: print "WARNING: more files were archived ($na vs. $nt)!\n";
! 222: }
! 223:
! 224: }
! 225:
! 226:
! 227: #
! 228: # delete_files(\%files)
! 229: #
! 230: # deletes the files from the list (of absolute files) and their directories
! 231: # if they are empty
! 232: #
! 233: sub delete_files {
! 234: my ($files) = @_;
! 235: my %dirs;
! 236:
! 237: foreach my $f (sort keys %$files) {
! 238: my ($fn, $fp) = MPIWGStor::split_file_path($f);
! 239: # collect all unique directories
! 240: if ($fp && (! $dirs{$fp})) {
! 241: $dirs{$fp} = $fp;
! 242: }
! 243: # don't delete index files
! 244: next if ($MPIWGStor::index_files{$fn});
! 245: # no file no delete
! 246: next unless (-f $f);
! 247: # delete files
! 248: if (unlink $f) {
! 249: print "INFO: remove $f ($fn)\n";
! 250: } else {
! 251: print "ERROR: unable to delete $f!\n";
! 252: $errcnt++;
! 253: }
! 254: }
! 255: # try to delete all empty directories
! 256: my @dirkeys = sort keys %dirs;
! 257: # starting at the end to get to the subdirectories first
! 258: for (my $i = $#dirkeys; $i >= 0; $i--) {
! 259: my $d = $dirkeys[$i];
! 260: # dont't remove document dir (shouldn't be empty anyway)
! 261: next if ($d eq $docdir);
! 262: if (-d $d) {
! 263: print "INFO: remove dir $d\n";
! 264: rmdir $d;
! 265: }
! 266: }
! 267: }
! 268:
! 269:
! 270: #
! 271: # delete_all_files(\%files, $dir)
! 272: #
! 273: # deletes all files with names from the list %files
! 274: # in the directory $dir and its subdirectories
! 275: #
! 276: sub delete_all_files {
! 277: my ($files, $dir) = @_;
! 278:
! 279: if (! opendir DIR, $dir) {
! 280: print "ERROR: unable to read directory $dir!\n";
! 281: $errcnt++;
! 282: return;
! 283: }
! 284: my @fl = readdir DIR;
! 285: closedir DIR;
! 286:
! 287: foreach my $f (@fl) {
! 288: next if ($f =~ /^\.{1,2}$/);
! 289: if ($$files{$f}) {
! 290: # $f is in the file list
! 291: if (-f "$dir/$f") {
! 292: # $f is a file
! 293: if (unlink "$dir/$f") {
! 294: print "INFO: removed $f\n";
! 295: } else {
! 296: print "ERROR: unable to delete $f!\n";
! 297: $errcnt++;
! 298: }
! 299: } elsif (-d _) {
! 300: # $f is a directory (unlink won't work)
! 301: if ((system 'rm', '-r', "$dir/$f") == 0) {
! 302: print "INFO: removed directory $f\n";
! 303: } else {
! 304: print "ERROR: unable to delete directory $f!\n";
! 305: $errcnt++;
! 306: }
! 307: } else {
! 308: print "ERROR: funny object $dir/$f!\n";
! 309: $errcnt++;
! 310: }
! 311: } else {
! 312: # $f is not in the list
! 313: if (-d "$dir/$f") {
! 314: # recurse into directories
! 315: print "DEBUG: enter $dir/$f\n";
! 316: delete_all_files($files, "$dir/$f");
! 317: }
! 318: }
! 319: }
! 320: }
! 321:
! 322:
! 323: #######################################################
! 324: # main
! 325: #
! 326:
! 327: print "START: archiver $version at $archdate\n";
! 328:
! 329: # make shure the right user is running this program
! 330: my $user = getlogin;
! 331: #if (($user ne "archive")||($user ne "root")) {
! 332: # logger("ABORT", "you ($user) must be archive or root user to run this program!");
! 333: # exit 1;
! 334: #}
! 335:
! 336: # use metacheck first
! 337: if (system("$checkprog $docdir >/dev/null") == 0) {
! 338: print "INFO: resource '$docdir' check OK\n";
! 339: } else {
! 340: print "ABORT: resource '$docdir' check failed!!\n";
! 341: exit 1;
! 342: }
! 343:
! 344: # read index.meta file
! 345: my ($document, $rootnode) = MPIWGStor::read_xml($metafile);
! 346:
! 347: # check file and add archive date
! 348: my $files_to_archive = read_resource_meta($rootnode);
! 349:
! 350: print "INFO: ", scalar keys %$files_to_archive, " files to archive\n";
! 351:
! 352: # check for .archived file
! 353: if (-f "$docdir/.archived") {
! 354: if (unlink "$docdir/.archived") {
! 355: print "WARNING: existing .archived file has been removed! Resource already archived?\n";
! 356: $warncnt++;
! 357: } else {
! 358: print "ERROR: unable to remove existing .archived file!\n";
! 359: $errcnt++;
! 360: }
! 361: }
! 362:
! 363: # remove junk files
! 364: if ($delete_junk_files) {
! 365: delete_all_files(\%MPIWGStor::junk_files, $docdir);
! 366: }
! 367:
! 368: # write new index.meta
! 369: if ($errcnt > 0) {
! 370: print "ABORT: there were errors!\n";
! 371: exit 1;
! 372: } else {
! 373: if ($fix_xml) {
! 374: MPIWGStor::write_xml($document, $metafile);
! 375: }
! 376: }
! 377:
! 378: # start archiving
! 379: my $archived_files = run_archive;
! 380:
! 381: print "INFO: ", scalar keys %$archived_files, " files archived\n";
! 382:
! 383: # check list of archived files
! 384: check_files($files_to_archive, $archived_files);
! 385:
! 386: # delete files if all went OK
! 387: if ($errcnt == 0) {
! 388: system("touch", "$docdir/.archived");
! 389: # remove junk files (again)
! 390: if ($delete_junk_files) {
! 391: delete_all_files(\%MPIWGStor::junk_files, $docdir);
! 392: }
! 393: # remove archived files
! 394: if ($delete_data_files) {
! 395: delete_files($archived_files);
! 396: }
! 397: }
! 398:
! 399: print "INFO: $warncnt warnings\n";
! 400: print "INFO: $errcnt errors\n";
! 401: my $num_archfiles = %$archived_files + 1;
! 402: if ($errcnt > 0) {
! 403: print "ABORT: there were errors! ($num_archfiles files archived) at ", stime(time), "\n";
! 404: exit 1;
! 405: } else {
! 406: print "DONE: $num_archfiles files archived at ", stime(time), "\n";
! 407: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvs/cvsweb/icons/back.gif){kind=icon}
Return to archiver.pl CVS log ![[TXT]](/cvs/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvs/cvsweb/icons/dir.gif){kind=icon}
Up to [Repository] / foxridge-archiver