#!/usr/bin/perl
#
# Perform the CERN archive command
#
# Syntax
#
#   pubarch operation [flags] files
#
# History
#
# Date   Who    What
# 100805 CSN   Test version to pubarch2 and tsm002
# 200105 HRR   Change perl and arc paths to /usr/bin
# 230197 CSN   Accept match on either USER or LOGNAME on return from whoami
# 181196 CSN   Corrected help text to use Retrieve instead of Recall
# 151196 CSN   Added check for no files found if confirm asked (was asking confirmation for no files).
# 151196 CSN   Changed msg to emsg and code to ecode in last lines.
#               Was giving: "my" variable $msg masks earlier declaration in same scope at /usr/local/bin/pubarch line 418
# 150896 CSN   Add -Servername=pubarch to guard against changes in dsm.opt on ADSM2
# 070696 CSN   Fix: -subdir=yes was generated only if directory was specified
# 100596 CSN   Description: replace blanks by underscores
# 080596 CSN   Make default replace no for retrieve
# 070596 CSN   Add destination filespace handling on Retrieve
# 250496 CSN   Add destination file on Retrieve
# 250496 CSN   Put error message after usage text
# 250496 CSN   Allow y|n as yes|no on -replace
# 220496 CSN   parameters and messages cleanup
# 110496 CSN   uarch changed to pubarch
# 220196 JK    Rewritten in Perl 5
#		- long option names (can be abbreviated to uniqueness)
#		- multiword description workaround
#		- separated query and list
# 301195 CSN   Add -s summary option
# 301195 CSN   Allow abbreviations for archive, retrieve and query
# 301195 CSN   Add check for too long files spec (because of *)
# 201295 CSN   Add error message if file not found on archive
# 211295 CSN   Add all normal ADSM options, as one char option: -t -f -s -r
# 211295 CSN   Add Delete Archive function. Problem: asks for OK y/n, user does not see it...?
# 141298 CSN   Add warnings and ask for confirmation if too many files or bytes to archive
# 150199 CSN   Add flags -nbfiles and -size to specify archive limits
# 100399 CSN   Values selected are: -nbfiles: 2000, -size: 500 MB
# 040408 CSN   Run dsmc on tsmms (Linux) instead of tsm002 (AIX)
# 171208 CSN   Use Aliases for agent and server
# 300109 AI    Cosmetic changes
# 180309 AI    Add support for using curly brackets to specify filespace (as in {/afs}/cern.ch/...) 

# Still to be done
# Check that -nbfiles, -size arguments are numeric

#

($program = $0)  =~ s,.*/,,;
$cell            = "CERN.CH";
$adsmserver      = "pubarch";          # not used because optfile decides stanza name in dsm.sys
$operation       = "";
$opt_server      = "pubarch-agent";    # archiveserver
$opt_description = "";                 # description
$opt_subdir      = 0;                  # subdirs -> NO
                                       # Otherwise the -subdir flag is senseless

$outfname        = "pubarch.out";
$dispfname       = "pubarch.display";
$archnlimit      = 2000;               # Warning limit for number of files to archive
$archslimit      = 512000;             #  Warming limit for number of Kbytes to archive

$operation = $ARGV[0];
shift(@ARGV);

if ( $operation =~ /^(archive|arch|a)$/ ) {
    $operation = "archive";
} elsif ( $operation =~ /^(retrieve|retr|r)$/ ) {
    $operation = "recall";
} elsif ( $operation =~ /^(delete|del|d)$/ ) {
    $operation = "delete";
} elsif ( $operation =~ /^(query|q)$/ ) {
    $operation = "query";
} elsif ( $operation =~ /^(list|l)$/ ) {
    $operation = "list";
} elsif ($operation) {
    usage( "operation $operation not known\n", 22 );
} else {
    usage( "operation must be supplied\n", 22 );
}

use Getopt::Long;

$junk = GetOptions(
    "verbose", "server|h=s", "description=s", "archmc=s",
    "confirm", "fromdate=s", "todate=s",      "replace=s",
    "subdir",  "pick",       "nbfiles=s",     "size=s"
);

usage( "unknown flag", 22 ) unless $junk;

usage( "-fromdate or -todate flags are for query/list or retrieve only\n", 22 )
  if ( $opt_fromdate || $opt_todate ) && $operation !~ /recall|query|list/;

usage( "-replace flag for retrieve only\n", 22 )
  if $opt_replace && $operation ne "recall";

usage( "-archmc flag for archive only\n", 22 )
  if $opt_archmc && $operation ne "archive";

usage( "-nbfiles flag for archive only\n", 22 )
  if $opt_nbfiles && $operation ne "archive";

usage( "-size flag for archive only\n", 22 )
  if $opt_size && $operation ne "archive";

usage( "invalid -replace $opt_replace option\n", 22 )
  if $opt_replace && $opt_replace !~ /^(yes|no|y|n)$/;

usage( "-pick flag for delete only\n", 22 )
  if $opt_pick && $operation ne "delete";

if ( $opt_nbfiles > 0 ) {
    $archnlimit = $opt_nbfiles;
}

if ( $opt_size > 0 ) {
    $archslimit = $opt_size;
}

#
# Now make all of the file names absolute
#
$files = join( ' ', @ARGV );

#print "argv: @ARGV \n";
# add check for length of files string: if longer than 256 characters (?)
# issue error message (probably related to * not quoted) and exit
#print "test: lengthfiles: ", length($files), "\n";
if ( length($files) >= 256 ) {
    fatal( <<MSG, 22 );
Too many files arguments passed
If using *, please quote by double quotes, e.g. my"*"files
MSG
}

chop( $curdir = `pwd` );

for $file (@ARGV) {
    if ( $file =~ /^\~/ ) {
        substr( $file, 0, 1 ) = "$ENV{'HOME'}/";
    } elsif ( $file !~ m,^(/|{/), ) {
        $file = "$curdir/$file";
    }

    $junk = $ENV{'HOME'} =~ m,^/afs/, ? 'AFS' : "AFS or $ENV{'HOME'}";

    fatal( "file $file is not in $junk\n", 22 )
      if $operation eq "archive" && $file !~ m,^(/afs/.?|$ENV{'HOME'}),;
}

#print "test: argv: @ARGV \n";
$files = join( ' ', @ARGV );    # it might changed!!

if ( $operation eq "recall" ) {
    @rfiles = @ARGV;
    $ofile  = $rfiles[0];       # retrieved file
    $tfile  = $rfiles[1];       # replacement file, if any
    $zfile  = $rfiles[2];

    #print "test: files: $files \n ofile: $ofile \n tfile: $tfile \n zfile: $zfile \n";
    if ($zfile) {
        usage( "No more than two filespecifications for Retrieve\n", 22 );
    }
    @sfiles = glob($ofile);
    $tdfile = $ENV{'$HOME'};
    if ( $sfiles[1] && !-d $tfile ) {
        # open(OUT,"mkdir $tfile");
        # print "Multiple files to be retrieved, destination not a directory,\n creating directory $tfile\n";
        usage( "Multiple files to be retrieved and destination is not a directory\n Please specify the destination directory $tfile and resubmit \n", 22 );
    }
    if ( !$opt_replace ) {
        $opt_replace = "n";
    }
}

@files = glob($files);    # file list, after shell subst.

#print "files = @files\n";

if ( !$files ) {
    if ( $operation eq "archive" ) {
        fatal( "file(s) specified: $files not found\n", 24 );
    } elsif ( $operation !~ /query|list/ ) {
        fatal( "must supply a list for files for $operation\n", 22 );
    } else {
        $files = $ENV{'HOME'};
        @files = ($files);
    }
}

#if ($operation eq "recall")  {
#    $ofile=$files[0];       # retrieved file
#   $tfile=$files[1];       # replacement file, if any
#    $zfile=$files[2];
#print "test: files: $files \n ofile: $ofile \n tfile: $tfile \n zfile: $zfile \n";
#    if ($zfile) {
#       usage("No more than two filespecifications for Retrieve\n",22);
#    }
#}

if ($opt_subdir) {    # I think it was missing from the shell ver.
    foreach $file (@files) {
        if ( -d $file ) {
            $subdoptions = "-subdir=yes";
            last;
        }
    }
}

if ($opt_subdir) {    # force subdir=yes if specified
    $subdoptions = "-subdir=yes";
}

# If asked by -confirm, tell submitter which files will be archived

if ( "$operation" eq "archive" && $opt_confirm && $files ) {
    local ( $answ, $nel, $size, %size );
    foreach $file (@files) {
        sizeof($file);
    }
    if ("$nel") {
        print "The following files will be archived:\n";
        print "Number of elements: $nel\n";
        foreach $file ( sort keys(%size) ) {
            print "$size{$file}	$file\n";
        }
        $ksize = $size / 1024;
        $ksize = substr( $ksize, 0, index( $ksize, "." ) );
        print "Total: $ksize Kbytes\n";
        print "Do you want to proceed? [y/n]: ";
        chop( $answ = <STDIN> );
        if ( $answ !~ /^y$/i ) {
            print "OK, pubarch $operation operation cancelled\n";
            exit;
        }
    } else {
        print "No files found, archive cancelled\n";
        exit;
    }

}

# Give message and ask for confirmation if too many files or bytes to be archived
if ( "$operation" eq "archive" ) {
    local ( $answ, $nel, $size, %size );
    foreach $file (@files) {
        sizeof($file);
    }
    if ( $nel > $archnlimit ) {
        print "You asked to archive $nel files, which exceeds the limit of $archnlimit\n";
        print "Type [y] to confirm your archive request, anything else will cancel the operation:  ";
        chop( $answ = <STDIN> );
        if ( $answ !~ /^(y|yes)$/i ) {
            print "OK, pubarch $operation operation cancelled\n";
            exit;
        }
    }
    $ksize = $size / 1024;
    $ksize = substr( $ksize, 0, index( $ksize, "." ) );

    if ( $ksize > $archslimit ) {
        print "You asked to archive $ksize Kbytes, which  exceeds the limit of $archslimit Kbytes\n";
        print "Type [y] to continue, anything else will cancel your request: ";
        chop( $answ = <STDIN> );
        if ( $answ !~ /^(y|yes)$/i ) {
            print "OK, pubarch $operation operation cancelled\n";
            exit;
        }
    }
}

#
# Now perform the operation
#

unlink("dsmerror.log");

$command = "/usr/bin/arc -p -s -h $opt_server dsmc.afs -se=$adsmserver -t -- ";

#
# Check if arc is installed
#
if ( !-x "/usr/bin/arc" ) {
    fatal( "Error: the 'arc' program is not installed on this machine\n", 22 );
}

if ( !-x "/afs/usr/local/etc/GetToken" ) {
    fatal( "Error: the 'GetToken' program is not installed on this machine\n", 22 );
}

#
# Check to see if arc recognises us
#
chop( $whoami = `/usr/bin/arc -h $opt_server whoami 2>/dev/null` );

if ( "$whoami" ne "$ENV{'USER'}\@$cell" && "$whoami" ne "$ENV{'LOGNAME'}\@&cell" ) {
    print "Please enter your AFS password\n";
    `/usr/sue/bin/kinit`;
    exit 22 unless $? == 0;
}

$qoptions = $opt_verbose || $operation =~ /query|list/ ? "" : "-quiet";

#print "test: $opt_description\n";
$opt_description =~ s/ /_/g;

#print "test: $opt_description\n";
$opt_description = $opt_description ? "-description=\'$opt_description\'" : "";
$opt_fromdate    = $opt_fromdate    ? "-fromdate=\"$opt_fromdate\""       : "";
$opt_todate      = $opt_todate      ? "-todate=\"$opt_todate\""           : "";
$opt_replace     = $opt_replace     ? "-replace=$opt_replace"             : "";
$opt_archmc      = $opt_archmc      ? "-archmc=$opt_archmc"               : "";
$opt_pick        = $opt_pick        ? "-pick"                             : "";
$opt_nbfiles     = $opt_nbfiles     ? "-nbfiles=$opt_nbfiles"             : "";
$opt_size        = $opt_size        ? "-size=$opt_size"                   : "";

$qoptions = "$qoptions $opt_fromdate $opt_todate $subdoptions";
$aoptions = "$subdoptions $opt_archmc";
$roptions = "$subdoptions $opt_fromdate $opt_todate $opt_replace";
$doptions = "$subdoptions $opt_pick";
$toptions = "-tapeprompt=no";

#$files = "\'$files\'";

if ( $operation eq "archive" ) {
    $run = "archive $opt_description $aoptions $toptions $files";
} elsif ( $operation =~ /query|list/ ) {
    $run = "query archive $opt_description $qoptions $files";
} elsif ( $operation eq "recall" ) {
    $run = "retrieve $opt_description $roptions $ofile $tfile";
} elsif ( $operation eq "delete" ) {
    $run = "delete archive $opt_description $doptions $files";
} else {
    usage("operation $operation not implemented\n");
}

if ("$run") {
    print STDERR "Issuing: $run \n\n";
    if ( $operation eq "delete" ) {
        print "Do you want to proceed? [y/n]: ";
        chop( $answ = <STDIN> );
        if ( $answ !~ /^(y|yes)/i ) {
            print "OK, pubarch $operation operation cancelled\n";
            exit;
        }
    }

    open( OUT, "/afs/usr/local/etc/GetToken | $command \"$run\" 2>&1|" );
    if ( $operation =~ /query|list/ ) {
        local ( $start, $next, $line, @lines );

       #
       # Query: I assume here the following:
       #
       #	 - information begins after a line with dashes:
       #
       #	  -----
       #
       #	 - then for every file:
       #
       #	   (white space) size date time filename expires description
       #  V5.3    (white space) size Unit date time filename expires description
       #
       #	 - it can be wrapped into two lines! Try to figure it out
       #
        $line = '';
        while (<OUT>) {
            print if $operation eq "query" && $opt_verbose;
            if ($start) {
                chop;
                if (/^\s\s/) {
                    push( @lines, &splitline($line) );
                    s/^\s+//;
                    $line = $_;
                } else {
                    s/^\s+//;
                    $line .= $_;
                }
            } elsif (/^\s+\-\-\-\-/) {
                $start = 1;
            }
        }
        push( @lines, &splitline($line) );    # last file!
        close(OUT);
        if ( $operation eq "query" ) {
            if ( !$opt_verbose ) {
                print "Query Archive result for $files :  \n";
                &query;
            }
        } else {
            &list;
        }
    } else {
        while (<OUT>) {
            print if $opt_verbose || /^AN/;
        }
        close(OUT);
    }
}

sub fatal {
    my ( $msg, $code ) = @_;
    print STDERR "$program error: $msg";
    exit $code;
}

sub sizeof {
    local ( $file, $fsize ) = @_;
    if ( -d $file && $opt_subdir ) {
        foreach ( glob("$file/*") ) {
            sizeof($_);
        }
    } else {
        $fsize = ( stat(_) )[7];
        $size{$file} = $fsize;
        $nel++;
        $size += $fsize;
    }
}

sub query {
    my ($line) = @_;

    foreach $line (@lines) {
        next unless $line->[3];
        print <<EOF;
			
Filename:	 $line->[4]
Description:	 $line->[6]
Details:	 size=$line->[0] unit=$line->[1] date=$line->[2] time=$line->[3] expires=$line->[5]
EOF
    }
}

sub list {
    my ($line) = @_;
    my ($longest);

    foreach $line (@lines) {
        $line->[7] = length( $line->[4] );
        $longest = $line->[7] if $line->[7] > $longest;
    }
    foreach $line (@lines) {
        next unless $line->[4];
        $tmp = $line->[4];
        $tmp .= " " x ( $longest - $line->[7] );
        print "$tmp\t$line->[2]   $line->[5]\n";
    }
}

sub splitline {
    my ($line) = @_;
    my (@line);

    @line = split( ' ', $line );
    $line[5] =~ s/_/ /g;

    return \@line;
}

sub usage {
    my ( $msg, $code ) = @_;
    print STDERR "$program error: $msg\n" if $msg;
    print <<EOF;
    Usage: $program operation [flags] files

provides a central archive facility for files

Operations are

   archive	Archive file(s)
   retrieve	Retrieve file(s)
   query	Query files in the archive
   list		Query files in the archive and produce compact list
   delete	Delete archived files

Flags are

   -verbose			Verbose (no effect in the case 'list')
   -description "description"	Description of files to archive or retrieve
   -confirm 			Ask for confirmation before archiving
   -subdir			Subdir=yes: will include Subdirectories
   -archmc "class"		Management class (for 'archive' only)
   -fromdate "fromdate"		For 'query', 'list' and 'retrieve' only
   -todate "todate"		For 'query', 'list' and 'retrieve' only
   -replace [yes|no]		Replace automatically (for 'retrieve' only)
   -nbfiles "number"            Maximum number of files to  be  archived. If exceeded,  you will get a warning. Default: 2000 files
   -size "number"               Maximum number of KB to archived/ If exceeded, you will get a warning. Default: 512000 KB  (500 MB)
EOF
    my ( $emsg, $ecode ) = @_;
    print STDERR "$program error: $emsg\n" if $emsg;
    exit $ecode;
}

