#!/usr/bin/perl



=pod

NOTES

  This is the TEST distribution of local routines for the TUSC layer of
  the PST toolkit.  (See http://pstoolkit.org)

  The routines here are the site-specific component of the TUSC routines.
  They are called by site independent routines in (e.g.) archive.pm.
  This is therefore the only file you need to edit to port the TUSC layer to
  your site.

  If you find you need to edit more than these lines to port to your
  site, please share your code with www.pstoolkit.org.

  Each routine is meant to be very simple and be responsible only
  for a single act. Each has the following structure.

  1. Argument definition.  This is the line like:
     my($host,$path,$file) = @_
     It's turning the arguments from the caller into the local variables
     that you'll want to use, so don't mess with it.

  2. Declaration of local variables:
     my ($commandOutput, $exitStatus);
     Because this file uses strict, you'll have to declare your local
     variables.  Of course, these variables may be different in
     different implementations of local.pm

  3. The body. Usually a simple local command.  Often, the stdout and
     exit status of this command are caught and returned to the caller
     of the local subroutine.

  4. Values are returned as described in the comments for each subroutine.

  Most routines take $host as an argument.  If you have multiple archival
  storage facilities (ASF), you might need to issue different local commands
  one each.  Then you would have, within a subroutine, a block like:

  if ($host eq "ASF_NAME1")
  {
    #do local command appropriate to ASF 1
  }
  if ($host eq "ASF_NAME2")
  {
    #do local command appropriate to ASF 2
  }

  For routines that need to return a true or false value, 0 should be
  returned for false, and a non-zero value for true.  This is described
  in the appropriate RETURN VALUES comment for each subroutine below.

=cut





package TUSC::local;    #Define TUSC/local module

use Exporter;
@ISA = "Exporter";
@EXPORT = qw(site_put
             site_files_are_same
             site_unglob_files
             site_get
             site_ls
             site_directory_exists
             site_file_exists
             site_link_exists
             site_follow_link
             site_mkdir
             site_migrate
             site_get_archive_home
             site_get_archive_host
             site_get_archive_check_status_and_type
             site_get_archive_note
             site_get_site
             site_get_file_mode
             site_file_is_migrated
             site_archive_system_is_up);

$VERSION = "0.02";

use English;     # Provide symbols for improved Perl readability.
use strict;      # Enhance Perl strictness, for aid in development.
use FileHandle ; # Use sysopen to open the script file


####use warnings;




sub site_get
{
=pod

  NAME
    site_get: get a file from archive file system


  USAGE
    ($commandOutput,$exitStatus) = site_get($user, $host, $remoteFile);


  ARGUMENTS
    $user: target user name, i.e. the name of the user account on archive file
      system from which file will come.

    $host (in): name of this host, for determining specifically how to do
      the "get" on sites that have more than one archive file system.

    $remoteFile (in): name of file on archive file system


  DESCRIPTION
    This routine gets a file from an archive file system.  This routine
    is site-specific in that access to the archive file system depends on
    the site (it might also depend on which host at the site).


  RETURN VALUES
    site_get returns a list of two scalar elements:  The first element
    is a string containing the output of the "get" command.  The second
    element is the integer exit status value of the command.


=cut

  # Unpack arguments from ARGS array
  my ($user, $host, $remoteFile)=@_;

  # Declare local variables
  my ($commandOutput, $exitStatus);

  # Use /bin/cp to copy files.
  $commandOutput = `/bin/cp -f $remoteFile . 2>&1` ;

  # Store exit status of previous backtic command.
  $exitStatus    = $CHILD_ERROR;

  return($commandOutput, $exitStatus);
}




sub site_files_are_same
{
=pod

  NAME
    site_files_are_same: verify sameness of local and remote files


  USAGE
    $sameFlag = site_files_are_same($user, $host, $localFile, $remoteFile);

  ARGUMENTS
    $host (in): name of this host, for determining specifically how to
         perform on sites that have more than one archive file system.

    $localFile (in): name of file on local file system

    $remoteFile (in): name of file on archive file system


  DESCRIPTION
    Verify that the given local and remote files are the same.

    The implementer of this routine is at liberty to decide how rigorously
    to perform this verification.  One can imagine several possiblities:
          () Check the file size indicated in the directory listing.
          () Check the file size indicated by a word count.
          () Compare checksums.
          () Perform a complete "diff" or "cmp" on the two files.


  RETURN VALUES
    Returns non-zero if files are the same, zero otherwise.


=cut

  # Extract arguments from ARGS array
  my ($user, $host, $localFile, $remoteFile)=@_;

  # Declare local variables
  my ($localSize, $remoteSize);

  # Check file sizes as a rudimentary verification against corruption.
  $localSize    = -s $localFile;
  $remoteSize   = -s "$remoteFile";  #perl's size checker

  if($localSize == $remoteSize)
  {
    return 1;
  }
  else
  {
    return 0;
  }
}




sub site_unglob_files
{
=pod

  NAME
    site_unglob_files: expand file glob wildcards


  USAGE
    ($list) = site_unglob_files($user, $host, $path, $filePattern);


  ARGUMENTS
    $host (in): name of this host, for determining specifically how to
         perform on sites that have more than one archive file system.

    $path (in): path prefix on archive file system

    $filePattern (in): file name, possibly with glob pattern


  DESCRIPTION
    This routine expands a file name, possibly with a glob pattern,
    and returns a list of names of files on the archive file system.
    Here, files can mean directories, links, or actual files.

  RETURN VALUES
      list: a string (scalar) containing the list of full pathnames for the
            files (as ls directory/file* would return).


  NOTES
    This implementation relies on shell glob expansion.  If noglob is set
      and exported, this implementation will fail.


=cut

  # Extract arguments from ARGS array
  my ($user, $host, $path, $filePattern)=@_;

  # Declare local variables
  my ($lsOutput);  # output from "ls" on archive file system

  # If $filePattern contains wildcards,
  # obtain list of remote directory entries that match.
  # WARNING: beware noglob (see NOTES).
  $lsOutput=`/bin/ls $path$filePattern`;

  return ($lsOutput);

}





sub site_put
{

=pod

  NAME
    site_put: put a local file on the ASF.


  USAGE
    ($commandOutput,$exitStatus) = site_put($user, $host, $path, $file);


  ARGUMENTS
    $user (in): name of target user on archive file system

    $host (in): name of this host, for determining specifically how to
         perform on sites that have more than one archive file system.

    $path (in): directory on the ASF where the file will go

    $file (in): local file to be put


  RETURN VALUES
    $commandOutput: a string containing the stdout from the local put command
    $exitStatus: the integer status code returned by the local put command

=cut


  # Extract arguments from ARGS array
  my ($user, $host, $path, $file)=@_;
  my ($commandOutput);
  my ($exitStatus);

  #put the file
  $commandOutput=`/bin/cp -f $file $path 2>&1`;

  #Perlese for the status returned by the last `` command.
  $exitStatus=$CHILD_ERROR;

  return($commandOutput,$exitStatus);

}




sub site_directory_exists
{

=pod
  NAME
    site_directory_exists: Determine whether a remote directory exists.


  USAGE
    $existFlag = site_directory_exists($user, $host, $path);


  ARGUMENTS
    $host (in): name of this host, for determining specifically how to
         perform on sites that have more than one archive file system.
    $path (in): directory whose existence is in question


  RETURN VALUES:
    $dirExists: non-zero if $path exists on $host, zero otherwise.

=cut

  # Extract arguments from ARGS array
  my ($user, $host, $path)=@_;
  my ($dirExists);

  #Test existence with perl's -d test.
  if (-d $path)
  {
    $dirExists = 1;
  }
  else
  {
    $dirExists = 0;
  }

  return($dirExists);

}



sub site_file_exists
{

=pod
  NAME
    site_file_exists: Determine whether a remote file exists.


  USAGE
    $existFlag = site_file_exists($user, $host, $file);


  ARGUMENTS
    $user : the user
    $host (in): name of this host, for determining specifically how to
         perform on sites that have more than one archive file system.
    $file (in): full-path name for file whose existence is of interest to us.


  RETURN VALUES:
    $fileExists: non-zero if $file exists on $host, zero otherwise.
                 Note that it should return zero if a directory named $file
                 exists.

=cut

  # Extract arguments from ARGS array
  my ($user, $host, $file)=@_;
  my ($fileExists);

  #Test existence with perl's -e test.
  if (-e $file)
  {
    $fileExists = 1;
  }
  else
  {
    $fileExists = 0;
  }

  return($fileExists);

}




sub site_link_exists
{

=pod
  NAME
    site_link_exists: Determine whether a remote link exists.


  USAGE
    $existFlag = site_link_exists($user, $host, $link);


  ARGUMENTS
    $user : the user
    $host (in): name of this host, for determining specifically how to
         perform on sites that have more than one archive file system.
    $link (in): full-path name for link whose existence is of interest to us.


  RETURN VALUES:
    $existFlag: non-zero if $link exists on $host and is a link (not a file
                or directory), zero otherwise.

=cut

  # Extract arguments from ARGS array
  my ($user, $host, $file)=@_;
  my ($existFlag);

  #Test existence with perl's -l test.
  if (-l $file)
  {
    $existFlag = 1;
  }
  else
  {
    $existFlag = 0;
  }

  return($existFlag);

}




sub site_follow_link
{

=pod
  NAME
    site_follow_link: return the name of a file pointed to by a link.


  USAGE
    $followedLink = site_follow_link($user, $host, $link);


  ARGUMENTS
    $user : the user
    $host (in): name of this host, for determining specifically how to
         perform on sites that have more than one archive file system.
    $link (in): full-path name for link that we want to follow.


  RETURN VALUES:
    $followedLink: The full path name of the file that a link points at.
        It is not necessary to determine whether the link points at a
        real file, a directory, another link, or whatever, but simply to
        return the name of whatever the link thinks it is pointing at.

=cut

  my ($user,$host,$link) = @_;
  my ($followedLink);

  $followedLink=readlink($link);

  return $followedLink;

}




sub site_mkdir
{

=pod
  NAME
    site_mkdir: Create a remote directory.


  USAGE
    ($commandOutput,$exitStatus) = site_mkdir($user, $host, $path, $mode);


  ARGUMENTS
    $user (in): target user on archive file system

    $host (in): name of this host, for determining specifically how to
         perform on sites that have more than one archive file system.

    $directory (in): directory to create

    $mode (in): the mode (specified in octal) with which to create the
                directory.  See chmod(1) and mkdir(1) (-m option).


  RETURN VALUES:
    $commandOutput: a string containing the stdout from the local mkdir command
    $exitStatus: the integer status code returned by the local mkdir command


=cut

  # Extract arguments from ARGS array
  my ($user, $host, $directory, $mode)=@_;
  my ($commandOutput,$exitStatus);

  #make directory and get the exit status
  $commandOutput = `mkdir -m $mode $directory 2>&1`;
  $exitStatus    = $CHILD_ERROR;

  return($commandOutput,$exitStatus);
}




sub site_migrate
{
=pod

  NAME
    site_migrate: Migrate a remote file.


  USAGE
    site_migrate($user, $host, $file);


  ARGUMENTS
    $host (in): name of the ASF where the file exists.
    $file (in): full path name of the file to be migrated.


  RETURN VALUES
    None.

=cut

  # Extract arguments from ARGS array
  my ($user, $host, $file)=@_;

  # since there's no migration in the test, don't do anything.
  warn("site_migrate: COMMENT: Doing nothing.\n");
  warn(" If this were a real archival system, this would migrate your file.\n");
}




sub site_ls
{
=pod

  NAME
    site_ls: perform an ls on remote files.


  USAGE
    ($commandOutput,$exitStatus) = site_ls($user, $host, $options, $files);


  ARGUMENTS
    $user: name of target user on archive file system

    $host: name of the ASF where the file(s) exist.

    $options: A string of options suitable to be passed to ls. See ls(1).

    $files: A string containing the full path names of the files to be ls'ed.


  RETURN VALUES
    $commandOutput: stdout from the local ls command
    $exitStatus: the status code returned by the local ls command

=cut

  # Extract arguments from ARGS array
  my ($user, $host, $options, $files)=@_;
  my ($commandOutput,$exitStatus);

  #do the ls and get the exit status
  $commandOutput=`/bin/ls $options $files 2>&1`;
  $exitStatus=$CHILD_ERROR;

  return ($commandOutput,$exitStatus);

}




sub site_get_archive_home
{
=pod

  NAME
    site_get_archive_home: Get the home directory on the mass store for a user.


  USAGE
    $home = site_get_archive_home($user);


  ARGUMENTS
    $user(in): The user whose home is requested.


  RETURN VALUES
    $home: name of the home directory for the user

=cut

  # Extract arguments from ARGS array
  my ($user)=@_;
  my ($home);

  #define the user's home directory
  $home = "/tmp/$user/DATA_ARCHIVE";

  return ($home);

}




sub site_get_archive_host
{
=pod

  NAME
    site_get_archive_host: Return the name of the mass store hosts for a user.


  USAGE
    $host = site_get_archive_host($user);


  ARGUMENTS
    $user (in): The user who is requesting available hosts.


  RETURN VALUES
    $host: A comma-delimeted string (no whitespace) of the available archival
      storage hosts hosts at the site.  One element of the list will
      be sent to most of the other local.pm subroutines as $host.  Barring
      command-line options or environment variables, the $host that will
      be used is the first element of this list.  Since the default host
      may be dependent on user, the user name is also passed in.


=cut

  # Extract arguments from ARGS array
  my ($user)=@_;
  my ($host);

  #In this test, we call the $host "local".
  $host = "local";

  return ($host);

}




sub site_get_archive_check_status_and_type
{
=pod

  NAME
    site_get_archive_check_status_and_time: Return a flag that determines
     whether or not archive will check the type and status of files on the
     ASF before and after a transfer.


  USAGE
    $doCheck = site_get_archive_check_status_and_type($host);


  ARGUMENTS
    $host(in): The host for which we are getting the flag.


  RETURN VALUES
    $doCheck: nonzero if we want to perform these checks for $host, 0 otherwise.

=cut

  # Extract arguments from ARGS array
  my ($host)=@_;
  my ($doCheck);


  $doCheck = 1;

  return ($doCheck);

}




sub site_get_archive_note
{
=pod

  NAME
    site_get_archive_note: Return a help message string.


  USAGE
    $message = site_get_archive_note($user,$host);


  ARGUMENTS
    $user(in): The user whose home is requested.

    $host (in): The host that the user is trying to access.


  RETURN VALUES
    $message: A message that does the following:
      Points the user to the local man pages for PST and www.pstoolkit.org.
      Gives information about environment variables used to control archive.
      Gives any site or host specific information that users will require to get
        archive to work.


=cut

  # Extract arguments from ARGS array
  my ($user,$host)=@_;
  my ($message);

  #Use perl's << operator to make multiline strings.
  #Caution: The end delimter (end_message) must be the whole line (no leading
  # spaces.  The ; is not required, but would be if there were any other
  # commands in this if block.
  $message = <<end_message;

See the man pages for the PST routines that use these environment
variables.  Man pages are included in the PST distribution and are
available on-line at pstoolkit.org.

If you choose not to set these environment variables, then the
default values specified here will be used.  Please make sure your
\$ARCHIVE_HOME directory exists.

There is no actual separate archival storage facility accessed for the
TEST version of PST.  Unix file-system utilities are used.

end_message
    ;

  return ($message);

}




sub site_get_site
{
=pod
  NAME
    site_get_site: Return the name of the local site.  Used in installation.


  USAGE
    $sitename = site_get_site();


  ARGUMENTS
    NONE


  RETURN VALUES
    $sitename: A string that contains the name of the site.

=cut

  return "local";
}





sub site_get_file_mode
{

=pod
  NAME
    site_get_file_mode: Return the octal access mode of a file

  USAGE
    $octalMode = site_get_file_mode($user,$host,$file);


  ARGUMENTS
    $user(in): The user

    $host(in): The host for which we are getting the flag.

    $file(in): full pathname of the file.


  RETURN VALUES
    mode: an octal number representing the access mode of the file.
           See chmod (1).

  NOTES
    This subroutine isn't used by archive proper, but is used by TestArchive
      to check the results of put -M mode.  If it is not implmented, archive
      will still work, but TestArchive will fail certain tests.  In the
      future, we may add a way to access this subroutine from archive itself.

=cut

  # Extract arguments from ARGS array
  my ($user, $host, $file)=@_;
  my ($mode);

  #see www.perldoc.com for info on perl's stat.
  #stat returns file type mish-mashed into mode, so the & part just gets mode.
  $mode = (stat($file))[2] & 07777;

  return $mode;

}






sub site_file_is_migrated
{

=pod
  NAME
    site_file_is_migrated: Determine whether a remote file has been migrated

  USAGE
    $isMigrated = site_file_is_migrated($user,$host,$file);


  ARGUMENTS
    $user(in): The user

    $host(in): The host for which we are getting the flag.

    $file(in): full pathname of the file.


  RETURN VALUES
    $isMigrated: zero if the file has not been migrated, nonzero if it has.

  NOTES
    This subroutine isn't used by archive proper, but is used by TestArchive
      to check the results of put and get -m.  If it is not implmented, archive
      will still work, but TestArchive will fail certain tests.  In the
      future, we may add a way to access this subroutine from archive itself.

      Even though this test version does not support migration, we always
      return true.  That allows this local.pm to pass TestArchive

=cut

  # Extract arguments from ARGS array
  my ($user, $host, $file)=@_;
  my ($lsoutput);                #output from ls
  my ($isMigrated) = 1;          #return value

  #use ls to see if file is migrated
  $lsoutput = `ls -l $file`;
  if ($lsoutput =~ /^m/){
    $isMigrated = 1;
  }

  return $isMigrated;

}



sub site_archive_system_is_up
{

=pod
  NAME
    site_archive_system_status:

  USAGE
    $systemUp = site_archive_system_status($host,$afsHome);


  ARGUMENTS
    $host(in): The host for which we are getting the flag.

    $afsHome(in): the home directory for the user.


  RETURN VALUES
    $systemUp: nonzero if $afsHome on $host is reachable, 0 otherwise.

=cut

  # Extract arguments from ARGS array
  my ($host, $afsHome)=@_;

  # Since the "test" version of "local.pm" uses a regular file system
  # for archival storage, just test whether the specified "archive"
  # proxy directory exists.
  if(-e $afsHome)
  {
    return 1;
  }
  else
  {
    return 0;
  }
}
