#!/usr/local/bin/perl

# $Id: mps_Xeq,v 1.5 2005/06/07 05:03:06 abh Exp $

# (C) 2000 by the Board of Trustees of the Leland Stanford, Jr., University
#                          All Rights Reserved
# Produced by Andrew Hanushevsky for Stanford University under contract
#            DE-AC03-76-SFO0515 with the Deprtment of Energy

#Syntax:

#     ooss_Xeq [-r cfg] [{ac|an|cp|cr|ds|ff|fl|mk|mv|nb|nl|pf|rl|rm|vn}
#                 opts & parms]

# ooss_Xeq performs varios cache management routine:

#          ac - audit cache disk(s)
#          an - audit name space
#          cp - copy a file
#          cr - create a file
#          ds - desparse file    (synonyms: desparse)
#          ff - find fail files  (synonyms: fl and ffail)
#          fl - find lock files  (synonyms: nl and nolk)
#          mk - make a lock file (sunonym:  mklk)
#          mv - rename a file
#          nb - find non-migrated(sysnonym: nm)
#          nl - find lock files  (synonyms: nl and nolk)
#          pf - pin file         (synonym:  pin)
#          rl - relocate file    (synonym:  reloc)
#          rm - remove a file
#          vn - version numbers  (synonym:  version)

# If no arguments are given, then input is obtained from standard is where
# each line is treated as a command args until a null line is encountered.

# The partucular options that are valid for each operation are:

# ac [-bl [-e] [-i] [-m[f]] [-v] cache_fs [cache_fs [. . .] ]

# an [-e] [-i] [-m[f]] [-r] [-v] dirpath [dirpath [. . .] ]

# cp [all ooss_Stage options] <sourcefn> <targetfn>

# cr [all ooss_Stage options] <targetfn>

# ds <fname> [<fname> . . . ]

# ff [-r] <dir> [. . .]

# fl [-r] <dir> [. . .]

# mk [-[m]f] [-[m]c] [-o owner] <base_name> [<base_name . . .]

# mv [-l] <sourcefn> <targetfn>

# pf [i noref_time] [-k keep_time] [-o owner] <fname> [<fname> . . . ]

# nb [-r] <dir> [. . .]

# nl [-r] <dir> [. . .]

# rl      <sourcefn> <targetfs>

# rm [-a] <targetfn>

# vn [<targetpath>]

# options:

#  -a  - remove the file in all locations (i.e., locally and the mass storage
#        system. Otherwise, only the local copy is removed.

#  -b  - rebuild name space by creating symlinks to the cached files o/w
#        simply report missing symboloc links.

#  -c  - Create a lock file with the current time which should be
#        greater than or equal to the base file time. Otherwise
#        the time of the file will be less than the base file and
#        will cause the base file to be migrated before it's purged.
#        The -mc option is a synonym for -c.

#  -e  - for ac: erase cache files that do not correspond to proper naming
#                conventions or conflict with an existing symlink o/w just
#                report the problem.
#        for an: erase symlinks that point to nowhere o/w report the problem.

#  -i  - ask for confirmation before removing or creating anything. For pf
#        the amount of time a file must be unreferenced before it can be
#        purged as nnn[d | h | m | s].

#  -k  - the amount of time to keep the file in the disk cache. Specify
#        nnn[d | h | m | s] | mm/dd/yy[yy] | forever | unused

#  -l  - perform the operation locally (i.e., don't replicate the operation
#        in the remote mass storage system).

#  -m  - consider the space migratable lock files report missing lock files.

#  -mc - create missing lock files with lockdate >= filedate (i.e., nomigrate)

#  -mf - like -mc but the lockdate < filedate in order to force migration.

#  -o  - specifies the owner of the lock/pin file otherwise it will
#        default to the same ownership as the base file.

#  -r  - recursively traverse the directory (the deafult).

#  -R  - do not recursively traverse the directory.

#  -v  - blab about things that are ok as well as problems.

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

# 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 ($@);
use Cwd;
require "timelocal.pl";

$STRINGS_CMD = '/usr/bin/strings';
$GREP_CMD = '/bin/grep';
$PS_CMD   = '/bin/ps';
$MV_CMD   = '/bin/mv';
$LS_CMD   = '/bin/ls';
$DD_CMD   = '/bin/dd';
$CP_CMD   = '/bin/cp';
$SF_CMD   = ($isMPS ? '/opt/xrootd/utils/mps_Stage'
                    : '/usr/etc/ooss/ooss_Stage');
$TF_CMD   = '/bin/touch';
$RX_CMD   = ($isMPS ? '/opt/xrootd/utils/rxmss'
                    : '/usr/etc/ooss/rxhpss');
$CFG_FN   =  ($isMPS ? '/opt/xrootd/etc/xrootd.cf'
                     : '/usr/etc/ooss/ooss_mps.cf');

@Stems    = ('.anew', '.fail', '.lock', '.map', '.pin', '.stage');

$CCHAR    = '%';   # Cache control separator
$PathMode = 02775;
$Hidden   = 0;     # Control files are not hidden

$GID = split(' ', "$)", 2);
$MYGID = $GID;
$MustOpen = 0;

# Obtain config file, if present.
#
  if ($ARGV[0] eq '-c')
     {shift; $CFG_FN = shift;
      die $SSD."_Xeq: Config file not specified.\n" if $CFG_FN eq '';
      $MustOpen = 1;
     }

# Check if we need to process the configuration file
#
  if ($MustOpen || -r $CFG_FN)
     {my(@recs, $line);
      die $SSD."_Xeq: $! opening $CFG_FN\n" if !open(CFGFH, "<$CFG_FN");
      @recs = <CFGFH>;
      close(CFGFH);
      foreach $line (@recs)
              {   if ($line =~ m/^(hidden |$SSD\.hidden |$SSD\.stage\.hidden)/)
                     {chomp($line); ($x, $Hidden) = split(' ', $line, 2);}
               elsif ($line =~ m/^($SSD\.msscmd |$SSD\.stage\.msscmd)/)
                  {chomp($line); ($x, $RX_CMD) = split(' ', $line, 2);}
              }
     }

# Verify that all required files exist
#
# Check_Files($CP_CMD, $DD_CMD, $SF_CMD, $TF_CMD, $RX_CMD);

# Process the command line or standard input
#
  $rc = 0;
  if (scalar(@ARGV)) {$rc = &Xeq(@ARGV)}
     else {select STDOUT; $| = 1;
           print($SSD."_Xeq: ");
           while (defined($line = <STDIN>))
                 {chomp($line);
                  last if $line eq '';
                  @args = split(/\s+/, $line);
                  next if $args[0] eq '';
                  if (($x = &Xeq(@args)) > $rc) {$rc = $x}
                  print($SSD."_Xeq: ");
                 }
          }
   exit $rc;

#******************************************************************************
#*                                   X e q                                    *
#******************************************************************************
 
sub Xeq {my(@argv) = @_;
    my($rc);

# Get command
#
  $cmd = shift(@argv);

# Fan out based on command
#
     if ($cmd eq 'ac')                      {$rc = &Xeq_ac($cmd, @argv)}
  elsif ($cmd eq 'an')                      {$rc = &Xeq_an($cmd, @argv)}
  elsif ($cmd eq 'cp' || $cmd eq 'cr')      {$rc = &Xeq_cpr($cmd, @argv)}
  elsif ($cmd eq 'ds' || $cmd eq 'desparse'){$rc = &Xeq_ds($cmd, @argv)}
  elsif ($cmd eq 'ff' || $cmd eq 'ffail')   {$rc = &Xeq_ff($cmd, @argv)}
  elsif ($cmd eq 'nl' || $cmd eq 'nolk' || $cmd eq 'fl')
                                            {$rc = &Xeq_fl($cmd, @argv)}
  elsif ($cmd eq 'mk' || $cmd eq 'mklk')    {$rc = &Xeq_mk($cmd, @argv)}
  elsif ($cmd eq 'mv')                      {$rc = &Xeq_mv($cmd, @argv)}
  elsif ($cmd eq 'pf' || $cmd eq 'pin')     {$rc = &Xeq_pf($cmd, @argv)}
  elsif ($cmd eq 'rl' || $cmd eq 'reloc')   {$rc = &Xeq_rl($cmd, @argv)}
  elsif ($cmd eq 'rm')                      {$rc = &Xeq_rm($cmd, @argv)}
  elsif ($cmd eq 'vn' || $cmd eq 'version') {$rc = &Xeq_vn($cmd, @argv)}
  elsif ($cmd eq 'nb' || $cmd eq 'nm')      {$rc = &Xeq_nb($cmd, @argv)}
  else  {$rc = &Emsg(4, "unknown command, '$cmd'.")}

  return $rc;
}
#******************************************************************************
#*                                X e q _ a c                                 *
#******************************************************************************
 
sub Xeq_ac {my($cmd, @argv) = @_;
    local($Build, $Erase, $Iactive, $Migchk, $Migok, $Migforce, $Verbose);
    my($nogo, $fs);

# Get the options
#
  while (substr($argv[0], 0, 1) eq '-') {
     $op = shift(@argv);
        if ($op eq '-b' ) {$Build   = 1}
     elsif ($op eq '-e' ) {$Erase   = 1}
     elsif ($op eq '-i' ) {$Iactive = 1}
     elsif ($op eq '-m' ) {$Migchk  = 1}
     elsif ($op eq '-mc') {$Migchk  = 1; $Migok = 1;}
     elsif ($op eq '-mf') {$Migchk  = 1; $Migok = 1; $Migforce = 1;}
     elsif ($op eq '-v' ) {$Verbose = 1}
     else {return &Emsg(4, "Invalid option '$op'.")}
     }

# Check if any cache file systems have been specified
#
  return &Emsg(4, 'no cache filesystems specified.') if $argv[0] eq '';

# Process each filesystem
#
  $nogo = 0;
  while ($fs = shift(@argv))
     {$fs .= $c if (($c = chop($fs)) ne '/');
      if ($c eq '*') {my(@dlist)=ExpandDir($fs); unshift(@argv, @dlist); next;}
      $nogo |= &Xeq_acfs($fs);
     }
  return 4*$nogo;
}

#******************************************************************************

sub Xeq_acfs {my($fs) = @_;
    my($dent, $cfn, $path, $OK);

# Perform standard checks
#
  return &Emsg(1, "'$fs' is not a directory.") if !-d $fs;
  return &Emsg(1, "unable to open directory $fs; $!.") if !opendir(DIRFH, $fs);

# Start listing out the contents of the filesystem
#
  $OK = 1;
  while (defined($dent = readdir(DIRFH)))
     {next if $dent eq '.' || $dent eq '..' || $dent eq 'lost+found';
      $cfn = "$fs/$dent";
         if (substr($dent, 0, 1) ne $CCHAR) 
            {$OK &= &Xeq_acrm($cfn, 'Improper name')}
      elsif (!-f $cfn)                      
            {$OK &= &Xeq_acrm($cfn, 'Not a data file')}
      else {$path = $dent;
            $path =~ tr:%:/:; # $path =~ tr:$CCHAR:/:
            if (!-l $path) {$OK &= &Xeq_acsl($cfn, $path)}
         elsif (&Xeq_acok($cfn, $path) && &Lock_OK($path, $cfn))
               {&Say("$cfn passed audit.") if $Verbose}
         else  {$OK = 0}
           }
     }
  return &Emsg(1, "error closing $fs; $!.") if !closedir(DIRFH);
  return !$OK;
}

#******************************************************************************

sub Xeq_acok {my($cfn, $path) = @_;
    my($lnk);
    $lnk = readlink($path);
    return &Emsg(0, "unable to read link $path; $!") if !defined($lnk);
    $lnk =~ tr:/:/:s;

# Verify that the link contains what we expect
#
    return 1 if $lnk eq $cfn;

# If the contents differs, then remove the file if the link target exists.
# Otherwise remove the link and rehook it to the target.
#
  return &Xeq_acrm($cfn, "Inconsistent symlink", " -> $lnk")
         if (-f $path || -e $path || -d $path);
  return &Xeq_acsl($cfn, $path);
}

#******************************************************************************

sub Xeq_acrm {my($cfn, $msg, $msg2) = @_;
    my($sfx);

# First indicate what the problem is then delete the file is we should do so.
#
  &Say($msg.': '.$cfn.$msg2);
  return 0 if !$Erase || !&Ask("Remove file?");
  if (-d $cfn)
     {return &Emsg(0, "unable to remove $cfn, $!.") if !rmdir($cfn)}
     else
     {return &Emsg(0, "unable to remove $cfn, $!.") if !unlink($cfn)}

# Remove any other files that may be associated with this file
#
  foreach $sfx (@Stems) {unlink(&mush($cfn.$sfx))}
  return 1;
}

#******************************************************************************

sub Xeq_acsl {my($cfn, $path) = @_;

# The target may exist already and not be a symbolic link, check this out
#
  return &Xeq_acrm($cfn, "Duplicate symlink", "($path already exists)")
         if (-e $path || -d $path);

# If non-linked files are to be erased
#
  return &Xeq_acrm($cfn, "Missing symlink") if $Erase;

# Indicate the problem and create the symlink if we should do so.
#
  &Say("Missing symlink: $cfn");
  return 0 if !$Build || !&Ask("Create symlink?");
  unlink($path);
  return 0 if !&Build_Path($path);
  return &Emsg(0, "unable to create symlink $path to $cfn; $!")
         if !symlink($cfn, $path);
  return 1;
}

#******************************************************************************
#*                                X e q _ a n                                 *
#******************************************************************************

sub Xeq_an {my($cmd, @argv) = @_;
    local($Erase, $Iactive, $Migchk, $Migok, $Migforce, $Recurse, $Verbose);
    my($nogo, $fs);
    $Recurse = 1;

# Get the options
#
  while (substr($argv[0], 0, 1) eq '-') {
     $op = shift(@argv);
        if ($op eq '-e' ) {$Erase   = 1}
     elsif ($op eq '-i' ) {$Iactive = 1}
     elsif ($op eq '-m' ) {$Migchk  = 1}
     elsif ($op eq '-mc') {$Migchk  = 1; $Migok = 1;}
     elsif ($op eq '-mf') {$Migchk  = 1; $Migok = 1; $Migforce = 1;}
     elsif ($op eq '-r' ) {$Recurse = 1}
     elsif ($op eq '-R' ) {$Recurse = 0}
     elsif ($op eq '-v' ) {$Verbose = 1}
     else {return &Emsg(4, "Invalid option '$op'.")}
     }

# Check if any cache file systems have been specified
#
  return &Emsg(4, 'no cache filesystems specified.') if $argv[0] eq '';

# Process each filesystem
#
  $nogo = 0;
  foreach $fs (@argv) 
     {$fs .= $c if (($c = chop($fs)) ne '/');
      $nogo |= &Xeq_anfs($fs);
     }
  return 4*$nogo;
}

#******************************************************************************

sub Xeq_anfs {my($fs) = @_;
    my($dent, @dlist, @newdirs, $OK, $OK1);

# Perform standard checks
#
  return &Emsg(0, "'$fs' is not a directory.") if !-d $fs;
  return &Emsg(0, "unable to open directory $fs; $!.") if !opendir(DIRFH, $fs);

# Get complete contents of the directory
#
  @dlist = readdir(DIRFH);
  return &Emsg(0, "error closing $fs; $!.") if !closedir(DIRFH);

# Process all files first saving directory entries for later
#
  $OK = 1;
  foreach $dent (@dlist)
     {next if $dent eq '.' || $dent eq '..';
      $dent = $fs.'/'.$dent;
      if (-d $dent) {push(@newdirs, $dent); next;}
         if (-l $dent) {$OK1 = &Xeq_ansl($dent)}
      elsif (!($dent =~ m/\.(lock|fail|stage|anew|map)$/))
                       {$OK1 = &Lock_OK($dent, $dent)}
      else  {next}
      &Say("$dent passed audit.") if $OK1 && $Verbose;
      $OK &= $OK1;
     }

# Recurse on each directory if recursion wanted
#
  if ($Recurse)
     {foreach $dent (@newdirs) {$OK |= &Xeq_anfs($dent)}}

# All done
#
  return !$OK;
}

#******************************************************************************

sub Xeq_ansl {my($path) = @_;
    my($lnk);
    $lnk = readlink($path);
    return &Emsg(0, "unable to read link $path; $!") if !defined($lnk);

# Verify that the target exists
#
    return &Xeq_acrm($path, "Dangling symlink", " ($lnk does not exist)") 
           if !-e $lnk;

# Return result of lock file check
#
    return &Lock_OK($path, $lnk);
}
 
#******************************************************************************
#*                               X e q _ c p r                                *
#******************************************************************************
 
sub Xeq_cpr {my($cmd, @argv) = @_;
    my($i, $l, $n, @opt);

# All options are valid. Two arguments must be supplied for cp and only one
# for cr. Check what is wanted and insert out own option appropriately.
#
  $n = $#argv;
  if ($cmd eq 'cp') {$i = $n-1; $l = 2;
                     if ($i < 0) 
                        {return &Emsg(4, 'target filename not specified.')}
                     @opt = ('-x', "$CP_CMD %sfn %tfn");
                    }
     else           {$i = 0;   $l = 1;
                     if ($n > 0)
                        {return &Emsg(4, "extraneous parameter, '$argv[1]'.")}
                     @opt = ('-x', "$TF_CMD %tfn", $argv[0]);
                    }

# Now insert our argument
#
  push(@argv, splice(@argv, $i, $l, @opt));

# Now execute the command
#
  return system($SF_CMD, @argv);
}

#******************************************************************************
#*                                X e q _ d s                                 *
#******************************************************************************

sub Xeq_ds {my($cmd, @argv) = @_;
    my($op, $fn, $Count, $Fcnt, $sfn, $tfn, @fstat, $resp);

# Get the options (there should be none)
#
  while (substr($argv[0], 0, 1) eq '-') {
     $op = shift(@argv);
     return &Emsg(4, "Invalid option '$op'.")
     }

# Get the paramneters.
#
  return &Emsg(4, 'file name not specified.') if (!$argv[0]);

# Process all of the base files
#
  $Count = 0; $Fcnt = 0;
  while ($sfn = shift(@argv)) {

     # Get the base file name
     #
       if (-l $sfn)
          {return &Emsg(0, "unable to read link $sfn; $!.")
                  if !defined($fn = readlink($sfn));
          }
          else {$fn = $sfn}

     # Make sure the file exists
     #
       return &Emsg(4, "file $sfn does not exist.") if !-e $fn;
       $Fcnt++;

     # If the uid differs from ours, make sure we are root
     #
       @fstat = stat($fn);
       return &Emsg(0,"Cannot desparse '$sfn' for uid/gid $fstat[4]/$fstat[5].")
           if ($> &&
              (($fstat[4] != $>) ||
              (($fstat[5] != $MYGID) && index(' '.$), ' '.$fstat[5]) == -1)) );

     # Make sure the file is really sparse
     #
       if (512*$fstat[12] >= $fstat[7])
          {&Emsg(0, "File $fn is not sparse."); next;}

     # Create a name for the temporary file
     #
       $i = 0;
       do {$tfn = "$fn.$i.anew"; $i++;} while(-e $tfn);

     # Copy the source file to the target file
     #
       $resp = CopyFile($fn, $tfn);
       return &Emsg(4, $resp) if $resp;

     # Rename the file
     #
       if (!rename($tfn, $fn))
          {$resp = "$!"; unlink($tfn);
           return &Emsg(4, "unable to rename $tfn; $resp.")
          }
       $Count++;
     }

# All done
#
  Say($SSD."_Xeq: $Count out of $Fcnt file(s) desparsed.");
  return(0);
}

#******************************************************************************
#*                                X e q _ f f                                 *
#******************************************************************************
 
sub Findff {my($fn) = @_; return ($fn =~ /\.fail$/);} ;

sub Xeq_ff {my($cmd, @argv) = @_;
    my($xeq, $fn);
    my($recurse) = 1;
    my($ok) = 0;

# Get the options
#
  while (substr($argv[0], 0, 1) eq '-') {
     $op = shift(@argv);
        if ($op eq '-r') {$recurse = 1}
     elsif ($op eq '-R') {$recurse = 0}
     else {return &Emsg(4, "Invalid option '$op'.")}
     }

# Get the paramneters.
#
  return &Emsg(4, 'find path not specified.') if (!$argv[0]);

# Construct the command line
#
  my($xcwd) = cwd();
  foreach $fn (@argv) {$ok |=  scan($xcwd, $fn, $recurse, \&Findff)}
  return ($ok ? 0 : 2);
}

#******************************************************************************
#*                                X e q _ f l                                 *
#******************************************************************************
 
sub Findlf {my($fn) = @_;
   return 0
     if ($fn =~ /\.anew|\.fail|\.map|\.migr|\.pin|\.stage|\.lock|DIR_LOCK$/);
   return !(-f &mush($fn.'.lock'));
}  ;

sub Xeq_fl {my($cmd, @argv) = @_;
    my($xeq, $fn);
    my($recurse) = 1;
    my($ok) = 0;

# Get the options
#
  while (substr($argv[0], 0, 1) eq '-') {
     $op = shift(@argv);
        if ($op eq '-r') {$recurse = 1}
     elsif ($op eq '-R') {$recurse = 0}
     else {return &Emsg(4, "Invalid option '$op'.")}
     }

# Get the paramneters.
#
  return &Emsg(4, 'find path not specified.') if (!$argv[0]);

# Construct the command line
#
  my($xcwd) = cwd();
  foreach $fn (@argv) {$ok |=  scan($xcwd, $fn, $recurse, \&Findlf)}
  return ($ok ? 0 : 2);
}

#******************************************************************************
#*                                X e q _ f l                                 *
#******************************************************************************
 
sub Findnb {my($fn) = @_;
   return 0
     if ($fn =~ /\.anew|\.fail|\.map|\.migr|\.pin|\.stage|\.lock|DIR_LOCK$/);
   my($lockfn) = &mush($fn.'.lock');
   return 0 if (!(-f $lockfn));
   return (stat($fn))[9] > (stat($lockfn))[9];}  ;

sub Xeq_nb {my($cmd, @argv) = @_;
    my($xeq, $fn);
    my($recurse) = 1;
    my($ok) = 0;

# Get the options
#
  while (substr($argv[0], 0, 1) eq '-') {
     $op = shift(@argv);
        if ($op eq '-r') {$recurse = 1}
     elsif ($op eq '-R') {$recurse = 0}
     else {return &Emsg(4, "Invalid option '$op'.")}
     }

# Get the paramneters.
#
  return &Emsg(4, 'find path not specified.') if (!$argv[0]);

# Construct the command line
#
  my($xcwd) = cwd();
  foreach $fn (@argv) {$ok |=  scan($xcwd, $fn, $recurse, \&Findnb)}
  return ($ok ? 0 : 2);
}


#******************************************************************************
#*                                X e q _ m k                                 *
#******************************************************************************
 
sub Xeq_mk {my($cmd, @argv) = @_;
    my($Basefn, $Btemp, $Count, $Fcnt, $uid, $gid);
    my($ok) = 1; my($Current) = 0;

# Obtain the options
#
  while (substr($argv[0], 0, 1) eq '-') {
     $op = shift(@argv);
        if ($op eq '-c' || $op eq '-mc') {$Current  = 1}
     elsif ($op eq '-f' || $op eq '-mf') {$Current  = 0}
     elsif ($op eq '-o') {($ok, $uid, $gid) = get_owner(shift(@argv))}
     else {return &Emsg(4, "Invalid option '$op'.")}
     }
  return 4 if !$ok;

# Make sure base file name has been specified
#
  return &Emsg(4, 'Base file name not specified.') if !$argv[0];

# Process all of the base files
#
  $Count = 0; $Fcnt = 0;
  while ($Basefn = shift(@argv)) {

     # Create the file
     #
     # Make sure the base file exists and
     #
       if (!-f $Basefn || !(@fstat = stat($Basefn)))
          {&Emsg(1, "File '$Basefn' does not exist.");
           next;
          }
       $Btemp = &mush($Basefn).'.lock.TEMP';
       if (!FileMake($Basefn, $Btemp, $uid, $gid, '')) {$Fcnt++; next;}

     # Set the correct time
     #
       if (!$Current && !utime($fstat[9]-113, $fstat[9]-113, $Btemp))
          {&Emsg(0, "Unable to set file time for '$Btemp'; $!.");
           $Fcnt++; unlink($Btemp); next;
          }

     # Now rename the file to be the right thing
     #
       if (!rename($Btemp, &mush($Basefn).'.lock'))
          {&Emsg(0, "Unable to rename '$Btemp'; $!.");
           $Fcnt++; unlink($Btemp); next;
          }
       $Count++;
     }

# All done
#
  Say($SSD."_Xeq: $Count lock file(s) created.");
  return($Fcnt);
}

#******************************************************************************
#*                                X e q _ m v                                 *
#******************************************************************************
 
sub Xeq_mv {my($cmd, @argv) = @_;
    my($srcfile, $sfn, $tfn, $op, $Local, $OK);
    my($rc) = 0;

# Get the options
#
  while (substr($argv[0], 0, 1) eq '-') {
     $op = shift(@argv);
        if ($op eq '-l') {$Local = 1}
     else {return &Emsg(4, "Invalid option '$op'.")}
     }

# Get the paramneters.
#
     if (!($sfn = shift(@argv))) {return &Emsg(4, 'old name not specified.')}
  elsif (!($tfn = shift(@argv))) {return &Emsg(4, 'new name not specified.')}
  elsif ($argv[0])      {return &Emsg(4, "extraneous parameter - $argv[0].")}

# Make sure the target file does not exist
#
  return &Emsg(4, "$tfn already exists.") if -e $tfn;

# Now copy over all the special files ahead of time
#
  foreach $sfx (@Stems)
          {$srcfile = &mush($sfn).$sfx;
           return &Emsg(4, "Unable to create file '$srcfile'.")
                  if -e $srcfile && 
                     system($CP_CMD,'-p',$srcfile,&mush($tfn).$sfx);
          }

# Perform the remote execution of the command
#
  $rc = &Xeq_Remote('mv', $sfn, $tfn) if !($Local);

# If the target is a symbolic link, then we have a lot more work to do o
#
  if (-l $sfn) {$OK = &Xeq_mvsl($sfn, $tfn)}
     else {$OK = rename($sfn, $tfn)}

# Tell the olbd that the original file is gone
#
  FileGone($sfn) if $OK;

# Now cleanup the local files, as needed
#
  if (!$OK) {$rc = &Emsg(4, "unable to rename $sfn; $!.")}
  foreach $sfx (@Stems)
          {if ($OK) {unlink(&mush($sfn).$sfx)}
              else  {unlink(&mush($tfn).$sfx)}
          }

# All done
#
  return $rc;
}

sub Xeq_mvsl {my($sfn, $tfn) = @_;
    my($lnk, $newlnk, $path, $fn);

# Find out where the file is in the cache
#
  return &Emsg(0, "unable to read link $sfn; $!.") 
         if !defined($lnk = readlink($sfn));
  return &Emsg(0, "cache file $lnk does not exist") if !-e $lnk;

# Create the new target name and make sure it does not exist
#
  $newlnk = $tfn;
  $newlnk =~ tr:/:%:; # $newlnk =~ tr:/:$CCHAR:
  ($path, $fn) = &DirFn($lnk);
  $newlnk = $path.$newlnk;
  return &Emsg(0, "rename conflict; cache file $newlnk already exists.")
         if -e $newlnk;

# Create the new symbolic link first
#
  unlink($tfn); # Just in case we have a dead symlink
  return &Emsg(0, "unable to create new symlink; $!.")
         if !symlink($newlnk, $tfn);

# Rename the file in the cache
#
  if (!rename($lnk, $newlnk))
     {&Emsg(0, "unable to rename cache file $lnk; $!.");
      unlink($tfn);
      return 0;
     }

# Remove the original link
#
  unlink($sfn);
  return 1;
}

#******************************************************************************
#*                                X e q _ p f                                 *
#******************************************************************************
 
sub Xeq_pf {my($cmd, @argv) = @_;
    my($v, $Count, $Fcnt, $Chown, $Chgrp, $uid, $gid);
    my($ok) = 1;
    my($inact) = 0;
    my($mtime) = time() + 24*3600; # default keep time = 24h
    my($forever) = 0;
    my($unused) = 0;

# Obtain the options
#
  while (substr($argv[0], 0, 1) eq '-') {
     $op = shift(@argv);
        if ($op eq '-i') {$inact = &get_intvl(shift(@argv),0);}
     elsif ($op eq '-k') {$v = shift(@argv); $forever = 0; $unused = 0;
                             if ($v eq 'forever') {$forever=1; $mtime=time();}
                          elsif ($v eq 'unused')  {$unused =1}
                          elsif ($v =~ m|^(\d+)/(\d+)/(\d+)$|)
                                       {$mtime = get_date($1,$2,$3)}
                          else  {if (($v = get_intvl($v,1)) < 0 ) {$mtime = -$v;}
                                    else  {$mtime = time() + $v;}
                                }
                         }
     elsif ($op eq '-o') {($ok, $uid, $gid) = &get_owner(shift(@argv))}
     else {return &Emsg(4, "Invalid option, '$op'.")}
     }
  return 4 if !$ok || !defined($inact) || !defined($mtime);

# Make sure base file name has been specified
#
  return &Emsg(4, 'Base file name not specified.') if !$argv[0];

# Set correct pin data
#
  my($pdata) = ($inact ? "&inact_time=$inact\n" : '');

# Process all of the base files
#
  $Count = 0; $Fcnt = 0;
  while ($Basefn = shift(@argv)) {

     # If unused requested, then time set on file directly
     #
       if ($unused)
          {if (!-e $Basefn) {&Emsg(0, "File $Basefn does not exist");
                             $Fcnt++; next;
                            }
           if (!utime(0, 0, $Basefn))
              {&Emsg(0, "Unable to set file time for '$Basefn'; $!.");
               $Fcnt++; next;
              }
           unlink(&mush($Basefn).'.pin');
           next;
          }

     # Create the file
     #
       $Btemp = &mush($Basefn).'.pin.TEMP';
       if (!FileMake($Basefn, $Btemp, $uid, $gid, $pdata)) {$Fcnt++; next;}

     # Set the correct time
     #
       if (!utime(time(), $mtime, $Btemp))
          {&Emsg(0, "Unable to set file time for '$Btemp'; $!.");
           $Fcnt++; unlink($Btemp); next;
          }

     # Set correct mode
     #
       if ($forever && !chmod(04644, $Btemp))
          {&Emsg(0, "Unable to set file mode for '$Btemp'; $!.");
           $Fcnt++; unlink($Btemp); next;
          }

     # Now rename the file to be the right thing
     #
       if (!rename($Btemp, &mush($Basefn).'.pin'))
          {&Emsg(0, "Unable to rename '$Btemp'; $!.");
           $Fcnt++; unlink($Btemp); next;
          }
       $Count++;
     }

# All done
#
  Say($SSD."_Xeq: $Count pin file(s) created.");
  return($Fcnt);
}

#******************************************************************************
#*                                X e q _ r l                                 *
#******************************************************************************
 
sub Xeq_rl {my($cmd, @argv) = @_;
    my($sfn, $tfs, @sstat, @tstat, $c, $tfn);

# Get the source filename and the target filesystem
#
  return &Emsg(4, 'source filename not specified.')
         if !($sfn = shift(@argv));
  return &Emsg(4, "file $sfn does not exist.") if !-e $sfn;
  return &Emsg(4, 'target filesystem not specified.')
         if !($tfs = shift(@argv));
  return &Emsg(4, "filesystem $tfs does not exist.") if !-e $tfs;
  $tfs .= $c if (($c = chop($tfs)) ne '/');

# Make sure that the file is not already in the right filesystem
# 

# However if the file is not in cachefs, then proceed to convert it to fs

  @sstat = stat($sfn); @tstat = stat($tfs);
  return &Emsg(0, "file $sfn already in filesystem $tfs.")
         if (-l $sfn && $sstat[0] == $tstat[0]);

# Construct the target filename
#
  $tfn = $sfn;
  $tfn =~ tr:/:%:; # $tfn =~ tr:/:$CCHAR:
  $tfn = $tfs.'/'.$tfn;

# Make sure the target does not exist
#
  return &Emsg(4, "cache file $tfn already exist.") if -e $tfn;

# Just make a hard link if a file already in cache.
# 
if (! -l $sfn && $sstat[0] == $tstat[0]) {
    if (!link $sfn, $tfn.".anew") {
	return &Emsg(4, "unable to link $tfn to $sfn $!.");
    }
}
# Otherwise Copy the source file to the target file
#
else {
  $resp = CopyFile($sfn, "$tfn.anew");
  return &Emsg(4, $resp) if $resp;
}

# Handle symlinks correctly
#
  if (!&Xeq_rlsl($sfn, $tfn)) {unlink($tfn.'.anew'); return 4;}

# Rename the file
#
  return &Emsg(4, "unable to rename $tfn.anew; $!.")
         if !rename($tfn.'.anew', $tfn);
  return 0;
}

#******************************************************************************

sub Xeq_rlsl {my($sfn, $tfn) = @_;


# Get the original file source
#
  if (-l $sfn) {return &Emsg(0, "unable to read symlink $sfn; $!.")
                       if !defined($src = readlink($sfn))}

# Rename the old file to save it and create symlink to the new file
#
  return &Emsg(0, "unable to rename $sfn; $!.")
         if !rename($sfn, $sfn.'.old');
  if (!symlink($tfn, $sfn))
     {&Emsg(0, "unable to create symlink $sfn; $!.");
      rename($sfn.'.old', $sfn);
      return 0;
     }

# Erase the original source and renamed link
#
  &Emsg(0, "unable to remove $src; $!.") if $src && !unlink($src);
  &Emsg(0, "unable to remove $sfn.old; $!.")     if !unlink($sfn.'.old');
  return 1;
}
 
#******************************************************************************
#*                                X e q _ r m                                 *
#******************************************************************************
 
sub Xeq_rm {my($cmd, @argv) = @_;
    my($tfn, $op, $Link);
    my($rc) = 0; my($Local) = 1;

# Get the options
#
  while (substr($argv[0], 0, 1) eq '-') {
     $op = shift(@argv);
        if ($op eq '-a') {$Local = 0}
     else {return &Emsg(4, "Invalid option '$op'.")}
     }

# Get the paramneters.
#
     if (!($tfn = shift(@argv))) {return &Emsg(4, 'file name not specified.')}
  elsif ($argv[0])       {return &Emsg(4, "extraneous parameter - $argv[0].")}

# If the target is a symbolic link, make sure we remove the target file
#
  if (-l $tfn)
     {return &Emsg(4, "unable to read symlink $tfn; $!.")
                  if (!($Link = readlink($tfn)));
      return &Emsg(4, "unable to handle relative symlink, '$Link'.")
                  if (substr($Link, 0, 1) ne '/');
      $Link = '' if !-e $tfn;
     } else {$Link = ''}

# Perform the remote execution of the command
#
  $rc = &Xeq_Remote('rm', $tfn) if !($Local);

# Now do the local variant of this (no need to really lock the directory).
#
     if ($Link && !unlink($Link))
        {$rc = &Emsg(4, "unable to remove $Link; $!.")}
  elsif (!unlink($tfn)) 
        {$rc = &Emsg(4, "unable to remove $tfn; $!.")}
  else  {FileGone($tfn);
         foreach $sfx (@Stems) {unlink(&mush($tfn).$sfx)}
        }

# All done
#
  return $rc;
}

#******************************************************************************
#*                            X e q _ R e m o t e                             *
#******************************************************************************
 
sub Xeq_Remote {my(@cmd) = @_;

# Issue system command to execute this remote command
#
  return system($RX_CMD, @cmd);
}

#******************************************************************************
#*                                X e q _ v n                                 *
#******************************************************************************
  
sub Xeq_vn {my($cmd, $path, @argv) = @_; my(@resp, @line, $vers, $lib);

# Only one path allowed
#
  if ($argv[0]) {return &Emsg(4, "extraneous parameter - $argv[0].")}

# If no path specified, find a running ams server and use that path
#
  if ($path eq '')
     {@resp = `$PS_CMD -ef | $GREP_CMD 'ooams *xyzzy'`;
      return &Emsg(4, "AMS is not running.") if ($? || !$resp[0]);
      ($path) = $resp[0] =~ m:.* /(.*)ooams:;
      $path = '/'.$path;
      }
     else {$path = "$path/";}

# Find all the shared libraries in this directory
#
  @resp = `$LS_CMD -1 $path/lib*so`;
  return &Emsg(4,"No libraries found in $path.") if ($? || !$resp[0]);
  chomp(@resp);
  push(@resp, $path.'ooams');

# get the version of each library and print the result
#
  foreach $lib (@resp)
     {$lib =~ tr:/:/:s;
      @line = `$STRINGS_CMD $lib | $GREP_CMD 'Vers'`;
      $line[0] =~ tr:\t::d; $line[0] =~ tr: : :s;
      if (!(($vers) = $line[0] =~ m:.*Vers.* ((\d|\.)+):)) {$vers = 'unknown'};
     printf "Ver %8s %s\n", $vers, $lib;
     }
return 0;
}

#******************************************************************************
#*                           C h e c k _ F i l e s                            *
#******************************************************************************
 
sub Check_Files {my(@Flist) = @_;
    my($fn); my($rc) = 0;

    foreach $fn (@Flist)
       {$rc = &Emsg(4, "executable $fn not found.") if !-x $fn;}

    return if !$rc;
    exit(4);
}
#******************************************************************************
#*                            B u i l d _ P a t h                             *
#******************************************************************************

sub Build_Path {my($path) = @_;
    my($Tdir, $Tfn,@dirs, $mkpath, $dname);

# Obtain the directory in which the target file resides
#
  ($Tdir, $Tfn) = &DirFn($path);

# Create all components of the directory path.
#
    @dirs = split('/', $Tdir);
    $mkpath = '/'.shift(@dirs);    # Base path must exist
    while ($dname = shift(@dirs)) {
          $mkpath .= "/$dname";
          if (!mkdir($mkpath, $PathMode) && $! != 17)
             {return &Emsg(0, "cannot create '$dname' in '$path'; $!")}
             else {chmod($PathMode, $mkpath)}
          }
return 1
}
 
#******************************************************************************
#*                               L o c k _ O K                                *
#******************************************************************************
 
sub Lock_OK {my($path, $fn) = @_;
    my($lkfn) = &mush($path).'.lock';

# Check if we need to create a lock file
#
  return 1 if !$Migchk || -e $lkfn;

# Tell user what we must do and create lock file as needed
#
  &Say("Missing lock file: $fn");
  return 0 if !$Migok || !&Ask('Create lock file?');

# Create the lock file
#
  return &Emsg(0, "unable to create $lkfn; $!.") if !open(LKFH, ">$lkfn");
  close($LKFH);

# Set correct time on the file
#
  my($OK) = 1;
  my(@fsi) = stat($fn);
  if ($Migforce)
     {my($now) = $fsi[9]-13;
      $OK = &Emsg(0, "unable to set time on $lkfn; $!.")
                  if !utime($now, $now, $lkfn);
     }

# Set correct ownership of the file
#
  if ($OK && $fsi[4] != $>)
     {$OK = &Emsg(0, "unable to set uid for $lkfn; $!.")
                  if !chown($fsi[4], -1, $lkfn);
     }

# Set correct group of the file
#
  if ($OK && $fsi[5] != $))
     {$OK = &Emsg(0, "unable to set gid for $lkfn; $!.")
                  if !chown(-1, $fsi[5], $lkfn);
     }

# Erase the lock file if we could not set correct time or ownership
#
  unlink($lkfn) if !$OK;

# All done.
#
return $OK;
}

#******************************************************************************
#*                              F i l e M a k e                               *
#******************************************************************************
  
sub FileMake {my($Basefn, $Btemp, $uid, $gid, $data) = @_;
    my($xu, $xg, $Chown, $Chgrp, @fstat);

    # Make sure the base file exists and
    #
      return &Emsg(0, "File '$Basefn' does not exist.")
             if (!(@fstat = stat($Basefn)) || !-f _ );

    # If file is not owned by us then we need to be root
    #
      $xu = (defined($uid) ? $uid : $fstat[4]);
      $xg = (defined($gid) ? $gid : $fstat[5]);
      $Chown = $xu != $>;
      $Chgrp = $xg != $MYGID;
      return &Emsg(0, "Cannot create '$Btemp' for uid/gid $uid/$fstat[5].")
         if ($> && ($Chown || ($Chgrp && index(' '.$), ' '.$fstat[5]) == -1)) );

     # Create the file and set the correct ownership and mode
     #
       return &Emsg(0, "Unable to create '$Btemp'; $!.") if !open(FD,">$Btemp");
       print FD $data if $data;
       close(FD);
       if ((!$> || $Chown || $Chgrp) && !chown($xu, $xg, $Btemp))
          {&Emsg(0, "Unable to set uid $uid for '$Btemp'; $!.");
           unlink($Btemp); return 0;
          }
       if (!chmod(0664, $Btemp))
          {&Emsg(0, "Unable to set mode for '$Btemp'; $!.");
           unlink($Btemp); return 0;
          }
       return 1;
 }
 
#******************************************************************************
#*                             u t i l i t i e s                              *
#******************************************************************************

sub Ask {my($qq) = @_;
    my($resp);
    return 1 if !$Iactive;
    $qq .= ' (n | y): ';
    while($resp ne 'n')
       {print $qq;
        $resp = <STDIN>;
        chomp($resp);
        return 1 if $resp eq 'y';
        return 0 if !$resp;
       }
return 0;
}

sub CopyFile {my($sfn, $tfn) = @_; my(@finfo);

   # Obtain stat info for source file
   #
     return "unable to stat $sfn; $!" if !(@finfo = stat($sfn));

   # Copy the source file to the target file
   #
     $resp = `$DD_CMD if=$sfn of=$tfn bs=1048576 2>&1`;
     chomp($resp);
     if ($?) {unlink($tfn);
              return "copy failed for $sfn; $resp";
             }

   # Set ownership on the file
   #
     if (!chown($finfo[4], $finfo[5], $tfn))
        {$resp = "$!"; unlink($tfn);
         return "unable to set uid/gid for $sfn; $resp";
        }

   # Rese the a/mtime
   #
     if (!utime($finfo[8], $finfo[9], $tfn))
        {$resp = "$!"; unlink($tfn);
         return "unable to set a/mtime for $sfn; $resp";
        }

     return '';
}

sub ExpandDir {my($fn) = @_; my (@files, @dirs, $fl);
    @files = <$fn>;
    foreach $fl (@files) {push(@dirs, $fl) if -d $fl;}
    return @dirs;
}

sub Emsg {my($rc, $msg) = @_;
    print STDERR $SSD."_Xeq: $msg\n";
    return $rc;
    }
  
sub DirFn {my($fn) = @_; my($i, $dir);
    if ( ($i = rindex($fn, '/')) < 0) {return ('./', $fn)}
       else {$dir = substr($fn, 0, $i+1); $fn = substr($fn, $i+1);}
    return ( (substr($dir, 0, 1) eq '/' ? $dir : './'.$dir), $fn);
    }

sub get_date {my($mm, $dd, $yy) = @_;
return timelocal(0,0,0,$dd,$mm-1,$yy,0,0,0);
}

sub get_intvl {my($val, $Aok) = @_;
   if ($val =~ /^(\d+)(d|D|h|H|m|M|s|S|a|A)$/)
      {my($type) = uc($2);
       return  $1 * 86400 if $type eq 'D';
       return  $1 *  3600 if $type eq 'H';
       return  $1 *    60 if $type eq 'M';
       return  $1         if $type eq 'S';
       return -($1?$1:1)  if $type eq 'A' && $Aok;
      }
      elsif  ($val =~ /^(\d+)$/) {return $val}
   return &Emsg(undef, "Invalid time interval, '$val'.");
}

sub get_owner {my($v) = @_;
    my($owner, @passwd);

# Establish the uid/gid of the owner
#
    if (defined($owner = &get_val('owner', $v)))
       {@passwd = getpwnam($owner);
        if ($owner ne $passwd[0]) {&Emsg(4, "Invalid owner, '$owner'")}
           else {return (1, $passwd[2], $passwd[3]);}
       }
    return (0, undef, undef);
}

sub get_val {my($item, $v) = @_;
    return &Emsg(undef, ucfirst($item).' not specified.') if $v eq '';
    return $v;
}

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

sub mush {my($fn) = @_; my($path, $fname);
          return $fn if !$Hidden;
          return '.' if $fn eq '';
          ($path, $fname) = $fn =~ m:^(.*/)(.*):g;
          return '.'.$fn if $path eq '';
          return $path.'.'.$fname;
}

sub Say {my($msg) = @_; print $msg, "\n";}

sub scan {my($curd, $base, $rrr, $carg) = @_;
   my($file);
   return &Emsg(0, "Unable to chdir to $base: $!.") if !chdir($base);
   return &Emsg(0, "Unable to open $base: $!.") if !opendir(DIR, $base);
   my(@files) = readdir(DIR);
   closedir(DIR);

   for $file (@files) {
       next if $file eq '.' || $file eq '..';
       stat "$file";
         if (-d _  && $rrr) {return 0
                             if !scan($base, "$base/$file", $rrr, $carg)}
      elsif (-f _  && &$carg($file)) {print "$base/$file\n"}
      }
   return &Emsg(0, "Unable to chdir to $curd: $!.") if !chdir($curd);
   return 1;
}
