#!/usr/local/bin/perl
#
#   $Id: mps_MigrPurg,v 1.10 2005/09/08 22:04:57 abh Exp $
#
# ooss_MigrPurg
#	-M			do migrate function
#	-O			one time only flag for purge
#	-P			do purge function
#	-b basedir		base directory for local filesystem
#       -c cfgfile              configuration file path
#	-d dir_list		list of local directories to search
#	-e cachefs_list		list of cache filesystem for purge
#				   The list can take one of three forms
#				   which determines purge policy
#				   1) fs		use global default
#				   2) fs,absval		use absolute value
#				   3) fs,lopct,hipct,minpct  use percentage
#	-F absfree		absolute free space target for purge
#	-f prty_filename	filename for priority migr/purge
#	-h mssdir		base directory for mass storage system filesystem
#	-i			ignore "stop" files
#	-k keep_num		number of files to keep from being purged
#	-L resource		resource name for global reservation system
#	-l log_filename		filename for log file
#	-m migrate_threshold	threshold in seconds for migrating a file
#	-p purge_threshold	threshold in seconds for purging a file
#	-t lowpct,hipct,minpct	% free space thresholds for purge routine
#	-u lowpct,hipct,minpct	% used space thresholds for purge routine
#	-w wait_time		sleep interval in seconds between checks
#	-x debug_level		message logging control 
#
# Signals:
#
#	The main wait loop can be interrupted via a SIGUSR1 to cause
#	a new migrate/purge cycle to be started.
#
#	A SIGCONT can be used to cause the configuration file to be reprocessed
#	which provides a way for dynamically changing parameters.
#
#	(c) 1998, Stanford University/SLAC, William Weeks

$|=1;

require 'getopts.pl';		# option parsing
use POSIX "sys_wait_h";
use Fcntl;

$isMPS = substr(($0 =~ m|([^/]*)$|)[0],0,4) eq 'mps_' ;
$SSD = ($isMPS ? 'mps' : 'ooss');
$XFR = ($isMPS ? 'xfr' : 'pftp');

# a) We always include the two default locations for 'use' statements.
# b) If the current working directory is not the location of the program,
#    we add the path to the program (as intuited by the execution path)
#    to @INC. The eval() defers this until run-time.
# c) Finally, we defer all use statements to run-time which is when we
#    have properly established @INC. Again, eval is used for the deferral.
#
use lib '/opt/xrootd/utils';
use lib '/usr/etc/ooss';
($ppath) = $0 =~ m:^(\S*)/\S*$:;
if ($ppath) {eval 'use lib $ppath;';}
eval 'use XrdOlbNotify'; die "'use XrdOlbNotify' failed: $@\n" if ($@);
eval 'use ooss_MonP'; die "'use ooss_MonP' failed: $@\n" if ($@); 

# default values for command options
$absfree = 0;				# (-F) default free byte target is disabled
$basedir = ($isMPS ? '/store'
                   : '/objy/databases'); # (-b) default base local directory
$cfgfn =   ($isMPS ? '/opt/xrootd/etc/xrootd.cf'
                   : '/usr/etc/ooss/ooss_mps.cf'); # (-r) default configuration file
$cos = 1;				# (-c) default class of service
$debug = 0;				# (-x) default debug level
$hipct = 20;				# (-t) default purge pct high threshold
$keepnum = 0;				# (-k) default number of files to keep
$lopct = 10;				# (-t) default purge pct low threshold
$migrate_time = 20*60;			# (-m) default migrate time = 20 minutes
$minpct = 0;				# (-t) default minimum purge pct to allow stageins
$mssdir  = ($isMPS ? '/store'
                   : '/objy/databases'); # (-h) default base mss directory
$prtyfn = "/var/adm/$SSD/migrpurg";	# (-f) default file for priority migrations
$purge_time = 20*3600;			# (-p) default purge time = 20 hours
@ufsdirs = ();				# (-d) default directory to scan
$waittime = 600;			# (-w) default wait interval

# Site dependent global variables
$adminuser = ($isMPS ? 'sys-mps' : 'sys-hpss');		# user to receive mail about errors
$copychar = ':';                        # character to append for dual copy
$copycos = 4;                           # default cos for dual copy
@copydirs = ();                         # directories for dual copy
$errlogfn = "/var/adm/$SSD/logerr";	# default file for error logging
$errlogintvl = 3600;			# default interval in seconds for sending E-mail
$hidden = 0;				# default do not use dot files for control files
$keyfn = ($isMPS ? '/var/adm/mps/xfrcmd/keyfile'
                 : '/var/adm/ooss/pftp/keyfile'); # location of keyword for $pftpuser
$dirlock = 'DIR_LOCK';			# directory lock file
$mailcmd = (-x '/usr/ucb/mail' ? '/usr/ucb/mail'
                               : '/bin/mail');		# default mail command
$max_migr_proc = 2;			# default max number of concurrent migrations
$migrctrsfn = '';                       # 
$min_tran_rate = 2*1024*1024;		# default minimum data transfer rate 
$pftphost = ($isMPS ? 'mpsmss'  : 'babarmss');			# default machine for pftp
$pftpport = ($isMPS ? '21'      : '2021');			# default port for pftp
$pftpuser = ($isMPS ? 'mpsuser' : 'objysrv');			# default user for pftp login
$pftpblksz = 2097152;			# default blksize for pftp
$pftpcmd = ($isMPS ? '/opt/xrootd/utils/xfrcmd'
                   : '/usr/etc/ooss/pftp_client');	# path for pftp command
$rmfail_time = 0;			# default is to not erase .fail files
$stopmigr = "/var/adm/$SSD/STOPMIGR";	# existence of file will stop migration
$stoppsta = "/var/adm/$SSD/STOPPSTA";	# stop stage-ins set by purge
$stoppurg = "/var/adm/$SSD/STOPPURG";	# existence of file will stop purge
$max_retry = 2;				# maximum number of retries for migration
$max_retry_wait = 600;                  # maximum sleep time for pftp retries

# OS-dependent commands
#
$CMDdf       = '/bin/df';
$CMDecho     = '/bin/echo';
$CMDfuser    = (-x '/usr/sbin/fuser' ? '/usr/sbin/fuser' : '/sbin/fuser');
$CMDls       = '/bin/ls';
$CMDhostname = '/bin/hostname';
$CMDkill     = '/bin/kill';
$CMDtail     = '/usr/bin/tail';
$CMDtouch    = '/bin/touch';
$CMDuname    = '/bin/uname';

# Initialize global variables
$globalfh = 'FILE0000';
$logfn = '-';
$myname = ($0 =~ m|([^/]*)$|)[0];
$num_migr_proc = 0;			# number of active migration processes
$ppid = $$;				# save parent pid
chop($systyp = `$CMDuname`);		# used for processing df command
chop($host = `$CMDhostname`);

$CMDdf .= ' -P' if $systyp eq 'Linux';

$ERR   = 0;				# set debug levels
$CTL   = 1;
$FILE  = 2;
$PROC  = 3;
$DEBUG = 4;

# %ErrType tracks the type of error err found

$LOCK_SH = 1;				# values for flock
$LOCK_EX = 2;
$LOCK_NB = 4;
$LOCK_UN = 8;
$LOCKNOERR = 0;				# ignore errors in getlock
$LOCKERR   = 1;				# report errors in getlock

$SIG{CONT} = 'reReadConfig';
$SIG{USR1} = 'wakeup';

# Process parameters
@saveargs = @ARGV;                      # Save @ARGV for Monitor/Poke
if (! &Getopts('MOPb:c:d:e:F:f:h:ik:L:l:m:p:t:u:w:x:1')) {
   logerr("Missing or invalid argument"); 
   exit 1;
   }
if ( (defined($opt_M) && defined($opt_P)) ||
     (!defined($opt_M) && !defined($opt_P)) ) {
   logerr("One and only one -M,-P flag must be specified");
   exit 1;
   }
if (defined($opt_M)) {			# Migrate function
   $cftag = 'migr';			# configuration file tag
   $logfn = "/var/adm/$SSD/logs/mlog";	# default log file
   }
elsif (defined($opt_P)) {		# Purge function
   $cftag = 'purg';			# configuration file tag
   $logfn = "/var/adm/$SSD/logs/plog";	# default log file
   }

if (defined($opt_l)) {			# log file name
   $logfn = "$opt_l";
   }
if (defined($opt_c)) {			# configuration file path
    $cfgfn = "$opt_c";
   }
logit("Starting $myname @saveargs");
readConfig($cfgfn);			# read the config

if (defined($opt_b)) {			# base directory for local file system
   $basedir = "$opt_b";
   }
if (defined($opt_d)) {			# ufs directory to search
   @ufsdirs = split(' ',"$opt_d");
   }
if (defined($opt_e)) {			# list of cache filesystems for purge
   @cachefs = split(' ',"$opt_e");
   }
if (defined($opt_F)) {			# absolute free byte target for purge
   $absfree = "$opt_F";
   }
if (defined($opt_f)) {			# filename for priority migration
   $prtyfn = "$opt_f";
   }
if (defined($opt_h)) {			# base directory for mass storage system
   $mssdir = "$opt_h";
   }
if (defined($opt_i)) {			# ignore/override STOP files
   $stopmigr = '';
   $stoppurg = '';
   }
if (defined($opt_k)) {			# number of files to keep from being purged
   $keepnum = "$opt_k";
   }
if (defined($opt_L)) {			# resource name for global reservation system
   $resource = "$opt_L";
   }
if (defined($opt_m)) {			# migration threshold in seconds
   $migrate_time = "$opt_m";
   }
if (defined($opt_p)) {			# purge threshold in seconds
   $purge_time = "$opt_p";
   }
if (defined($opt_t)) {			# low, high, min  free space thresholds for purge
   ($lopct, $hipct, $minpct) = split(/,/,"$opt_t");
   }
if (defined($opt_u)) {			# low, high, min  used space thresholds for purge
   ($lousedpct, $hiusedpct, $minusedpct) = split(/,/,"$opt_u");
   $lopct = 100 - $hiusedpct;		# get low free space threshold
   $hipct = 100 - $lousedpct;		# get high free space threshold
   $minpct = 100 - $minusedpct;		# get min free space threshold
   }
if (defined($opt_w)) {			# wait interval in seconds
   $waittime = "$opt_w";
   }
if (defined($opt_x)) {			# debug level
   $debug = "$opt_x";
   }

if ($savepid_fn) {			# only if defined in configuration file
   open(SAVE, ">$savepid_fn");
   print SAVE "$$\n";
   close(SAVE);
   }

open(SAVOUT,">&STDOUT");
open(SAVERR,">&STDERR");
close STDIN;
close STDERR;
close STDOUT;

@cachefs = @ufsdirs if !defined(@cachefs);

$doPoke=0;
if (defined($opt_M)) {
   $doPoke=1;
   if (!Monitor(2 * $waittime, "$0",@saveargs)) {
      logerr("Monitoring process for $myname did not start");
      $doPoke=0;
      }
   }

# Main processing loop
#	Scan for files that can be migrated or purged
#	Cleanup child processes for migration tasks
#	Process list for priority migration/purge
#	Initiate migration processes
#	Update priority migr/purge list
#	Initiate purge processes
#	Send any error messages to administrator

while (1) {
logit("Starting new cycle, migr proc = $num_migr_proc") if $debug >= $CTL;
Poke() if $doPoke;     # Let monitor know we are running

# Check to see if configuration file has changed
$mtime = (stat("$cfgfn"))[9];
readConfig($cfgfn) if $mtime > $mtime_cfgfn ;	# read the config file again

# Clear lists of files for a new scan
undef @migfiles;			# clear list
undef @purfiles;
undef @failfiles;
undef @newlist;
foreach $ufsdir (@ufsdirs) {
   scan("$ufsdir");
   }

# cleanup any child processes that have terminated
$killflag = 0;
foreach $file (keys(%migpid)) {
   logit("Checking pid $migpid{$file} for file $file $mtime{$file} $migmtime{$file}") if $debug >= $PROC;
   if (waitpid($migpid{$file},WNOHANG)) {
      delete($migpid{$file});	# remove from table
      delete($migmtime{$file});	# remove from table
      $num_migr_proc--;		# decrement count
      }
   else {			# migration still running
      if ($mtime{$file} > $migmtime{$file}) {	# file changed during migration
         logit("Killing pid $migpid{$file}, $mtime{$file} > $migmtime{$file}") if $debug >= $PROC;
         $cnt = kill -15, $migpid{$file};	# stop migration
         $killflag++;				# no signal from child, avoid sleep below
         }
      }
   }

if (defined($opt_M) && defined($opt_O) && (-e $stopmigr)) {
   logit("One time migration waiting for $stopmigr to be removed");
   }
if (defined($opt_M) && !(-e $stopmigr)) {
   # Process any priority migration/purge requests
   @migfiles = sort bymtime @migfiles;
   $PLCK_fh  = getlock(">>$prtyfn.lock", $LOCK_EX, $LOCKERR);
   $PRTY_fh  = getlock("+<$prtyfn", $LOCK_EX | $LOCK_NB, $LOCKNOERR);
   if ($PRTY_fh) {
      rename("$prtyfn", "$prtyfn.temp");
      @prty = <$PRTY_fh>;
      unlock($PRTY_fh, "$prtyfn.temp");
      for ($i=$#prty; $i >= 0; $i--) {
         ($func, $file) = split(' ', $prty[$i]);
         $mtime{"$file"} = (stat("$file"))[9];
         if ($func =~ /m/) {		# migrate file
            unshift(@migfiles, $file);	# put file on top of migrate list
            $func{"$file"} = $func;	# save func code for do_migrate
            }
         elsif ($func == 'p') {		# purge only
            do_purge("$file");
            @migfiles = grep !/^$file/, @migfiles;	# remove from migration list
            }
         else {
            logit("prtymig: Unknown function $func for file $file") if $debug >= $FILE;
            }
         }
      }
   unlock($PLCK_fh, "$prtyfn.lock") if $PLCK_fh;

   # Any files that pass the migration threshold may be eligible
   # for migration.
   for ($i=0; $i <= $#migfiles; $i++) {
      $file = $migfiles[$i];
      get_ctl_fnames($file);
      last if $num_migr_proc >= $max_migr_proc; 
      next if $migpid{"$file"};			# skip if migration in progress
      next if (-f "$failFN");			# check for previous failure
      next if ($mtime{"$file"} == 0);           # special case for mstore create
      if (-f "$lockFN") {
         my($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksiz, $blks)
            = stat("$lockFN");
         if ($mtime >= $mtime{"$file"}) {	# file has not changed since last migrate
            if ($func{"$file"} =~ /p/) {	# purge file after migrate
               do_purge("$file");
               }
            next;
            }
         }
      else {					# lock file does not exist
         next unless (-f "$file");		# skip, file has been purged
         logerr("migrate_loop: lock file does not exist for $file", 'lf');
         open(FAIL, ">$failFN");
         print(FAIL "No lock file\n");
         close(FAIL);
         next;					# skip it for now
         }
      fork_migrate($file);			# OK! migrate file
      sleep 1;					# wait a sec before starting another migration
      cache_path($file);
      }

   # Check for any priority migrations that were not performed this iteration
   for (; $i <= $#migfiles; $i++) {
      $file = $migfiles[$i];
      if ($func{"$file"} =~ /m/) {
         push(@newlist, "$func{$file} $file\n");
         $func{"$file"} = '';			# prevent 2nd stacking of file
         }
      }
   if ($#newlist >= 0) {
      $PLCK_fh  = getlock(">>$prtyfn.lock", $LOCK_EX, $LOCKERR);
      $PRTY_fh  = getlock(">>$prtyfn", $LOCK_EX | $LOCK_NB, $LOCKNOERR);
      if ($PRTY_fh) {
         print($PRTY_fh @newlist);
         unlock($PRTY_fh, "$prtyfn");
         }
      else {
         logit("prtymig: Unable to update $prtyfn") if $debug >= $FILE;
         }
      unlock($PLCK_fh, "$prtyfn.lock") if $PLCK_fh;
      }
   # Remove any .fail files that are older than the threshold specified to
   # allow another migration attempt to occur.
   foreach $file (@failfiles) {
      if (unlink($file)) {
         logit("File $file removed") if $debug >= $FILE;
         }
      else {
         logit("Error removing file $file");
         }
      }
   if (defined($opt_O) && ($num_migr_proc == 0)) {
      logit("One time migration request exiting");
      exit;
      }
   } # if (defined($opt_M))
     
if (defined($opt_P) && !(-e $stoppurg)) {
   # Check each filesystem for files to purge
   @purfiles = sort byptime @purfiles;
   splice(@purfiles, $#purfiles - $keepnum +1) if $keepnum;
   $purge_rc = 0;
   $minfreeflag = 0;
   undef %fsdata;
   foreach $cachefs (@cachefs) {
      $purge_rc++ if do_purgefs($cachefs);
      }
   exit $purge_rc if defined($opt_O);	# one time only purge

   # Disable stageins if minfree targets were not reached.
   # If cpfuzz = 100 (Round robin allocation) then stop stageins
   # if any filesystem is full. Otherwise, stop stageins only if
   # all filesystems are full.
   if ($minfreeflag && (($cpfuzz == 100) || ($minfreeflag == ($#cachefs +1)))) {
      if (! (-e $stoppsta)) {		# Already stopped?
         system("$CMDtouch $stoppsta");
         logerr("minfree target not reached, stageins not allowed",'sp'); # alert on first time
         }
      }
   elsif (-e $stoppsta) {		# stageins allowed again
      unlink($stoppsta);
      logit("minfree target reached, stageins allowed") if $debug >= $CTL;
      }
   } # if (defined($opt_P))

# Check to see if there are any error messages that need to be sent to
# the administrator.
if (-f "$errlogfn") {			# is there a error log file?
   $last_Email_time = (stat("$errlogfn.last"))[9];
   if ((time - $last_Email_time) > $errlogintvl) {
      $ERR_fh  = getlock("+<$errlogfn", $LOCK_EX | $LOCK_NB, $LOCKNOERR);
      if ($ERR_fh) {
         open(TEMP,">$errlogfn.last");
         close(TEMP);
         my($subject) = SLine($ERR_fh, $host);
         `$mailcmd -s "$subject" $adminuser < $errlogfn`;
         unlink("$errlogfn");
         unlock($ERR_fh, "$errlogfn");
         }
      }
   }

sleep $waittime - 1 if !$killflag;
# wait a second for migrate process to terminate. Assumes prior
# sleep was terminated by SIGALRM.
sleep 1;		
} # while (1)
exit;

#===================================================================
# Subroutine to construct parm file for pftp command
#
# Input: filename to copy
#        dual copy flag
#===================================================================
sub buildparm {
my($file,$copyflg) = @_;
my($ndir, $pdir, $subdirs);
local *FH;
get_ctl_fnames($file);

my($path, $fn) = $file =~ m|(^.*)/([^/]*)$|;
($subdirs) = $path =~ m|$basedir/(.*)$|;	# remove base directory
open(FH,">$migrFN");
print FH "user $pftpuser <$keyfn\n";
print FH "binary\n";
print FH "setpblocksize $pftpblksz\n";
print FH "site setcos " . ($copyflg ? "$copycos\n" : "$cos\n");
$pdir = '/';
while ("$subdirs" ne "") {
   if ($subdirs =~ m|^([^/]*)/(.*)$|) {		# 2 or more subdirs
      $ndir = $1;
      $subdirs = $2;
      }
   else {					# last subdir
      $ndir = $subdirs;
      $subdirs = "";
      }
   $path = "$mssdir$pdir$ndir";
   print FH "mkdir $path\n" unless $madedir{$path};
   $pdir = "$pdir$ndir/";
   } 
print FH "pput $file $mssdir$pdir$fn" . ($copyflg ? "\\$copychar\n" : "\n");
print FH "quit\n";
close FH;

# Check parm file to make sure it is complete
my($data) = `$CMDtail -1 $migrFN`;
if ("$data" ne "quit\n") {
   logerr("buildparm: $migrFN file incomplete",'ftp');
   unlink($migrFN);
   open(FH,">$failFN");  # try to create .fail file to prevent loop
   close(FH);
   return 0;
   } 

return "$migrFN";
}

#===================================================================
# Subroutine to sort list by modification time
#===================================================================
sub bymtime {
$mtime{$a} <=> $mtime{$b};
}

#===================================================================
# Subroutine to sort list by value used for purge 
#===================================================================
sub byptime {
$ptime{$a} <=> $ptime{$b};
}

#===================================================================
# Subroutine to keep track of directories built in hpss to avoid
#            unnecessary mkdirs
#
# Input: filesystem
#===================================================================
sub cache_path {
my($file) = @_;
my($path, $fn) = $file =~ m|(^.*)/([^/]*)$|;    # remove filename
($path) = $path =~ m|$basedir(/.*)$|;	        # remove base directory
while ("$path" ne "") {
   my($dir) = "$mssdir$path";
   if (! $madedir{$dir}) {
      $madedir{$dir} = 1;
      logit("cache_path: $dir") if $debug >= $DEBUG;
      }
   if ($path =~ m|^(/.*)/([^/]*)$|) {		# 2 or more subdirs
      $path = $1;
      }
   else {					# last subdir
      return;
      }
   }
}
#===================================================================
# Subroutine to determine the amount of free space in a file system
#
# Input: filesystem
# Output: %free, kbytes, kfree
#===================================================================
sub calcfree {
my($fs, $fsdev) = @_;
my($temp);
my($kbytes, $kfree);

if (defined($fsdata{$fsdev})) {
   ($kbytes, $kfree) = split(/,/, $fsdata{$fsdev});
   }
else {
   my(@data) = `$CMDdf -k $fs 2>&1`;
   if ($?) {
      logit("calcfree: df command failed for $fs") if $debug >= $ERR;
      foreach $temp (@data) {
         chomp($temp);
         logit("calcfree: $temp") if $debug >= $ERR;
         }
      sleep 2;
      return 100;
      }
   if ("$systyp" eq "AIX") {
      ($x, $kbytes, $kfree) = split(' ', $data[1]);
      }
   else {
      ($x, $kbytes, $x, $kfree) = split(' ', $data[1]);
      }
   $fsdata{$fsdev} = "$kbytes,$kfree";
   }
return ((100 * $kfree) / $kbytes, $kbytes, $kfree);
}

#===================================================================
# Subroutine to check if a file is open
#
# Input: file name to check
#===================================================================
sub chkopen {
my($file) = @_;
my($data) = `$CMDfuser $file 2>&1`;
($data =~ /^$file:\s+(\S+)/);
}

#===================================================================
# Subroutine to migrate file using pftp
#
# Input: file name to migrate
#===================================================================
sub do_migrate {
my($file) = @_;
my($cmd, $DIR_fh, $LOCK_fh, $prc);
my($retry_cnt);
my($temp);
local($pfile);
local *FAIL;
get_ctl_fnames($file);

# Re-open STDOUT and STDERR to grab file descriptors 1 and 2 so that
# the lock file does not use one of these which would be a problem if
# the process gets killed and something is written to STDERR.
open(STDOUT,">&SAVOUT");
open(STDERR,">&SAVERR");
$DIR_fh  = getlock(">>$dlckFN", $LOCK_EX, $LOCKERR);
return -1 if !$DIR_fh;
$LOCK_fh = getlock("+<$lockFN", $LOCK_EX | $LOCK_NB, $LOCKERR);
unlock($DIR_fh, "$dlckFN");
# If we did not obtain the file lock, then the file is being
# referenced by someone. Bail out for now, and let the next
# iteration attempt to migrate it if that's still appropriate.
if (!$LOCK_fh) {
   logit("do_migrate: unable to get lock for $file") if $debug >= $FILE;
   return -1;
   }

my($dualcopy) = 0;             # assume not dual copy
foreach $copydir (@copydirs) {
   if ($file =~ m|^$copydir/|) {
      $dualcopy++;
      last;
      }
   }
if (!$dualcopy || (! -e $dualFN)) {            # need to make first copy?
   $retry_cnt = 0;
   while (++$retry_cnt <= $max_retry) {
      $pfile = buildparm("$file",0);
      if (!$pfile) {              # buildparm failed
	 $prc=8;
         last;                    # exit loop for now
         }
      $cmd = "$pftpcmd -f '$pfile' $pftphost $pftpport 2>&1";
      logit("do_migrate: 1st $cmd") if $debug >= $CTL;
      my(@data) = `$cmd`;
      $prc = $? >> 8;
      # If the pftp failed, we will save the output from the pftp command
      # Note that creating the ".fail" file will prevent further migration
      # attempts for this file. Mail will be sent to the administrator.
      if ($prc) {		   # command failed
         my($cnt) = pftp_error($retry_cnt,$max_retry_wait,@data);
         last if !$cnt;            # exit retry loop
         $retry_cnt = $cnt;
         }
      else {			   # command succeeded
	 if ($debug >= $DEBUG) {
            foreach $temp (@data) {
               chomp($temp);
               logit("$temp");
               }
	    }
         unlink("$failFN");        # remove .fail if previous failure
	 if ($dualcopy) { 
	    open(TMP,">$dualFN");  # create .dual file
	    close(TMP);
	    }
         last;			   # exit retry loop
         }
      } # while (++$retry_cnt <= $max_retry)
   }
if ($dualcopy && (-e $dualFN)) {   # need to make 2nd copy?
   $retry_cnt = 0;
   while (++$retry_cnt <= $max_retry) {
      $pfile = buildparm("$file",1);
      if (!$pfile) {              # buildparm failed
	 $prc=8;
         last;                    # exit loop for now
         }
      $cmd = "$pftpcmd -f '$pfile' $pftphost $pftpport 2>&1";
      logit("do_migrate: 2nd $cmd") if $debug >= $CTL;
      my(@data) = `$cmd`;
      $prc = $? >> 8;
      # If the pftp failed, we will save the output from the pftp command
      # Note that creating the ".fail" file will prevent further migration
      # attempts for this file. Mail will be sent to the administrator.
      if ($prc) {		   # command failed
         my($cnt) = pftp_error($retry_cnt,$max_retry_wait,@data);
         last if !$cnt;            # exit retry loop
         $retry_cnt = $cnt;
         }
      else {			   # command succeeded
	 if ($debug >= $DEBUG) {
            foreach $temp (@data) {
               chomp($temp);
               logit("$temp");
               }
	    }
         unlink("$failFN");	   # remove .fail if previous failure
         unlink("$dualFN");	   # remove .dual
         last;			   # exit retry loop
         }
      } # while (++$retry_cnt <= $max_retry)
   }
if ($prc) {                        # migration failed
   logerr("do_migrate: $XFR failed for $file, rc=$prc, retry=$retry_cnt", 'ftp');
   }
else {                             # migration succeeded
   my($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksiz, $blks)
      = stat("$file");
   if ($mtime <= $mtime{$file}) {		# if file hasn't changed 
      utime($atime, $mtime, "$lockFN");	# update lock file time
      }
   else {
      logit("do_migrate: $file changed during migration") if $debug >= $FILE;
      }
}
unlink("$pfile");		   # remove parm file
unlock($LOCK_fh, "$lockFN");
return $prc;
}
#===================================================================
# Subroutine to handle pftp errors
#
# Input:  retry count
#         maximum wait time
#         pftp command response
#
# Output: new retry count or 0 for no more retries
#         setting retry count to 1 should cause infinite retries
#===================================================================
sub pftp_error {
my($retry_cnt,$maxwait,@data) = @_;
if (grep(/FileToNet: select error = 145/, @data)) {	# pftp timeout
   logit("do_migrate: $XFR timeout for $file");
   return 0;
   }
# Errors which should be retried forever because problem is with HPSS
# not the particular file being transferred.
if (grep(/Bad Data Transfer.\(error = -28,moved = 0\)/, @data)) {
   logit("do_migrate: No space in storage class for $file");
   sleep min(240,$maxwait);	# wait a bit and retry forever
   return 1;                    # since nothing else will work
   }
if (grep(/Login failed./, @data)) {
   logit("do_migrate: $XFR login failed for $file");
   sleep min(240,$maxwait);	# wait a bit and retry forever
   return 1;                    # since nothing else will work
   }
if (grep(/Service not available, remote server has closed connection/, @data)) {
   logit("do_migrate: $XFR login failed for $file");
   sleep min(240,$maxwait);	# wait a bit and retry forever
   return 1;                    # since nothing else will work
   }
if (grep(/connect: Connection timed out/, @data)) {
   logit("do_migrate: $XFR login failed for $file");
   sleep min(240,$maxwait);	# wait a bit and retry forever
   return 1;                    # since nothing else will work
   }
if (grep(/connect: Connection refused/, @data)) {
   logit("do_migrate: $XFR login failed for $file");
   sleep min(240,$maxwait);	# wait a bit and retry forever
   return 1;                    # since nothing else will work
   }
# Retryable errors that are likely file related. Retries limited to
# max_retry in calling routine.
if (grep(/Bad Data Transfer.\(error = -5,moved = 0\)/, @data)) {
   logit("do_migrate: No devices available to $XFR $file");
   sleep min(120 * $retry_cnt, $maxwait);	# wait a bit and retry
   return $retry_cnt;
   }
if (grep(/cannot be opened - HPSS Error: -5/, @data)) {
   logit("do_migrate: Open error for $file");
   sleep min(60,$maxwait);	# wait a bit and retry
   return $retry_cnt;
   }
if (grep(/cannot be opened - HPSS Error: -2/, @data)) {
   logit("do_migrate: mkdir error for $file");
   undef %madedir;		# make all directories
   return $retry_cnt;
   }
# The following error seems to correlate to BFS end session error BFSR0096
if (grep(/Bad Data Transfer.\(error = -52,moved = 0\)/, @data)) {
   logit("do_migrate: BFS error = -52 for $file");
   sleep min(60,$maxwait);	# wait a bit and retry
   return $retry_cnt;
   }

open(FAIL, ">>$pfile");
foreach $temp (@data) {
   chomp($temp);
   logit("$temp") if $debug >= $ERR;
   print FAIL "$temp\n";
   }
close(FAIL);
rename("$pfile", "$failFN");

# Retryable error conditions that require notification should go here.
if (grep(/HPSS Error: -5/, @data)) {		# I/O error in HPSS?
   logerr("do_migrate: I/O error for $file, rc=$prc, retry=$retry_cnt", 'io');
   sleep min(60,$maxwait);	# wait a bit and retry
   return $retry_cnt;
   }
return 0;			# no more retries 
}
#===================================================================
# Subroutine to purge a file
#
# Input: file name to purge
#===================================================================
sub do_purge {
my($file) = @_;
my($DIR_fh) = '';
my($LOCK_fh) = '';
get_ctl_fnames($file);

$curtime = time();
($dir) = $file =~ m|(^.*)/[^/]*$|;
$DIR_fh  = getlock(">>$dlckFN", $LOCK_EX, $LOCKERR);
return 0 if !$DIR_fh;			# bail out if can't get directory lock
while (1) {
   last if (-f "$failFN");		# skip if migration failed
   last unless -f "$lockFN";		# skip if file not migrated
   if (chkopen("$file")) {		# skip if file is open
      logit("do_purge: file $file is open, not purged") if $debug >= $DEBUG;
      last;
      }
   #
   # If a "pin" file exists, it is a mechanism to prevent or delay the purge of a file.
   # The base file will not be purged if the "pin" file has its sticky bit set.
   # The "pin" file can also be set with a modification time in the future indicating
   # when the base file is eligible to be purged. It may also contain a inactive time
   # value which will prevent the file from being purged unless it has been inactive
   # for the specified number of seconds.
   if (-f "$pinFN") {			# should file be left alone?
      my($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksiz, $blks)
         = stat("$pinFN");
      last if ($mode & 04000);		# skip if "sticky bit" is on
      last if ($mtime > $curtime);	# skip if purge time has not occurred yet
      if ($size > 0) {			# check for minimum inactive time value
         open(PIN, "$pinFN");
         @pindata = <PIN>;
         close(PIN);
         if ("@pindata" =~ /&inact_time=(\d+)/) {
            last if ( ($curtime - (stat($file))[8]) < $1);
            }
         }
      }
   $LOCK_fh = getlock("+<$lockFN", $LOCK_SH | $LOCK_NB, $LOCKERR);
   last if !LOCK_fh;
   my($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksiz, $blks)
      = stat("$lockFN");
   last if $mtime < $mtime{"$file"};	# skip if file has changed since last migrate
   if (-l $file) {			# we have a symlink
      my($lfile) = readlink($file);	# get the linked file
      if (unlink($lfile)) {
         logit("do_purge: linked file $lfile purged") if $debug >= $FILE;
         }
      else {
         logerr("do_purge: error purging linked file $lfile",'pu');
         last;
         }
      }
   if (unlink($file)) {
      logit("do_purge: file $file purged") if $debug >= $FILE;
      unlink("$pinFN");			# remove pin file too
      unlink("$lockFN");		# remove lock file too
      unlock($LOCK_fh, "$lockFN");
      unlock($DIR_fh, "$dlckFN");
      $DIR_fh = '';			# DIR lock no longer held
      FileGone($file);
      return 1;				# purge successful
      }
   else {
      logerr("do_purge: error purging file $file",'pu');
      last;
      }
   }

# If we get here, it means the purge failed or wasn't attempted.
# Cleanup any locks we have, and return.
if ($LOCK_fh) {
   unlock($LOCK_fh, "$lockFN");
   $LOCK_fh = '';
   }
if ($DIR_fh) {
   unlock($DIR_fh, "$dlckFN");
   $DIR_fh = '';
   }
return 0;
}
#===================================================================
# Subroutine to purge files in a filesystem
#
# Input: filesystem to purge files from
#===================================================================
sub do_purgefs {
my($cachefs) = @_;
my($i) = 0;
my($absval, $blkfree, $blks, $curfree, $dev, $file, $fshi, $fslo, $fsmin);
my($key, $minfree, $purgflag, $targfree);

# Determine which purgy policy we should use for this filesystem
# based on the number of parameters specified.
$absval = 0;				# Assume percentage policy
my($fs, $parm1, $parm2, $parm3) = split(/,/,"$cachefs");
if (defined($parm2)) {			# Use percentage policy
   $fslo = $parm1;
   $fshi = $parm2;
   $fsmin = defined($parm3) ? $parm3 : $minpct;
   }
elsif (defined($parm1)) {		# Use absolute value
   $absval = getval($parm1);
   return if (!$absval);
   }
else {					# Use global policy
   $absval = $absfree;
   $fslo = $lopct;
   $fshi = $hipct;
   $fsmin = $minpct;
   }

my($fsdev) = (stat("$fs"))[0];		# get device num for base filesystem

my($freesp, $kbytes, $kfree) = calcfree($fs, $fsdev);
my($totblks) = $kbytes*1024/512;
$minfree = 0;				# minfree not enforced
# Set target blocks to free based on absolute value or percentage
if ($absval) {				# absolute value specified
   $curfree = $totblks * ($freesp/100);	# get number of free blocks
   logit(sprintf("do_purgefs: curfree = %.0f, absval = %.0f %s", $curfree, $absval/512, $fs))
      if $debug >= $CTL;
   return 0 if $curfree >= ($absval/512);
   $targfree = ($absval/512) - $curfree;
   logit("do_purgefs: absolute, targfree = $targfree") if $debug >= $FILE;
   }
else {					# use percent free space
   logit(sprintf("do_purgefs: free = %.2f, low = %.2f, high = %.2f %s", $freesp, $fslo, $fshi, $fs))
      if $debug >= $CTL;
   return 0 if ($freesp > $fslo);		# return if over low free space threshold
   $targfree = int($totblks * (($fshi-$freesp)/100));	# num of blocks to free
   logit("do_purgefs: percent, totblks = $totblks, targfree = $targfree") if $debug >= $FILE;
   if ($fsmin && $fsmin > $freesp) {
      $minfree = int($totblks * (($fsmin-$freesp)/100));
      logit("do_purgefs: minfree = $minfree") if $debug >= $FILE;
      }
   }
$blkfree = 0;				# initialize counter of blocks freed
my($num_acc) = 0;
my($num_noacc) = 0;
my($num_cmprss) = 0;
while ($blkfree < $targfree) {		# purge until we reach target value
   $purgflag = 0;
   while ($i <= $#purfiles) {
      ($dev, $blks, $file) = split(/:/, $purfiles[$i], 3);
      my($atime) = (stat($file))[8];
      my($cmprss) = ($isMPS ? 0 : system("/usr/etc/ooss/oosquish -Q $file"));
      if (($dev == $fsdev) && (do_purge("$file"))) {
         splice(@purfiles, $i, 1);	# remove file from list
         $purgflag++;			# indicate file purged
         $blkfree += $blks;		# increment blocks freed
         $num_cmprss++ if $cmprss;      # count num of compress files purged
         if ($atime > $mtime{"$file"}) {
            $num_acc++;
            }
         else {
            $num_noacc++;
            }
       	 last;				# check target again
         }
      $i++;				# get next file for purge
      }
   $key = "$dev:$blks:$file";
   logit("blkfree = $blkfree, targfree = $targfree, ptime = $ptime{$key}") if $debug >= $FILE;
   if (!$purgflag) {	# nothing more eligible for purge
      logit("do_purgefs: unable to obtain target free space in $fs") if $debug >= $CTL;
      last;
      }
   }
$kfree += $blkfree*512/1024;		# adjust amount of free space
$fsdata{$fsdev} = "$kbytes,$kfree";

# Check to see if minimum target was reached. Ignore if one time purge.
if (!defined($opt_O) && $minfree && $blkfree < $minfree) {
   $minfreeflag++;
   logit("do_purgefs: minfree target not reached for $fs") if $debug >= $CTL;
   }
   
($freesp, $kbytes, $kfree) = calcfree($fs, $fsdev);
$totblks = $kbytes*1024/512;
if ($absval) {				# absolute value specified
   $curfree = $totblks * ($freesp/100);	# get number of free blocks
   logit(sprintf("do_purgefs: curfree = %.0f, absval = %.0f %s", $curfree, $absval/512, $fs))
      if $debug >= $CTL;
   }
else {					# use percent free space
   logit(sprintf("do_purgefs: free = %.2f, low = %.2f, high = %.2f %s", $freesp, $fslo, $fshi, $fs))
      if $debug >= $CTL;
   }
logit(sprintf("do_purgefs: purged %4d accessed, %4d not accessed, %4d compressed in %s", 
               $num_acc, $num_noacc, $num_cmprss, $fs));
return !$purgflag;
}

#===================================================================
# Subroutine to fork a migration process
#
# Input: file name to migrate
#===================================================================
sub fork_migrate {
my($file) = @_;
local($pid);

if (defined($opt_1)) {
   my($rc) = do_migrate("$file");
   return;
   }
# Fork a process to migrate file.
if ($pid = fork) {		# parent
   $migpid{$file} = $pid;
   # Save modification time when migration started
   $migmtime{$file} = $mtime{$file};
   $num_migr_proc++;		# increment count
   return;
   }
elsif (defined $pid) {		# child
   logit("fork_migrate: for $file, starting") if $debug >= $PROC;
   setpgrp(0, $$);		# create a new process group
   my($stime) = time();
   my($rc) = do_migrate("$file");
   my($etime) = time();
   my($usr,$sys,$cusr,$csys) = times();
   my($elap) = $etime-$stime ? $etime-$stime : 1;
   my($pctb) = sprintf("%.2f", 100 * ($usr+$sys+$cusr+$csys) / $elap);
   my($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksiz, $blks)
            = stat($file);
   $rc ? update_ctrs(0,0,0,1) : update_ctrs(1,$size,$elap,0);
   my($rate) = sprintf("%dK/sec", $size/$elap/1024); 
   logit("fork_migrate: for $file, exiting, size=$size elap=$elap, pctbsy=$pctb%, $rate, rc=$rc") if $debug >= $PROC;
   if ($func{"$file"} =~ /p/) {		# purge file after migrate
      do_purge("$file");
      }
   `$CMDkill -USR1 $ppid`;			# wakeup parent
   exit $rc;
   }
else {
   logit("fork_migrate: fork failed for $file: $!\n") if $debug >= $ERR;
   }
}
 
#===================================================================
# Subroutine to scan a filesystem for files to migrate/purge
#
# Input: filesystem to scan
#===================================================================
sub scan {
   my($base) = @_;
   my($fpurgtime);
   $base .= "$c" if (($c = chop($base)) ne '/'); # remove trailing /
   my($parent) = $base =~ m|(^.*)/[^/]*$|;
   chdir($base) or logit("Unable to chdir to $base: $!"), return;
   opendir(DIR, ".") or logit("Unable to open $base: $!"), chdir($parent), return;
   my(@files) = grep(! /^\.\.?$/ & ! /\.anew|\.dual|\.map|\.migr|\.pin|\.stage|\.lock$/ & !/$dirlock$/, readdir(DIR));
   closedir(DIR);

   $curtime = time();
   for $file (@files) {
      stat "$file";
      if (-d _ ) {		# have a directory or a link to a directory
         scan("$base/$file");
         }
      elsif (-f _ ) {		# have a file
         get_ctl_fnames($file);
         my($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksiz, $blks)
            = stat($file);
         $mtime{"$base/$file"} = $mtime;
         # Create list of .fail files for possible cleanup/retry.
         if ($file =~ /\.fail$/) {
            if ($rmfail_time && (($curtime-$mtime) > $rmfail_time) ) {
               push @failfiles, "$base/$file";
               }
            next;
            }
         #
         # Calculate how long it will take to migrate this file assuming
         # a minimum data transfer rate, and require the file to be unchanged
         # for at least that long before starting a migration.
         #
         my($trans_time) = defined($opt_O) ? 0 : $size/$min_tran_rate;
         my($migtime) = ($trans_time > $migrate_time) ? $trans_time : $migrate_time;
         if ($migrate_time && (($curtime-$mtime) > $migtime) ) {
            push @migfiles, "$base/$file";
            $func{"$base/$file"} = 'n';		# indicate normal migration
            }
         #
         # If a "pin" file exists, it is a mechanism to prevent or delay the purge of a file.
         # The base file will not be purged if the "pin" file has its sticky bit set.
         # The "pin" file can also be set with a modification time in the future indicating
         # when the base file is eligible to be purged. It may also contain a inactive time
         # value which will prevent the file from being purged unless it has been inactive
         # for the specified number of seconds.
         $fpurgtime = 0;
         if (-f "$pinFN") {			# should file be left alone?
            my($x, $x, $modeP, $x, $x, $x, $x, $sizeP, $x, $mtimeP, $x, $x, $x)
               = stat("$pinFN");
            if (($modeP & 04000) ||		# skip if "sticky bit" is on
                ($mtimeP > $curtime)) {  	# skip if purge time has not occurred yet
	       $fpurgtime = -1;                 # override purge of file
	       }
            elsif ($sizeP > 0) {		# check for minimum inactive time value
               open(PIN, "$pinFN");
               @pindata = <PIN>;
               close(PIN);
               ($fpurgtime) = "@pindata" =~ /&inact_time=(\d+)/; 
               }
	    }
         my($purgtime) = ($fpurgtime) ? $fpurgtime : $purge_time;
         # Only select files for purge that are older than the purge threshold
         # Also skip any file with atime=0, convention for purge override  
         if ($purge_time &&
             ($purgtime > 0) &&
             ($atime > 0) &&
             (($curtime-$atime) > $purgtime) &&
             (($curtime-$mtime) > $purgtime) ) {
            push @purfiles, "$dev:$blks:$base/$file";
            $ptime{"$dev:$blks:$base/$file"} = (($atime > $mtime) ? $atime : $mtime) -
                                               (($fpurgtime) ? $purge_time - $fpurgtime : 0);
            }
         logit(sprintf("%s, atime %d, mtime %d, ctime %d",
               "$file", $curtime-$atime, $curtime-$mtime, $curtime-$ctime))
               if $debug >= $DEBUG;
         }
      }

   chdir($parent);
}

#===================================================================
# Subroutine to lock a file using fcntl instead of flock
#
# Input: file handle to lock
#        flock flags to be translated to fcntl
#===================================================================
sub Flock {
my($fh, $flags) = @_;
my($lk_type, $lk_mode, $lk_parms);

# Determine lock mode.
if ($flags & $LOCK_NB) {	# non-blocking request
   $lk_mode = F_SETLK;
   }
else {
   $lk_mode = F_SETLKW;		# wait for lock
   }
# Determine lock type.
if ($flags & $LOCK_UN) {	# unlock request
   $lk_type = F_UNLCK;
   }
elsif ($flags & $LOCK_SH) {	# shared lock
   $lk_type = F_RDLCK;
   }
else {
   $lk_type = F_WRLCK;		# exclusive lock
   }
# Construct the parameter list and perform lock function.
$lk_parms = pack('sslllll', $lk_type, 0, 0, 0, 0, 0, 0);
return fcntl($fh, $lk_mode, $lk_parms);
}
#===================================================================
# Subroutine to construct filenames for control files
#
# Input: file name to lock
# 
# Output: $dlckFN
#         $dualFN
#         $failFN
#         $lockFN
#         $migrFN
#         $pinFN
#===================================================================
sub get_ctl_fnames {
my($file) = @_;
my($path,$lfn) = $file =~ m|(^.*)/([^/]*)$|;
if ($hidden) {
   $dlckFN = "$path/.$dirlock";
   $dualFN = "$path/.$lfn.dual";
   $failFN = "$path/.$lfn.fail";
   $lockFN = "$path/.$lfn.lock";
   $migrFN = "$path/.$lfn.migr";
   $pinFN  = "$path/.$lfn.pin";
   }
else {
   $dlckFN = "$path/$dirlock";
   $dualFN = "$file.dual";
   $failFN = "$file.fail";
   $lockFN = "$file.lock";
   $migrFN = "$file.migr";
   $pinFN  = "$file.pin";
   }
}
#===================================================================
# Subroutine to open and lock a file
#
# Input: file name to lock
#        flags for flock
#        error logging flag
#===================================================================
sub getlock {
my($file, $flag, $errflg) = @_;
my($fh) = $globalfh++;
if (!open($fh, "$file")) {
   logerr("getlock: open failed for $file, $!",'gl') if $errflg;
   return '';
   }
if (!Flock($fh, $flag)) {
   logerr("getlock: flock failed for $file, $!",'gl') if $errflg && $! != 11;
   close($fh);
   return '';
   }
logit("getlock: locking file $file, flags $flag") if $debug >= $DEBUG;
return $fh;      
}

#===================================================================
# Subroutine to get a numeric value
#
# Input: value to check
#===================================================================
sub getval {
my($val) = @_;
my($q);
my($valsave) = $val;

$q = uc(chop($val));
if ($q eq 'K') {
   $q = 1024;
   }
elsif ($q eq 'M') {
   $q = 1024*1024;
   }
elsif ($q eq 'G') {
   $q = 1024*1024*1024;
   }
else {
   $val .= $q;		# put last character back
   $q = 0;
   }
if (!&IsNum($val)) {	# value is not numeric
   logit("getval: Invalid numeric value $valsave");
   return;
   }
$val = $val*$q if $q;
logit("getval: input $valsave, returning $val") if $debug >= $DEBUG;
return $val;
}

sub IsNum  {my($v) = @_; return ($v =~ m/^[0-9]+$/);}

#===================================================================
# Subroutine to generate a subject line
#
# Input: host name
#===================================================================
sub SLine {my($EFD, $host) = @_;

my(@frec) = <$EFD>;
my($rec, $etype, $enlst, %ErrTypes);

foreach $rec (@frec) {$ErrTypes{$1} = 1 if $rec =~ m/.*-(\w*)-/;}

my(@elist) = keys(%ErrTypes);
@elist = sort(@elist);
foreach $etype (@elist) {$enlst .= ' '.$etype;}

return "$SSD$enlst @ $host"
}

#===================================================================
# Subroutine to notify administrator of an error
#
# Input: error message to log
#===================================================================
sub logerr {
local($text,$etype) = @_;
local(@t) = localtime(time);
$etype = 'oth' if !defined($etype);

# Put error message in error log file which will be mailed periodically
# to the administrator in the main processing loop to avoid mail flooding.
$ERR_fh  = getlock(">>$errlogfn", $LOCK_EX, $LOCKNOERR);
if ($ERR_fh) {
   printf($ERR_fh "%02d:%02d:%02d [%s-%s-%d] %s\n", $t[2], $t[1], $t[0], $cftag, $etype, $$, $text);
   unlock($ERR_fh, "$errlogfn");
   }
else {			# Couldn't open error log
   logit("logerr: Could not get lock for $errlogfn");
   `$CMDecho "\n$text" | $mailcmd -s "migrpurg error on $host" $adminuser`;
   }
logit("$text");
}

#===================================================================
# Subroutine to log an message
#
# Input: message text to log
#===================================================================
sub logit {
local($text) = @_;
local(@t) = localtime(time);
open(LOG, ">>$logfn");
printf(LOG "%02d:%02d:%02d [%6d] %s\n", $t[2], $t[1], $t[0], $$, $text);
close(LOG);
}
#===================================================================
# Subroutine to return minimum of two numbers
#===================================================================
sub min {
my($a,$b) = @_;
return ($a < $b) ? $a : $b;
}
#===================================================================
# Subroutine to read config file
#
# Input: config filename
#
# config file format:
#
#	ooss[.subsys].variable_name = value
#		or
#	ooss[.subsys].variable_name value
#
# where subsys is optional with a value of migr or purg
#
# There is special processing for the cache parameter which assumes
# a format of : ooss.cache group fs [opt1 [opt2 [opt3]]]
# The group is ignored and the options if they exist are joined
# into a comma separated list for the @cachefs list.
#
#===================================================================
sub readConfig {
local($cfgFN) = @_;
local($cache, $cachefs, $i, $x);
return unless(open(CONFIG, $cfgFN)); 
$mtime_cfgfn = (stat("$cfgFN"))[9];
logit("readConfig: processing file $cfgFN");
my(@tempfs) = ();
my(@tempscan) = ();   
my(@tempcopy) = ();   

my(%Xlate) = (xfrblksz      => 'pftpblksz',
              xfrcmd        => 'pftpcmd',
              xfrhost       => 'pftphost',
              xfrport       => 'pftpport',
              xfruser       => 'pftpuser',
              ftpcmd        => 'pftpcmd'
             );
my(%Xcept)= ('ooss.cache'   => 1, 
              'oss.cache'   => 1);

while( <CONFIG> ) {
   s/#.*$//;						# remove comments
   if (/=/) {                                           # var = val
      ($var,$val) = /(\S*?)\s*=\s*(.*)/;
      }
   else {                                               # var val (no equal sign)
      ($var,$val) = /(\S*)\s*(.*)/;
      }
   $var =~ tr/ \t\n//d;					# remove whitespaces
   $val =~ s/^\s*//;					# remove leading whitespaces
   $val =~ s/\s*$//;					# remove trailing whitespaces
   my($Accept) = $Xcept{$var};
   if ($var =~ /^(\S*)\.(\S*)\.(\S*)$/) {
      ($sys,$ssys,$var) = ($1,$2,$3);
      next if ("$ssys" ne "$cftag");	# skip if not for our subsys
      }
   elsif ( $var =~ /^(\S*)\.(\S*)$/ ) {
      ($sys,$var) = ($1,$2);
      }
   else {
      next;				# skip comments, errors
      }
   next if ("$sys" ne "$SSD" && !$Accept);		# skip if not for ooss
   if ("$var" eq "cache") {
      ($x, $val) = split(" ", $val,2);			# remove group
      $val = join(",", split(" ", $val));		# create comma separated args
      }
   $val =~ tr/ /:/ if ("$var" eq "scan");		# translate blank to colon
   $var = $Xlate{$var} if ($Xlate{$var});

   eval '$' . "$var = " .'"' . "$val" . '"' ;
   logit("readConfig: $var = $val") if $debug >=$FILE;
   push @tempfs, "$cache" if "$var" eq "cache";		# create list of cache filesystems 
   push @tempfs, "$cachefs" if "$var" eq "cachefs";	# create list of cache filesystems
   push @tempcopy, "$copydir" if "$var" eq "copydir";
   push @tempscan, split(":", $scan) if "$var" eq "scan";
   $lopct = 100 - $hiusedpct if "$var" eq "hiusedpct";	# get low free space threshold
   $hipct = 100 - $lousedpct if "$var" eq "lousedpct";	# get high free space threshold
   }

# Check cache filesystems for wildcard "*" and expand list appropriately
for ($i = $#tempfs; $i >= 0; $i--) {
   my($fs,$rest) = split(",", $tempfs[$i],2);
   if ($fs =~ /\*$/) {
      splice(@tempfs, $i,1);
      my(@data) = `$CMDls -d1 $fs`;
      chomp(@data);
      foreach $fs (@data) {
         push @tempfs, "$fs" . (defined($rest) ? ",$rest" : "");
         }
      }
   }

@copydirs = @tempcopy if defined(@tempcopy);
@ufsdirs = @tempscan if defined(@tempscan);
@cachefs = defined(@tempfs) ? @tempfs : @ufsdirs;
close(CONFIG);
}

sub reReadConfig {
readConfig($cfgfn);
}

#===================================================================
# Subroutine to unlock a file
#
# Input: file handle for opened file
#        file name for messages
#===================================================================
sub unlock {
my($fh, $file) = @_;

if (!Flock($fh, $LOCK_UN)) {
   logerr("unlock: flock failed for $file, $!",'ul');
   }
close($fh);
logit("unlock: unlocking file $file") if $debug >= $DEBUG;
}

#=============================================================================
sub update_ctrs {
    my($num,$bytes,$elap,$fail) = @_;
    return if !$migrctrsfn;
    my($fh) = getlock(">>$migrctrsfn.lock",$LOCK_EX, $LOCKNOERR);   
    return if !$fh;
    open(CTRS,"$migrctrsfn");
    my($data) = <CTRS>;
    close(CTRS);
    open(CTRS,">$migrctrsfn");
    my($onum,$obytes,$oelap,$ofail) = split(' ',$data);
    printf(CTRS "%15.0f %15.0f %15.0f %15.0f\n",
           $onum+$num, $obytes+$bytes, $oelap+$elap, $ofail+$fail);
    close(CTRS);
    unlock($fh,"$migrctrsfn.lock");
    return;
}

#===================================================================
# Subroutine to process signals
#
# Input: type of signal trapped
#===================================================================
sub wakeup {
my($sig) = @_;

# When a migrate process terminates, it will wakeup the parent with a
# USR1 signal so that another migrate process can be started.
}
