scripts/archival/shared_snarfer.pl

   1 #!/usr/bin/perl
   2
   3 ###############################################################################
   4 #                                                                             #
   5 #  Name   : shared_snarfer                                                    #
   6 #  Author : Chris Koeritz                                                     #
   7 #  Rights : Copyright (C) 1996-$now by Author                                 #
   8 #                                                                             #
   9 #  Purpose:                                                                   #
  10 #                                                                             #
  11 #    A shared library collection for "snarfing up" archives.  This uses the   #
  12 #  compressed tar format for files ending in ".snarf" to store collections    #
  13 #  of files, folders, hierarchies and so forth.                               #
  14 #                                                                             #
  15 ###############################################################################
  16 #  This program is free software; you can redistribute it and/or modify it    #
  17 #  under the terms of the GNU General Public License as published by the Free #
  18 #  Software Foundation; either version 2 of the License or (at your option)   #
  19 #  any later version.  See: "http://www.gruntose.com/Info/GNU/GPL.html" for a #
  20 #  version of the License.  Please send any updates to "fred@gruntose.com".   #
  21 ###############################################################################
  22
  23 require "filename_helper.pl";
  24 require "inc_num.pl";
  25
  26 use Cwd;
  27 use Sys::Hostname;
  28 use File::Which;
  29 use Env qw(FEISTY_MEOW_SCRIPTS TMP);
  30
  31 $null_log = "/dev/null";
  32
  33 $TMP =~ s/\\/\//g;  # fix the temp variable for ms-winders.
  34
  35 # defines an array of problematic entries we were told to deal with.
  36 @missing_log = ();
  37
  38 # these files are considered unimportant and won't be included in the archive.
  39 @junk_file_list = ("*~", "*.$$$", "*.aps", "*.bak", "binaries",
  40     "*.bsc", "*.cgl", "*.csm", "CVS", "Debug", "*.dll", "*.err", "*.exe",
  41     "generated_*", "*.git", "*.glb", "inprogress", "ipch", "*.llm",
  42     "*.log", "*.lnk",
  43     "makefile.fw*", "*.mbt", "*.mrt", "*.ncb", "*.o", "obj", "*.obj",
  44     "octalforty.Wizardby", "*.obr", "*.opt", "packages",
  45     "*.pch", "*.pdb", "*.plg", "*.r$p", "*.rcs", "Release",
  46     "*.res", "*.RES", "*.rws", "*.sbr", "*.scc", "*.spx", "*.stackdump",
  47     "Steam",
  48     "*.sdf", "*.suo", ".svn", "*.sym", "*.td", "*.tds", "*.tdw", "*.tlb",
  49     "*.trw", "*.tmp", "*.tr", "*.user", "*_version.h", "*_version.rc",
  50     "*.vspscc", "waste", "zeitgeist");
  51 #print "junk list=@junk_file_list\n";
  52 @excludes = ();
  53 for (local($i) = 0; $i < scalar(@junk_file_list); $i++) {
  54   push(@excludes, "--exclude=$junk_file_list[$i]");
  55 }
  56 #print "excludes list=@excludes\n";
  57
  58 # generic versions work on sane OSes.
  59 $find_tool = which('find');
  60 # for mac, try to match gnu tar first.
  61 $tar_tool = which('gtar');
  62 if ( ! -f "$tar_tool" ) {
  63   # fall back to regular tar.
  64   $tar_tool = which('tar');
  65 }
  66 #print "find tool: $find_tool\n";
  67 #print "tar tool: $tar_tool\n";
  68
  69 if ( ! -f "$find_tool" || ! -f "$tar_tool" ) {
  70   print "Could not locate either tar or find tools for this platform.\n";
  71   exit 3;
  72 }
  73
  74 # this is somewhat ugly, but it sets up a global variable called
  75 # "original_path" so we remember where we started.
  76 sub initialize_snarfer {
  77   $original_path = cwd();
  78   $original_path =~ s/\\/\//g;
  79 }
  80
  81 # returns the current hostname, but without any domain included.
  82 sub short_hostname {
  83   local($temphost) = hostname();
  84 #&hostname();
  85   $temphost =~ s/([^.]*)\..*/\1/;
  86   return &lower($temphost);
  87 }
  88
  89 # takes the base name and creates the full snarf prefix name, which includes
  90 # a timestamp and hostname.
  91 sub snarf_prefix {
  92   local($base) = @_;
  93
  94 #hmmm: extract this shared code to new function (also in safedel)
  95   $date_tool = "date";
  96   local($date_part) = `$date_tool +%Y-%m-%d-%H%M`;
  97   while ($date_part =~ /[\r\n]$/) { chop $date_part; }
  98
  99   local($host) = &short_hostname();
 100   while ($host =~ /[\r\n]$/) { chop $host; }
 101   $base = $base . "_" . $host . "_" . $date_part;
 102   return $base;
 103 }
 104
 105 # returns the name of the file to create based on the prefix and the
 106 # current archive number.
 107 sub snarf_name {
 108   local($prefix, $number) = @_;
 109   local($path) = &canonicalize($original_path);
 110   local($target_file) = $path . '/' . $prefix . "_" . $number . ".tar";
 111   return $target_file;
 112 }
 113
 114 # finishes up on the archive file.
 115 sub finalize_snarf {
 116   local($filename) = @_;
 117 #print "finalizing now on filename $filename\n";
 118   local($outcome) = 0xff & system "gzip", $filename;
 119   if ($outcome) { die("failure to finalize"); }
 120
 121   if (scalar(@missing_log)) {
 122     print "The following files or directories were missing:\n";
 123     print "@missing_log\n";
 124   }
 125 }
 126
 127 # fixes the directory passed in, if required.  this is only needed for
 128 # dos-like operating systems, where there are drives to worry about and where
 129 # cygwin refuses to store the full path for an absolute pathname in the
 130 # archive.  instead of letting it store partial paths, we change to the top
 131 # of the drive and scoop up the files using a relative path.
 132 sub chdir_to_top {
 133   local($directory) = @_;
 134   if ( (substr($directory, 0, 2) eq "//")
 135       && (substr($directory, 3, 1) eq "/") ) {
 136 #print "into special case\n";
 137     # it was originally a dos path, so now we must do some directory changing
 138     # magic to get the paths to work right.
 139     local($drive) = substr($directory, 0, 4);  # get just drive letter biz.
 140 #print "going to change to $drive\n";
 141     chdir($drive);
 142 #print "cwd now=" . cwd() . "\n";
 143     $directory = substr($directory, 4);  # rip off absolutist path.
 144 #print "using dir now as $directory\n";
 145     if (length($directory) == 0) {
 146 #print "caught zero length dir, patching to dot now.\n";
 147       $directory = ".";
 148     }
 149   }
 150   return $directory;
 151 }
 152
 153 # snarfer scoops up some files in a directory.
 154 sub snarfer {
 155   local($prefix, $number, $root, $subdir, @extra_flags) = @_;
 156 #print "prefix=$prefix, num=$number, root=$root, subdir=$subdir, extra=@extra_flags\n";
 157
 158   $root = &chdir_to_top($root);
 159
 160   local($target_file) = &snarf_name($prefix, $number);
 161
 162   $random_num = (rand() * 1000000) % 1000000;
 163   $temp_file = `mktemp "$TMP/zz_snarf_tmp.XXXXXX"`;
 164   chop($temp_file);
 165
 166   if (! -d $root . "/" . $subdir) {
 167     local($base) = &basename($root . "/" . $subdir);
 168 #print "adding to missing in snarfer A: $base\n";
 169     push(@missing_log, $base);
 170     return 0;
 171   }
 172   local($currdir) = cwd();
 173   chdir($root);
 174
 175   local($outcome) = 0;
 176   my @lines = qx( $find_tool "$subdir" @extra_flags "-follow" "-type" "f" );
 177 #  if ( ($! != 0) || ($? != 0) ) {
 178 #    die("failure to find files in $subdir");
 179 #  }
 180
 181   open TEMPY_OUT, ">>$temp_file" or die "cannot open $temp_file";
 182   foreach (@lines) { print TEMPY_OUT "$_"; }
 183   close TEMPY_OUT;
 184
 185   if (-s $temp_file == 0) {
 186     local($base) = &basename($root . "/" . $subdir);
 187 #print "adding to missing in snarfer B: $base\n";
 188     push(@missing_log, $base);
 189   }
 190
 191   local($outcome) = 0xff & system $tar_tool,
 192 #hmmm: trying to dereference symbolic links and stop missing stuff.
 193 "-h",
 194       "-rf", &canonicalize($target_file), @excludes,
 195       "--files-from=" . &canonicalize($temp_file);
 196   if ($outcome) {
 197     unlink($temp_file);
 198     die("failure to archive");
 199   }
 200   # clean up temporaries.
 201   unlink($temp_file);
 202   # change back to previous directory.
 203   chdir($currdir);
 204 }
 205
 206 # snarf_file_list is like snarfer but expects a file pattern at the end rather
 207 # than a directory name.
 208 sub snarf_file_list {
 209   local($prefix, $number, $root, $file_pattern, @extra_flags) = @_;
 210
 211 #print "prefix=$prefix, num=$number, root=$root, file_pattern=$file_pattern, extra=@extra_flags\n";
 212
 213   $root = &chdir_to_top($root);
 214
 215   local($target_file) = &snarf_name($prefix, $number);
 216
 217   local($currdir) = cwd();
 218 #print "got root as: '$root'\n";
 219   chdir("$root");
 220
 221   local(@files) = &glob_list($file_pattern);
 222   if (!scalar(@files)) {
 223     local($base) = $root . "/" . $file_pattern;
 224     $base =~ s/\/\//\//g;
 225 #print "adding to missing in snarf_file_list: $base\n";
 226     push(@missing_log, $base);
 227   }
 228
 229   foreach $i (@files) {
 230     if ($i =~ /^\.\//) {
 231       $i = substr $i, 2, length($i) - 2;
 232     }
 233     local($outcome) = 0xff & system $tar_tool,
 234 #"--directory=" . "$root",
 235
 236 #hmmm: trying to dereference symbolic links and stop missing stuff.
 237 "-h",
 238         @extra_flags,
 239 "-rf", &canonicalize($target_file), @excludes, $i;
 240     if ($outcome) { die("failure to archive"); }
 241   }
 242   chdir("$currdir");
 243 }
 244
 245 # backup some specific files.
 246 sub backup_files {
 247   local($prefix, $number, $root, $subdir, @files) = @_;
 248 #print "backup_files: ref=$prefix, num=$number, subdir=$subdir, list of files=@files\n";
 249   foreach $i (@files) {
 250     local($new_path) = $subdir . "/" . $i;
 251     if ($subdir eq ".") { $new_path = "$i"; }
 252     &snarf_file_list($prefix, $number, $root, $new_path);
 253   }
 254 }
 255
 256 # backup some specific directories.
 257 sub backup_directories {
 258   local($prefix, $number, $root, $subdir, @dirs) = @_;
 259 #print "backup_directories: ref=$prefix, num=$number, root=$root, subdir=$subdir, list of dirs=@dirs.\n";
 260   foreach $i (@dirs) {
 261     local($path_to_use) = $subdir . "/" . $i;
 262     if ($i eq ".") {
 263       $path_to_use = $subdir;
 264     }
 265     &snarfer($prefix, $number, $root, $path_to_use, ("-maxdepth", "1"));
 266   }
 267 }
 268
 269 # removes items from the file that match a pattern.
 270 sub remove_from_backup {
 271   local($prefix, $number, $pattern) = @_;
 272 #print "remove_from_backup: pref=$prefix, num=$number, patt=$pattern,\n";
 273   local($target_file) = &snarf_name($prefix, $number);
 274
 275   open(TARPROC, "$tar_tool --delete -f " . &canonicalize($target_file)
 276       . " \"$pattern\" 2>$null_log |");
 277   <TARPROC>;
 278 }
 279
 280 # recursively scoops up a directory hierarchy.
 281 sub backup_hierarchy {
 282   local($prefix, $number, $root, $filepart) = @_;
 283 #print "backup_hierarchy: pref=$prefix, num=$number, root=$root, filepart=$filepart\n";
 284   local(@locus_temp) = &glob_list($root);
 285   local($save_root) = $root;
 286   local($root) = $locus_temp[0];
 287   if (!length($root)) {
 288     local($base) = $save_root . "/" . $filepart;
 289 #print "adding to missing in backup_hierarchy A: $base\n";
 290     push(@missing_log, $base);
 291     return;
 292   }
 293   local($new_pattern) = "$root/$filepart";
 294   if ($root =~ /\/$/) { $new_pattern = "$root$filepart"; }
 295   local(@mod_locus) = &glob_list($new_pattern);
 296   if (!scalar(@mod_locus)) {
 297     local($base) = &basename($root . "/" . $filepart);
 298 #print "adding to missing in backup_hierarchy B: $base\n";
 299     push(@missing_log, $base);
 300   } else {
 301     foreach $i (@mod_locus) {
 302       local($new_locus) = $root;
 303       local $offset_len = length($root) + 1;
 304       local $char_len = length($i) - length($root) - 1;
 305       # make sure we don't double slashes up if one's already there.
 306       if ($root =~ /\/$/) { $offset_len--; $char_len++; }
 307       local($extra_portion) = substr $i, $offset_len, $char_len;
 308       if (!length($extra_portion)) {
 309         # well, in this case, there's nothing left of the extra part after
 310         # the root.  we'll push the last component of the root down into
 311         # the extra part so there's actually something to traverse.
 312         $new_locus = &dirname($root);
 313         $extra_portion = &basename($root);
 314       }
 315       &snarfer($prefix, $number, $new_locus, $extra_portion, ());
 316     }
 317   }
 318 }
 319
 320 # recursively scoop up a list of directory hierarchies.
 321 sub backup_hierarchies {
 322   local($prefix, $number, $root, @dirs) = @_;
 323 #  print "backup_hierarchy: pref=$prefix, num=$number, root=$root,\n";
 324 #  print "list of dirs=@dirs.\n";
 325   foreach $i (@dirs) {
 326     &backup_hierarchy($prefix, $number, $root, $i);
 327   }
 328 }
 329
 330 # grab up all the files in a directory (second parm) that are named matching
 331 # a simple text pattern (third parm).  if there is a fourth parameter, it is
 332 # used as an extra directory component after the main directory.
 333 sub snarf_by_pattern {
 334   local($prefix, $dir, $pattern, $extra_component) = @_;
 335   local($had_extra) = length($extra_component) != 0;
 336 #print "snarf by pattern, dir = $dir, patt = $pattern, extra = $extra_component\n";
 337   if ($had_extra) {
 338     $dir = "$dir/$extra_component";
 339   }
 340   @dir_contents = &glob_list("$dir/*$pattern*");
 341 #print "dir contents: @dir_contents\n";
 342
 343   if (!scalar(@dir_contents)) {
 344     print "no '$pattern' directores were backed up in $dir.\n";
 345   }
 346
 347   foreach $item (@dir_contents) {
 348     if ( ($item =~ /$pattern.*snarf/) || ($item =~ /$pattern.*tar/) ) { next; }
 349     if ( ! -d "$item" ) { next; }
 350 #print "now really planning to backup hier of $item\n";
 351     # normal backup had no extra component.
 352     local $upper_dir = &dirname($item);
 353     local $dir_plus_base = &basename($item);
 354     # if we did have an extra component, we do this a bit differently.
 355     if ($had_extra) {
 356       $upper_dir = &dirname( &dirname($item) );
 357       $dir_plus_base = &basename( &dirname($item) ) . "/" . &basename($item);
 358     }
 359 #print "using upper=$upper_dir and dir+base=$dir_plus_base\n";
 360     &backup_hierarchy($prefix, $number, $upper_dir, $dir_plus_base);
 361   }
 362 }
 363
 364 # gets the number out of the file specified by a basename.  the number file
 365 # is assumed to be stored in the TMP directory and to have an extension of
 366 # ".num".
 367 sub retrieve_number {
 368   local($number_prefix) = @_;
 369   # get number from the file specified and increment it for the next use.
 370   local($NUMBER_FILE) = $TMP."/$number_prefix.num";
 371   local($number) = &get_number($NUMBER_FILE);
 372   &next_number($NUMBER_FILE);
 373   return $number;
 374 }
 375
 376 # takes a name to use as the basename for a number file, and stores the
 377 # file into the archive specified.
 378 sub backup_number {
 379   local($number_prefix, $snarf_prefix, $number) = @_;
 380 #print "backup_number: parms are: numpref=$number_prefix, archpref=$snarf_prefix, num=$number.\n";
 381   local($target_file) = $original_path ."/". $snarf_prefix . "_" . $number . ".tar";
 382   local($number_file) = $number_prefix . ".num";
 383
 384   local($currdir) = cwd();
 385   chdir($TMP);
 386
 387   local($outcome) = 0xff & system $tar_tool, "-cf",
 388       &canonicalize($target_file), &canonicalize($number_file);
 389   if ($outcome) { die("failure to archive"); }
 390
 391   local($prefix_file) = "prefix.bac";
 392   open(NUM_PREFIX, ">" . $prefix_file);
 393   print NUM_PREFIX $number_prefix;
 394   close(NUM_PREFIX);
 395
 396   $outcome = 0xff & system $tar_tool,
 397
 398 #hmmm: trying to dereference symbolic links and stop missing stuff.
 399 "-h",
 400
 401 "-rf",
 402       &canonicalize($target_file), &canonicalize($prefix_file);
 403   if ($outcome) { die("failure to archive"); }
 404   unlink($prefix_file);
 405   chdir($currdir);
 406 }
 407
 408 # takes a prefix for the number file and a filename where it can be found.
 409 # the current number in the temporary directory is compared against the file,
 410 # and the new number's used if it's greater.
 411 sub restore_number {
 412   local($number_prefix, $number_file) = @_;
 413 #print "restore num has numpref $number_prefix and numfile $number_file\n";
 414   local($comparison_file) = "$TMP" . "/" . $number_prefix . ".num";
 415   local($number) = &get_number($number_file);
 416   local($old_number) = &get_number($comparison_file);
 417   if ($number > $old_number) {
 418     &store_number($number, $comparison_file);
 419   }
 420   unlink($number_file);
 421 }
 422
 423 # ensures that the special restoration program is used on the archives by
 424 # renaming their extension.
 425 sub rename_archive {
 426   local($filename) = @_;
 427 #print "rename_archive: file=$filename\n";
 428   &finalize_snarf($filename);
 429   local(@pieces) = split(/\.[^.]*$/, $filename, 3);
 430   local($just_dir_and_base) = $pieces[0];
 431   local($new_name) = $just_dir_and_base . '.snarf';
 432   rename($filename . ".gz", $new_name)
 433       || die("could not rename $filename to $new_name.");
 434 }
 435
 436 # undoes a snarfed up archive and pulls out the number.
 437 sub restore_archive {
 438   local($filename) = &canonicalize(&remove_trailing_slashes(@_));
 439   local(@split_name) = &split_filename($filename);
 440   if ($#split_name < 1) {
 441     print "The name \"$filename\" could not be parsed for restoration.\n";
 442     exit 1;
 443   }
 444   # get the basename of the file.
 445   local(@pieces) = split(/\.[^.]*$/, @split_name[1], 2);
 446   # we don't want the extension.
 447   local($just_dir_and_base) = $split_name[0] . $pieces[0];
 448   # now just get the basename without a directory.
 449   local(@name_components) = split(/\//, $just_dir_and_base);
 450   local($basename) = $name_components[$#name_components];
 451   local($new_dir_name) = 'snarf_' . $basename;
 452
 453   local($currdir) = cwd();
 454
 455   if (!chdir($new_dir_name)) {
 456     mkdir($new_dir_name, 0777)
 457         || die("could not create directory $new_dir_name.");
 458     if (!chdir($new_dir_name)) {
 459       die("could not change to directory $new_dir_name.");
 460     }
 461   }
 462
 463   # patch a relative path name to reflect the fact that we're now underneath
 464   # the directory where we were.
 465   if (! ($filename =~ /^\//)
 466       && ! ($filename =~ /^.:/) ) {
 467     $filename = "../" . $filename;
 468   }
 469
 470   local($outcome) = 0xff & system $tar_tool, "-xzf",
 471       &canonicalize($filename);
 472   if ($outcome) { die("failure to undo archive"); }
 473
 474   local($outcome) =
 475       0xff & system "bash", "$FEISTY_MEOW_SCRIPTS/security/normal_perm.sh", ".";
 476   if ($outcome) { die("failure to normalize permissions"); }
 477
 478   # remove any links that might have crept in; these can cause mischief.
 479   local($outcome) = 0xff & system("$find_tool . -type l -exec rm {} ';'");
 480
 481   # read the name of the prefix file.
 482   local($prefix_file) = "prefix.bac";
 483   open(NUM_PREFIX, "<" . $prefix_file);
 484   local($number_prefix) = <NUM_PREFIX>;
 485   close(NUM_PREFIX);
 486
 487   &restore_number($number_prefix, $number_prefix . ".num");
 488   unlink($prefix_file);
 489
 490   chdir($currdir);
 491 }
 492
 493 1;
 494