freeswan/testing/utils/regress-cleanup.pl

   1 #!/usr/bin/perl
   2
   3 # This script is used to clean up the /btmp dir of previous nights runs.
   4 # It expects the following things to be in the environment:
   5 #
   6 #    $BTMP
   7 #    $USER
   8 #    $BRANCH
   9 #    $TODAY
  10
  11 if(!defined($ENV{'BTMP'})   || length($ENV{'BTMP'})==0 ||
  12    !defined($ENV{'USER'})   || length($ENV{'USER'})==0 ||
  13    !defined($ENV{'BRANCH'}) || length($ENV{'BRANCH'})==0 ||
  14    !defined($ENV{'TODAY'})  || length($ENV{'TODAY'})==0 )
  15   {
  16     print STDERR "You must define \$BTMP, \$USER, \$BRANCH and \$TODAY for the cleanup to function.";
  17     print STDERR "Values are: BTMP=\"".$ENV{'BTMP'}."\"\n";
  18     print STDERR "\tUSER=\"".$ENV{'USER'}."\"\n";
  19     print STDERR "\tBRANCH=\"".$ENV{'BRANCH'}."\"\n";
  20     print STDERR "\tTODAY=\"".$ENV{'TODAY'}."\"\n";
  21     die "Thank you.";
  22   }
  23
  24 $BTMP=$ENV{'BTMP'};
  25 $USER=$ENV{'USER'};
  26 $BRANCH=$ENV{'BRANCH'};
  27 $TODAY=$ENV{'TODAY'};
  28
  29 $cleandir="$BTMP/$USER/$BRANCH";
  30
  31 # by default we'd like to have 700Mb to play with. UMLs take lots of space, alas.
  32 $desiredspace=700*1024*1024;
  33
  34 # but, if there is a file in $cleandir called "free", then we take that as
  35 # being the amount to keep free. It would make more sense to put a maximum
  36 # usage instead, but that requires that we walk the file system multiple times.
  37
  38 if(-f "$cleandir/free") {
  39   $success = open(FREE, "$cleandir/free");
  40   if($success) {
  41     chop($desiredspace=<FREE>);
  42     close(FREE);
  43   } else {
  44     warn "Can not open $cleandir/free: $!\n";
  45   }
  46 }
  47
  48 sub getdiskspace {
  49 # bash-2.05$ df -P /btmp
  50 # Filesystem         1024-blocks      Used Available Capacity Mounted on
  51 # /dev/hda7             33855264   2954140  29181368      10% /abigail
  52 #
  53
  54   open(DF, "df -P $cleandir |") || die "Can not invoke df: $!\n";
  55   $header=<DF>;
  56   $_=<DF>;
  57   ($filesystem, $blocks, $used, $avail, $percent, $mount)=split;
  58   return $avail*1024;
  59 }
  60
  61 sub cmpdir {
  62   # $a and $b contain things to compare.
  63
  64   local($ay,$am,$ad) = split(/_/, $a, 3);
  65   local($by,$bm,$bd) = split(/_/, $b, 3);
  66
  67   if($ay != $by) {
  68     return $ay <=> $by;
  69   } elsif ($am != $bm) {
  70     return $am <=> $bm;
  71   } elsif ($ad != $bm) {
  72     return $ad <=> $bd;
  73   } else {
  74     return 0;
  75   }
  76 }
  77
  78 chdir($cleandir) || die "Can not chdir to $cleandir\n";
  79
  80 opendir(TOPDIR, $cleandir) || die "can not opendir($cleandir): $!\n";
  81 @dirs=readdir(TOPDIR);
  82 closedir(TOPDIR);
  83
  84 # filter it looking for date format dirs, excepting $TODAY.
  85 @candidatedirs=();
  86 for $dir (@dirs) {
  87   if($dir =~ m,\d\d\d\d_\d\d_\d\d, &&
  88      $dir != $TODAY) {
  89     push(@candidatedirs, $dir);
  90   }
  91 }
  92
  93 @candiatedirs = sort cmpdir @candidatedirs;
  94
  95 while($#candiatedirs > 0 &&
  96       &getdiskspace < $desiredspace) {
  97
  98   $dir=unpush(@candiatedirs);
  99
 100
 101   print "Removing $dir\n";
 102   #system("rm -rf $dir");
 103 }
 104
 105 if(&getdiskspace < $desiredspace) {
 106   print STDERR "Failed to free enough disk space";
 107   exit 1;
 108 }
 109
 110 exit 0;
 111
 112 # $Id: regress-cleanup.pl,v 1.2 2002/01/11 20:43:02 mcr Exp $
 113 #
 114 # $Log: regress-cleanup.pl,v $
 115 # Revision 1.2  2002/01/11 20:43:02  mcr
 116 #       perl uses "elsif" - if was missing completely.
 117 #
 118 # Revision 1.1  2002/01/11 04:26:48  mcr
 119 #       revision 1 of nightly regress scripts.
 120 #
 121 #