#!/usr/bin/env perl

# $Id$

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

# This command stages in a file from a remote site. The syntax is:

# {frm_xfr.HPSS | hpsscp} [options] <[usr@]host>:<sfn> <tfn> |
#                                   <sfn> <[usr@]host>:<tfn>

# options:

# [-A [<port>]] [-c <config>] [-d] [-f] [-F {hide|none|oute|outo|<ffdir>}]

# [-k <keytab>] [-m] [-M offs] [-n] [-p <mode>] [-P <port>] [-r] [-s <cos>]

# [-t <tries>] [-x <pftpcmd>] [-w <maxw>] [-z]

# options (valid only under hpsscp):

# [-C] [-N <ndir>] [-Q <qdir>] [-W <wait41>]

# -A send the output filename via a udp alert to the receiving host:<port>
#    If port is not specified, the default port is used.

# -c supplies an option configuration file. The options in the file are
#    added in front of whatever options remain. The file is structured
#    as if you specified the options on the command line either in a single
#    line or multiple lines separated by linends.

# -d turn on debugging.

# -k is the location of the keytab which should contain a single password
#    to be used when logging in <usr> (default is /var/adm/xrootd/pftp/keyfile).

# -f force file retrieval even if the file exists (i.e., replace).
#    This is the default for zero length files.

# -F specified the '.fail' file handling. The default is to create "<tfn>.fail"
#    when a transfer fails. The file contains the pftp session along with any
#    pftp responses. You can change this as:
#    hide    Creates a dot file instead: "tpath>/.<tfile>.fail"
#    none    Does not create anything and stays silent about it.
#    oute    Print what would have been written to ".fail" to stderr.
#            This is the default for hpsscp!
#    outo    Print what would have been written to ".fail" to stdout.
#    <ffdir> Creates the file in the directory as "<ffdir>/<tfn>.fail".

# -m exit with non-zero status if the file exists and has a non-zero length.

# -M specified he offset into the target filename where directories are to
#    start being created. See notes on auto-path creation.

# -n do not redirect standard error when invoking the copy function

# -o the onwership information in the form of <usr>:<grp> where either one
#    or both may be specified. The default comes from the data source.
#    Ownership can only be maintained by root proceses or pftp logins.

# -P The MSS port number to use (default is 2021).

# -p set the protection mode of the file. Specify 1 to 4 octal digits, the
#    letter 'r' for 0440, or the letter 'w' for 640.

# -s specifies the storage class; where <cos> is a number. This has only
#    meaning if <tfn> is remote.

# -t number of times to retry a failing copy that is retriable (default is 2).

# -x The pftp command to use (default is /opt/xrootd/utils/pftp_client).

# -w maximum number of seconds to wait between retries. Default is 240.

# -z do not reset the process group id.

# hpsscp options:
# -C continue execution even when a transfer slot cannot be obtained. By
#    default, the transfer does not occur without a transfer slot if a queue
#    directory exists.
#
# -N the location of the name space directory. If not specified, no check is
#    made whether or not a directory path exists in hpss. This causes mkdir's
#    to be executed for each copy, which is ineffecient and slow. With -N, a
#    shadow directory name space is maintained to avoid duplicate mkdir's.

# -Q the location of execution queue directory. This directory must contain
#    at least one file and may contain any number. The number of files
#    represents the maximum number of simultaneous requests allowed. Requests
#    over the limit wait until a execution slot frees up. The default is
#    "/var/hpss/xfrq", if it exists.

# -W the location of the wait41 program that implements the transfer queue
#    limits. The default is "/opt/xrootd/utils/wait41".

# <user@host> indicates that the file is in the Mass Storage System. The <user>
#             is used as the login name and <host> is the location of the MSS.
#             Only one of <srcfn> or <trgfn> may have this designation but
#             one must have it. If user if omitted, the current user is used.

#             Auto-path creation is supported in three ways. Primarily, if a
#             space appears in the hpss target path, then directories to
#             left of the space are assumed to exist and directories to the
#             are created prior to the pput of the file. If you do not want to
#             use space notation, use the -M option to specify where the space
#             would have occurred. This location must have a slash ('/').
#             For hpsscp, the -N option can be used to provide a reference name
#             space that will determine which directories will be created.

# Upon success, a zero status code is returned. Failure causes a message to
# be issued to stderr and a non-zero exit status to be returned.

use IPC::Open2;
use Socket;

# Global variables:
#
($CMD)     = "/$0" =~ m|^.*/([^.]*).*$|g;
$isCPY     = $CMD =~ m/^hpsscp/;
$MsgPfx    = "$CMD: ";
$ER_SFX    = '.fail';        # Suffix for fail file when error occurrs
$OKFile    = 1;              # If file already present, all is good.
$Replace   = undef;          # Replace existing file, if any
$Mode      = undef;

$Debug = 0;
$ErrLog  = '';     # Command stream and response
$ErrDisp = ($isCPY ? 'oute' : '');
$ErrFD   = 0;
$ErrFile = '';     # Absolute name of where error data resides

$newPGRP = 1;      # Set new process group
$DMode   = 0775;   # Directory create mode
$doGet   = 1;      # We assume we will be doing gets
$UDPort  = 0;      # Alert udp port
$UDPdef  = 8686;   # Alert udp port default

# hpsscp specific items
#
$nsDir   = '';
$nsMkd   = '';
$xqDir   = (-d '/var/hpss/xfrq'           ? '/var/hpss/xfrq'          : '');
$WT41    = (-x '/opt/xrootd/utils/wait41' ? 'opt/xrootd/utils/wait41' : '');
$PFOK     = 0;

# Transfer specific items
#
$XfrCmd  = '/opt/xrootd/utils/pftp_client';
$XfrArgs = '-n -v';
$XfrOut  = '2>&1'; # The redirection of stderr to stdout
$XfrHost = '';     # MSS host name
$XfrPort = '2021'; # MSS port number
$XfrUser = '';     # MSS user name
$XfrPswd = '';     # MSS user password
$XfrKey  = '/var/adm/xrootd/pftp/keyfile';
$XfrGet  = 'open %xfrhost %xfrport;user %xfruser %xfrpswd;binary;' .
           'setpblocksize 2097152;pget %xfrsfn %xfrtfn;quit;';
$XfrPut1 = 'open %xfrhost %xfrport;user %xfruser %xfrpswd;delete %xfrtfn';
$XfrPut2 = ';binary;setpblocksize 2097152;pput %xfrsfn %xfrtfn';

$XfrGID  = '';     # The group ID (usually from source file)
$XfrUID  = '';     # The user  ID (usually from source file)
$XfrCOS  = -1;     # Class of Service
$XfrApnd = '';     # Value of '-a'
$XfrBase = '';     # Target prior to appending with XfrApnd
$XfrMaxTR= 2;      # Maximum Number of tries.
$XfrMaxWT= 240;    # Maximum Retry Wait Time.

$XfrSrcFN= '';     # The source file
$XfrTrgFN= '';     # The target file
$XfrResp = '';     # The transfer response
$XfrSess = '';     # The transfer session
$XfrRC   = 0;      # The final return code
$XfrMoff = -1;

# Get the options
#
  $CmdLine = join(' ',@ARGV);
  while (substr($ARGV[0], 0, 1) eq '-') {
     $op = shift(@ARGV);
        if ($op eq '-A') {if (&IsNum($ARGV[0])) {$UDPort= &GetVal('port', 'N');}
                             else {$UDPort = $UDPdef;}
                         }
     elsif ($op eq '-c') {$CFile = &GetVal('config file'); AddOpts($CFile);}
     elsif ($op eq '-d') {$Debug    = 1;}
     elsif ($op eq '-k') {$XfrKey =  &GetVal('key file');}
     elsif ($op eq '-f') {$Replace  = 1;}
     elsif ($op eq '-F') {$ErrDisp  = &GetVal('fail handing');
                          &Emsg("Invalid fail file disposition '$ErrDisp'.")
                               if !($ErrDisp =~ /^(hide|none|outo|oute|\/.*)$/);
                         }
     elsif ($op eq '-m') {$OKFile  =  0;}
     elsif ($op eq '-M') {$XfrMoff =  &GetVal('offset', 'N', 0);}
     elsif ($op eq '-n') {$XfrOut = ''}
     elsif ($op eq '-o') {&GetOwners(&GetVal('ownership'));}
     elsif ($op eq '-P') {$XfrPort =  &GetVal('port', 'N');}
     elsif ($op eq '-p') {$Mode =  &GetVal('mode');
                             if ($Mode eq 'r') {$Mode = oct('0440');}
                          elsif ($Mode eq 'w') {$Mode = oct('0640');}
                          else {&Emsg("Invalid mode '$Mode'.")
                                     if !IsOct($Mode) || $Mode > 7777;
                                $Mode = oct($Mode);
                                $Mode = undef if $Mode == 0;
                               }
                         }
     elsif ($op eq '-s') {$XfrCOS   =  &GetVal('storage class', 'N');}
     elsif ($op eq '-t') {$XfrMaxTR =  &GetVal('max tries', 'N', 1);}
     elsif ($op eq '-w') {$XfrMaxWT =  &GetVal('max wait', 'N', 1);}
     elsif ($op eq '-x') {$XfrCmd = &GetVal('transfer command');}
     elsif ($op eq '-z') {$newPGRP = 0;}
     elsif ($op eq '-C' && $isCPY)
                         {$PFOK = 1;}
     elsif ($op eq '-N' && $isCPY)
                         {$nsDir = &GetDir('name space directory');}
     elsif ($op eq '-Q' && $isCPY)
                         {$xqDir = &GetDir('xfer queue directory');}
     elsif ($op eq '-W' && $isCPY)
                         {$WT41  = &GetVal('wait41 command');
                          &Emsg(ET("Invalid -W command target")) if !-x $WT41;
                         }
     else {&Emsg("Invalid option '$op'.",-1);}
     }
  &SayDebug("cmd = $CmdLine");

# Get the source and target filenames
#
  &Emsg('Source file not specified.',-1) if (!($XfrSrcFN = $ARGV[0]));
  &Emsg('Target file not specified.',-1) if (!($XfrTrgFN = $ARGV[1]));
  &Emsg("Extraneous parameter, $ARGV[2].") if ($ARGV[2]);

# See if the source is a remote location
#
   ($mss_uhs, $XfrSrcFN) = split(':', $XfrSrcFN, 2);
   if (!$XfrSrcFN) {$XfrSrcFN = $mss_uhs, $mss_uhs = '';}
      else {$uhLoc = 'source'; $doGet = 1;}
   ($mss_uht, $XfrTrgFN) = split(':', $XfrTrgFN, 2);
   if (!$XfrTrgFN) {$XfrTrgFN = $mss_uht, $mss_uht = '';}
      else {$uhLoc = 'target'; $doGet = 0;}

# Make sure we have something but not too much of it
#
   &Emsg("Source and target files may not be both remote files!")
        if ($mss_uhs ne '' && $mss_uht ne '');
   &Emsg("Source and target files may not be both local files!")
        if ($mss_uhs eq '' && $mss_uht eq '');

# Extract out the user and host
#
  $mss_uh = ($mss_uhs ? $mss_uhs : $mss_uht);
  if (index($mss_uh, '@') >= 0) {($XfrUser, $XfrHost) = split('@', $mss_uh);}
     else {$XfrUser = (getpwuid($>))[0]; $XfrHost = $mss_uh;}
  &Emsg("User missing in $uhLoc file specification.") if $XfrUser eq '';
  &Emsg("Host missing in $uhLoc file specification.") if $XfrHost eq '';

# Cleanup nsDir option
#
  if ($nsDir ne '')
     {while ($nsDir =~ s|//|/|g) {}
      $nsDir .= $sfx if ($sfx = chop($nsDir)) ne '/';
     }

# If we need to append something, do so now
#
  if (!$doGet)
     {if (index($XfrTrgFN, ' ') >= 0)
         {($XfrBase, $XfrApnd) = split(/ /, $XfrTrgFN, 2);
          $XfrTrgFN = $XfrBase.'/'.$XfrApnd;
         } elsif ($XfrMoff >= 0)
                 {&Emsg("-M offset does not refer to a slash.")
                       if substr($XfrTrgFN, $XfrMoff, 1) ne '/';
                  $XfrBase = substr($XfrTrgFN, 0, $XfrMoff);
                  $XfrApnd = substr($XfrTrgFN, $XfrMoff+1);
                 }
           elsif ($nsDir ne '') {($XfrBase, $XfrApnd) = Get_Base($XfrTrgFN);}
     }

# Remove double slashes
#
  while ($XfrSrcFN =~ s|//|/|g) {}
  while ($XfrTrgFN =~ s|//|/|g) {}
  &SayDebug("Base=$XfrBase Append=$XfrApnd Target=$XfrTrgFN")
           if $Debug && ($XfrBase ne '' || $XfrApnd ne '');

# Handle error file disposition
#
     if ($ErrDisp eq '')
        {$ErrFile = ($doGet ? $XfrTrgFN : $XfrSrcFN).$ER_SFX;}
  elsif ($ErrDisp eq 'hide')
        {my($edir, $efn) = $XfrTrgFN =~ /^(.*)\/(.*)$/g;
         $ErrFile = $edir.'/.'.$efn.$ER_SFX;
        }
  elsif ($ErrDisp eq 'oute') {$ErrFD = STDERR; $ErrDisp = 'prnt';}
  elsif ($ErrDisp eq 'outo') {$ErrFD = STDOUT; $ErrDisp = 'prnt';}
  elsif (substr($ErrDisp,0,1) eq '/')
        {$ErrFile = $ErrDisp.$XfrTrgFN.$Er_SFX;
         while ($ErrFile =~ s|//|/|g) {}
        }
  unlink($ErrFile) if $ErrFile ne '';

# If this is a put, make sure the source file exists before we do anything
#
  if (!$doGet)
     {@Svec = stat($XfrSrcFN);
      &CleanUp(&Emsg(ET("Unable to put $XfrSrcFN"), 0)) if $Svec[7] eq '';
      $XfrUID = $Svec[4] if $XfrUID eq '';
      $XfrGID = $Svec[5] if $XfrGID eq '';
      &MakePath($nsMkd) if !($rc = TransPace(0,$Svec[7])) && $nsMkd ne '';
      &CleanUp($rc);
     }

# Check if the file already exists in the cache. If it doesn't create the
# directory path to the file.
#
  @Svec = stat($XfrTrgFN);
  if ($Svec[7])
     {if (!$Replace)
         {utime(time(), $Svec[9], $XfrTrgFN);
          &CleanUp(&Emsg("File $XfrTrgFN already exists.", $OKFile));
         } else {truncate($XfrTrgFN, 0);}
     } else {&MakePath($XfrTrgFN);}

# At this point we need to bring the file into this cache. Issue the
# appropriate command to do this and set the access mode if it succeeded.
#
  &CleanUp($rc) if ($rc = TransPace(1,-1));
  &Emsg(ET("Unable to set mode for '$XfrTrgFN'"), 1)
       if (defined($Mode) && !chmod($Mode, $XfrTrgFN));

# All done.
#
  &CleanUp(0);

#******************************************************************************
#*                               A d d O p t s                                *
#******************************************************************************
 
sub AddOpts {my($cfn) = @_; my(@clines);

    &Emsg(ET("Unable to open config file '$cfn'")) if !open(CFD, $cfn);

    @clines = <CFD>;
    chomp(@clines);
    @clines = split(/ /,join(' ', @clines));
    unshift(@ARGV, @clines);
    close(CFD);
}

#******************************************************************************
#*                               C l e a n u p                                *
#******************************************************************************
 
sub CleanUp {my($rc) = @_; my($eFN);
  if ($rc && ($ErrLog || $XfrSess))
     {$XfrSess =~ s/\;/\n/g;
      if ($ErrFile)
         {$eFN = (-e $ErrFile ? '>>' : '>').$ErrFile;
          if (!MakePath($ErrFile) || !open(ERFD,$eFN)) {$ErrFD=STDERR;}
             else {print(ERFD $XfrSess,$ErrLog); close(ERFD);}
         }
      print($ErrFD $XfrSess,$ErrLog) if $ErrFD;
     }
  exit(($rc > 255 ? 255 : $rc));
}

#******************************************************************************
#*                              G e t _ B a s e                               *
#******************************************************************************
 
sub Get_Base {my($Path) = @_; my($dir, $apnd, $Base);

    my(@dirs) = split('/', $Path);
    my($fn) = pop(@dirs);
    shift(@dirs) if ($dirs[0] eq '');
    while(($dir = shift(@dirs)) ne '')
         {last if !-d $nsDir.$Base.'/'.$dir; $Base .= '/'.$dir;}
    if ($dir ne '')
       {while(($apnd = shift(@dirs)) ne '') {$dir .= '/'.$apnd;}
        $nsMkd = $nsDir.$Path;
        $dir .= '/'.$fn;
        return ($Base, $dir);
       }
    return ('', '');
}
 
#******************************************************************************
#*                              G e t _ F i l e                               *
#******************************************************************************
 
sub Get_File {my($cmd, $resp, $GetTries);

    # Construct the command stream
    #
    $cmd = &TransCmd($XfrGet);

    # Execute the command to get the file (as many times as wanted/needed)
    #
    $GetTries = 0;
    do {return 0 if &Transfer($cmd);
        $GetTries += &TransErr($GetTries+1);
       } while($GetTries < $XfrMaxTR);
    return $XfrRC;
}
 
#******************************************************************************
#*                             P u t _ A l e r t                              *
#******************************************************************************
 
sub Put_Alert {my($ip_addr);

# if there is no need to send an alert, simply return
#
  return 0 if !$UDPort;

# Get a udp socket
#
  if (!socket(MYSOCK, PF_INET, SOCK_DGRAM, getprotobyname("udp")))
     {&SayDebug("Unable to get socket for alert; $!", 1); return 0;}

# Convert destination to a sockaddr
#
  if (substr($XfrHost,0,1) =~ m/\d/) {$ip_addr = inet_aton($XfrHost);}
     else {$ip_addr = gethostbyname($XfrHost);}
  my($ip_dest) = pack_sockaddr_in($UDPort, $ip_addr);

# Send the message
#
  &SayDebug("Unable to send alert; $!", 1)
     if !send(MYSOCK, "$XfrUser $XfrTrgFN\n", 0, $ip_dest);

  return 0;
}
  
#******************************************************************************
#*                              P u t _ F i l e                               *
#******************************************************************************
 
sub Put_File {my($Fsz) = @_; my($cmd, $dir, $resp, $sfx, $PutTries);

    # Establish command stream preamble
    #
    $cmd = &TransCmd($XfrPut1);

    # Check if we need to insert mkdir commands
    #
    if ($XfrApnd ne '')
       {while ($XfrApnd =~ s|//|/|g) {}
        while ($XfrBase =~ s|//|/|g) {}
        $XfrBase .= $sfx if ($sfx = chop($XfrBase)) ne '/';
        my(@dirs) = split('/', $XfrApnd);
        pop(@dirs);
        shift(@dirs) if ($dirs[0] eq '');
        while(($dir = shift(@dirs)) ne '')
             {$XfrBase .= '/'.$dir; $cmd .= ";mkdir $XfrBase";}
       }

    # Set the cos if we need to
    #
    $cmd .= ";site setcos $XfrCos" if $XfrCOS >= 0;

    # Construct the penultimate command stream
    #
    $cmd .= TransCmd($XfrPut2);

    # Now add the uid/gid settings, as needed, followed by a quit.
    #
    if ($XfrUser eq 'root')
       {$cmd .= ";site chuid $XfrUID $XfrTrgFN" if $XfrUID ne '';
        $cmd .= ";site chgid $XfrGID $XfrTrgFN" if $XfrGID ne '';
       }
    $cmd .= ';quit';

    # Execute the command to put the file (as many times as wanted/needed)
    #
    $PutTries = 0;
    do {return &Put_Alert() if &Transfer($cmd, 1, $Fsz);
        $PutTries += &TransErr($PutTries+1, 1);
       } while($PutTries < $XfrMaxTR);
    return $XfrRC;
}

#******************************************************************************
#*                              T r a n s C m d                               *
#******************************************************************************

sub TransCmd {my($cmd, $nofn) = @_;

# Do command substitution (same for get or put)
#
    $cmd =~ s/%xfrhost/$XfrHost/;
    $cmd =~ s/%xfrport/$XfrPort/;
    $cmd =~ s/%xfruser/$XfrUser/;
    $cmd =~ s/%xfrsfn/$XfrSrcFN/;
    $cmd =~ s/%xfrtfn/$XfrTrgFN/;
    return $cmd;
}

#******************************************************************************
#*                              T r a n s E r r                               *
#******************************************************************************
  
sub TransErr {my($Try, $isput) = @_;

# Errors that cannot be retried because nothing will work. Return a count
# that will cause the counter to decrease to zero.
#
if ($XfrResp =~ /FileToNet: select error = 145/) {	# pftp timeout
   Logit("pftp timeout for $XfrTrgFN");
   return $XfrMaxTR+1;
   }

if ($XfrResp =~ /cannot be opened - HPSS Error: -2/) { # ENOENT type of error
   if ($isput) {Logit("mkdir error; path not found for $XfrTrgFN");}
      else     {Logit("get failed; '$XfrTrgFN' not found.");}
   $XfrRC = 2;
   return $XfrMaxTR+1;
   }

if (!$isput && $resp =~ /NetToFile:file write failure\(5\)/) { # Disk is full
   Logit("pftp failed for $XfrTrgFN; disk is full.");
   return $XfrMaxTR+1;
   }

# Errors which should be retried *forever* because problem is with HPSS
# not the particular file being transferred. Return non-increasing value.
#
if ($XfrResp =~ /Bad Data Transfer.\(error = -28,moved = 0\)/) {
   Logit("No space in storage class for $XfrTrgFN");
   sleep Min(240,$XfrMaxWT);
   return 0;
   }
if ($XfrResp =~ /Login failed./) {
   Logit("pftp login failed for $XfrTrgFN");
   sleep Min(240,$XfrMaxWT);
   return 0;
   }
if ($XfrResp =~ /Service not available, remote server has closed connection/) {
   Logit("pftp login failed for $XfrTrgFN");
   sleep Min(240,$XfrMaxWT);
   return 0;
   }
if ($XfrResp =~ /connect: Connection timed out/) {
   Logit("pftp login failed for $XfrTrgFN");
   sleep Min(240,$XfrMaxWT);
   return 0;
   }
if ($XfrResp =~ /connect: Connection refused/) {
   Logit("pftp login failed for $XfrTrgFN");
   sleep Min(240,$XfrMaxWT);
   return 0;
   }

# Retriable errors that are likely file related. These have a maximum limit and
# we wait between tries for an arbitrary but limited amount of time.
#
if ($XfrResp =~ /Bad Data Transfer.\(error = -5,moved = 0\)/) {
   Logit("No devices available to pftp $XfrTrgFN");
   sleep Min(120 * $Try, $XfrMaxWT);
   return 1;
   }
if ($XfrResp =~ /cannot be opened - HPSS Error: -5/) {
   Logit("Open error for $XfrTrgFN");
   sleep Min(60,$XfrMaxWT);
   return 1;
   }

# The following error seems to correlate to BFS end session error BFSR0096
#
if ($XfrResp =~ /Bad Data Transfer.\(error = -52,moved = 0\)/) {
   Logit("BFS error = -52 for $XfrTrgFN");
   sleep Min(60,$XfrMaxWT);
   return 1;
   }

# Retriable error conditions that require notification should go here.
#
if ($XfrResp =~ /HPSS Error: -5/) {		# I/O error in HPSS?
   Emsg("I/O error for $XfrTrgFN, rc=$XfrRC, try=$Try");
   sleep Min(60,$XfrMaxWT);	# wait a bit and retry
   return 1;
   }

# We don't know why we were called but we don't want to try again
#
$resp = 'transfer failed for unknown reasons.' if !($resp = &LastLine($resp));
return $XfrMaxTR+2;
}

#******************************************************************************
#*                              T r a n s f e r                               *
#******************************************************************************
 
sub Transfer {my($Cmds, $isWrite, $Fsz) = @_;
              my($i, $n, $pid, @Resp);
              my($xdir) = ' bytes '.($isWrite ? 'sent ' : 'received ');
              local(*Reader, *Writer);

# Det things up
#
  $XfrRC = 0;
  $XfrSess .= $Cmds.'===================================;';

# Do some debugging here to avoid spilling the password
#
  if ($Debug)
     {&SayDebug("Executing '$XfrCmd $XfrArgs'");
      my($Sess) = $XfrSess; $Sess =~ s/\;/\n/g;
      &SayDebug("Command stream:\n$Sess");
     }

# We now insert the password prior to transfer to avoid revealing it
#
  &GetPswd($XfrKey);
  $Cmds =~ s/%xfrpswd/$XfrPswd/;

# Establish a signal handler and create a process group
#
  $SIG{PIPE} = 'PHandler';
  $SIG{TERM} = 'THandler';
  setpgrp() if $newPGRP;

# execute the command feeding it the input
#
  &Emsg(ET("Unable to exec '$XfrCmd'"))
    if !($pid = open2(\*Reader, \*Writer, "$XfrCmd $XfrArgs $XfrOut"));
  $Cmds =~ s/\;/\n/g;
  &Emsg(ET("Unable to send commands to '$XfrCmd'")) if !print Writer $Cmds;
  close(Writer);

# Get the command output and clean-up the command
#
  @Resp = <Reader>;
  waitpid($pid,0);
  $XfrRC = ($? != 2 ? $? : 22);
  $XfrResp = join('',@Resp);
  $XfrSess .= $XfrResp.'==================================='."\n";

# If we ended with an error, bail out
#
  if ($XfrRC != 0)
     {Logit("!!! Transfer ended with non-zero status ($XfrRC)."); return 0;}

# Verify that the transfer fully completed. Note that the "transfer complete"
# message comes in two flavors and may be repeated. We want the last instance
# which cannot be neither on the last nor first lines of the response.
#
  $i = $#Resp; $XfrRC = 8;
  while($i--)
       {last if ($Resp[$i] =~ m/226 Transfer Complete\./)
             || ($Resp[$i] =~ m/226 Transfer complete\./);
       }

# Make sure we found the transfer complete message
#
  if ($i < 0)
     {Logit("!!! '226 Transfer complete' msg not found."); return 0;}

# Make sure we have the number of bytes sent/received
#
  if (($n  = index( $Resp[$i+1], $xdir)) < 0)
     {Logit("!!! '226 Transfer bytes' msg not found."); return 0;}
  $XfrBytes = substr($Resp[$i+1], 0, $n);

# For writes, make sure all the bytes were transferred
#
  if ($isWrite && $XfrBytes != $Fsz)
     {Logit("Transfer bytes ($XfrBytes) != file bytes ($Fsz)."); return 0;}

# All done
#
  $XfrRC = 0;
  return 1;
}

#******************************************************************************
#*                             T r a n s P a c e                              *
#******************************************************************************
 
sub TransPace {my($doGet, $Fsz) = @_; my($resp, $pid);
              local(*xfrRDR, *xfrWRT);


  my($okPace) = 0;
  if ($WT41 ne '' && $xqDir ne '')
     {&SayDebug("Obtaining xfer slot in $xqDir");
      my($xsT) = time();
      if (!($pid = open2(\*xfrRDR, \*xfrWRT, "$WT41 $xqDir")))
         {&Emsg(ET("Unable to exec '$WT41'"));
          return 1 if !$PFOK;
         } else {
          $resp = <xfrRDR>; chomp($resp); $okPace = 1;
          if ($resp ne 'OK')
             {Emsg("Unable to obtain transfer slot.");
              return 1 if !$PFOK;
             } else {
              $xsT = time() - $xsT;
              SayDebug("Xfer slot obtained in $xsT seconds.");}
         }
     }
   $rc = ($doGet ? Get_File($Fsz) : Put_File($Fsz));

   if ($okPace)
      {close(xfrRDR); close(xfrWRT); waitpid($pid,0);}

   return $rc;
}
  
#******************************************************************************
#*                                 U s a g e                                  *
#******************************************************************************
 
sub Usage {my($rc) = @_;
$CMD .= '.hpss' if !$isCPY;
print "Usage: $CMD [options] {<[usr@]host>:<sfn> <tfn> | <sfn> <[usr@]host>:<tfn>}\n";
print "\n";
print "options: [-c <config>] [-d] [-f] [-F {hide|none|oute|outo|<ffdir>}]\n";
print "         [-k <keytab>] [-m] [-M offs] [-n] [-p <mode>] [-P <port>] [-r]\n";
print "         [-s <cos>] [-t <tries>] [-x <pftpcmd>] [-w <maxw>] [-z]\n";
if ($isCPY) {
print "         [-C] [-N <nsdir>] [-Q <qdir>] [-W <waitqcmd>]\n";
}
exit($rc);
}

#******************************************************************************
#*                             u t i l i t i e s                              *
#******************************************************************************

sub MakePath {my($path) = @_; my(@dirs, $mkpath, $dname);
    @dirs = split('/', $path); pop(@dirs);
    $mkpath = shift(@dirs);  # start with either "" or "."
    while(($dname = shift(@dirs)) ne "")
         {$mkpath .= "/$dname";
          if (!-d $mkpath)
             {return &Emsg(ET("mkdir($mkpath) failed for '$path'"),1)
                     if !mkdir($mkpath, $DMode);
             }
         }
    return 1;
}

sub Min {my($V1, $V2) = @_; return ($V1 < $V2 ? $V1 : $V2);}

sub SayDebug {my($msg) = @_;
    print STDERR $MsgPfx, $msg, "\n" if $Debug;
}

sub LastLine {my($resp) = @_;
    my(@rr, $i);
    @rr = split("\n", $resp);
    for ($i = $#rr; $i >= 0; $i--) {return $rr[$i] if $rr[$i];}
    return '';
}

sub GetDir {my($item) = @_; my($v);
    $v = shift(@ARGV);
    &Emsg(ucfirst($item).' not specified.') if $v eq '';
    &Emsg(ET("Invalid $item, '$v'")) if !-d $v;
    return $v;
}

sub GetOwners {my($ug) = @_;
     my($usr, $grp) = split(/:/, $ug, 2);
     if ($usr ne '')
        {if (IsNum($usr)) {$XfrUID = $usr;}
            else {$XfrUID = getpwnam($usr);
                  &Emsg("User '$usr' is not valid.") if !defined($XfrUID);
                 }
        }
     if ($grp ne '')
        {if (IsNum($grp)) {$XfrGID = $grp;}
            else {$XfrGID = getgrnam($grp);
                  &Emsg("Group '$grp' is not valid.") if !defined($XfrGID);
                 }
        }
}

sub GetPswd {my($fn) = @_;
    &Emsg(ET("Unable to open keyfile '$fn'")) if !open(KTFD, $fn);
    $XfrPswd = <KTFD>; close(KTFD);
}

sub GetVal {my($item, $type, $minv) = @_; my($v, $q);
    $v = shift(@ARGV); $q = 0;
    &Emsg(ucfirst($item).' not specified.') if $v eq '';
    if ($type eq 'Q') { $q = uc(chop($v));
                           if ($q eq 'K') {$q = 1024;}
                        elsif ($q eq 'M') {$q = 1024*1024;}
                        elsif ($q eq 'G') {$q = 1024*1024*1024;}
                        else  {$v .= $q; $q = 0;}
                      }
    &Emsg("Invalid $item, '$v'.") 
         if ($type eq 'N' || $type eq 'Q') && !&IsNum($v);
    &Emsg("$item, '$v', is too small.")
         if ($type eq 'N' && $v < $minv);
    $v = $v*$q if $q;
    return $v;
    }

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

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

sub Emsg {my($msg,$ret,$rc) = @_;
    print STDERR $MsgPfx,$msg,"\n";
    Logit($msg) if !$isCPY;
    return 0 if $ret > 0;
    Usage(4) if $ret < 0;
    $rc = 4 if $rc eq "";
    &CleanUp($rc);
    }

sub ET {my($etxt) = @_; return $etxt.'; '.lcfirst($!).'.';}

sub Logit {my($msg) = @_; $ErrLog .= $MsgPfx.$msg."\n";}

sub PHandler {$SIG{PIPE} = 'DEFAULT';}
sub THandler {$SIG{TERM} = 'DEFAULT'; kill(-15, getpgrp(0));}