#!/usr/bin/perl -w
#
# Copyright (c) 2004 Parallelldatorcentrum
# (Center for Parallel Computers, KTH, Sweden)
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without 
# modification, are permitted provided that the following conditions 
# are met: 
#
# 1. Redistributions of source code must retain the above copyright 
#    notice, this list of conditions and the following disclaimer. 
#
# 2. Redistributions in binary form must reproduce the above copyright 
#    notice, this list of conditions and the following disclaimer in the 
#    documentation and/or other materials provided with the distribution. 
#
# 3. Neither the name of the Institute nor the names of its contributors 
#    may be used to endorse or promote products derived from this software 
#    without specific prior written permission. 
#
# THIS SOFTWARE IS PROVIDED BY THE INSTITUTE AND CONTRIBUTORS ``AS IS'' AND 
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 
# ARE DISCLAIMED.  IN NO EVENT SHALL THE INSTITUTE OR CONTRIBUTORS BE LIABLE 
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 
# SUCH DAMAGE. 
#
# $Header: /afs/pdc.kth.se/home/p/pek/src/perl/hsmcmds-ng/RCS/hput,v 1.6 2005/05/17 08:59:39 pek Exp $
#
# pek@pdc.kth.se $Date: 2005/05/17 08:59:39 $
#
# Move files to remote storage and leave a stub file behind.
#

use English;
use strict;
use Getopt::Std;
use File::Basename;
use Cwd;

use vars qw($opt_d $opt_h $opt_k $opt_v $opt_V);

my ($version) = '0.9' . "\n";
my ($usage) = "Usage : [ -dhkvV ] infile\n";
my ($usage_long) = "Options : \n" .
    " -v         Print version.\n" .
    " -k         Keep the file locally.\n" .
    " -d         Debug\n" .
    " -V         Verbose\n" .
    "";

## Configureable stuff

# Commands on local machine
my ($rsh) = "/usr/heimdal/bin/rsh";
my ($sum) = "/usr/bin/sum";
my ($rm) = "/bin/rm";
my ($dd);

# Try to find a good dd
if ( -x "/bin/dd") {
    $dd = "/bin/dd";
}
elsif ( -x "/usr/bin/dd") {
    $dd = "/usr/bin/dd";
}
elsif ( -x "/usr/gnu/bin/dd") {
    $dd = "/usr/gnu/bin/dd";
}
else {
    print STDERR "Error : Failed to find \'dd\' command. \n";
    exit 1;
}

# Commands on remote (storage) machine
my ($r_dd) = "/bin/dd";
my ($r_ls) = "/bin/ls";
my ($r_sum) = "/usr/bin/sum";
my ($r_mkdir) = "/bin/mkdir";

# Name of remote (storage) machine
my ($hsmhost) = "hsm.pdc.kth.se";

my ($user) = getpwuid $UID;
my ($prefix) = $user =~ /^(.).*/;
# Base path on remote machine
my ($hsmbase) = "/hsm/home/$prefix/$user/rarch"; # This name should not collide
                                                 # with anything in HSM home

## End of configurable stuff

my ($fpath); # Local path
my ($fname); # Local file name
my ($rpath); # Remote path
my ($rname); # Remote file name

my ($suffix);

my ($str, $cmd, $rcmd, $rc, $rc2);

my ($verbose) = 0;
my ($debug) = 0;

sub debug(@) {
    if ($debug) {
        print "Debug : @_";
    }
}

sub verbose(@) {
    if ($verbose) {
        print "@_";
    }
}

sub run (@) {
    my ($rc);

    debug " @_\n"; $rc = 0;
    $rc = system (@_);
    return $rc >> 8;
}

# Arguments : remote host (string)
#             command (string)
# Executes command on remote host using rsh
sub rexec ($$) {
    my ($host) = $ARG[0];
    my ($cmd)  = $ARG[1];
    my ($res);
    
    verbose "$rsh $host $cmd\n";
    $res = `$rsh $host $cmd`;

    return $res;
}

sub remtest ($$) { # Return value of arg2 run remotely on host arg1
    my ($cmd) = "$rsh $ARG[0] /bin/sh -c \"\\\"if $ARG[1]; then echo 0; else echo 1; fi\"\\\"";
    my ($res);
#    print "$cmd\n";
    $res = `$cmd`;
    chomp $res;
    if ($res ne "0" && $res ne "1") {
	print STDERR "Error: Remote command failed \"$cmd\"\n";
	exit 1;
    }
    return $res;
}

sub rfcmp ($$$) { # Compare local and remote file. Return 1 if same.
    my ($file) = $ARG[0];
    my ($host) = $ARG[1];
    my ($rfile) = $ARG[2];
    my ($rc, $rc2, $rest);
    
    ($rc, $rest) = split ' ', rexec($host, "$r_sum -r $rfile"), 2;
    debug "rc $rc rest $rest\n";
    ($rc2, $rest) = split ' ', `$sum -r $file`, 2;
    debug "rc2 $rc2 rest $rest\n";
    chomp $rc; chomp $rc2;
    debug "rfcmp : Remote $rc, local $rc2\n";
    if ($rc == $rc2) {
	return 1;
    }
    
    return 0;
}

sub cleanpath($) { # Try to resolve .. and such in a path
    my ($opath) = $ARG[0];
    my ($cpath) = cwd;
    my ($rc);

    chdir dirname($opath) or die "No such directory " . dirname($opath) . "\n";
    $rc = cwd . "/" . basename($opath);
    chdir $cpath or die "Could not return to original path $cpath.\n";
    return $rc;
}

sub fullpath($) { # Return the full path of the argument
    my ($opath) = $ARG[0];

    # Non-absolute path gets prepended with cwd
    if (! ($opath =~ /^\/.*/)) {
	$opath = cwd() . "/$opath";
    }
    
    return cleanpath($opath);
}

#####################################################################
# Execution starts here
#####################################################################

if (!getopts('hkdvV') || $opt_h) {
    print $usage_long;
    exit;
}
if ($opt_v) {
    print $version;
    exit;
}
if ($#ARGV < 0) {
    print $usage;
    exit;
}
if ($opt_d) {
    $debug = 1;
}
if ($opt_V) {
    $verbose = 1;
}

debug " @ARGV\n";
foreach $str (@ARGV) {
    my ($i) = 0;
# build name
    $str = fullpath($str);
    ($fname, $fpath, $suffix) = fileparse($str);
    debug "fpath is $fpath\n";
    if (! defined $suffix) {
	$suffix = "";
    }
    if ($suffix eq ".hsm") {
	print STDERR "Error: Tried to migrate already migrated file $str\n";
	exit 1;
    }
    $rpath = $hsmbase . $fpath;
    $fname = $fname . $suffix;
    $rname = $fname;
    debug "rpath is $rpath and fname is $fname\n";
# check if it exists locally
    if ( -e "$fpath/$fname.hsm") {
	print STDERR "Error : File stub $fpath/$fname.hsm already exists.\n";
	exit 1;
    }
    if (! -e "$fpath/$fname") {
	print STDERR "Error : $fpath/$fname does not exist.\n";
	exit 1;
    }
# check if it exists remotely
    while (remtest($hsmhost, "[ -e $rpath/$rname ]") == 0) {
	debug "$rname exists, Trying ";
	$i++;
	$rname = $fname . ".$i";
	debug "$rname\n";
    }
# copy file
    if (remtest($hsmhost, "[ -e $rpath ]") != 0) { # Not a dir
	if (remtest($hsmhost, "$r_mkdir -p $rpath") != 0) {
	    print STDERR "Failed to make directory $rpath remotely.\n";
	    exit 1;
	}
    }
    $rc = run("$dd if=$fpath/$fname bs=64k | $rsh $hsmhost \"$r_dd of=$rpath/$rname bs=64k\"");
    if ($rc != 0) {
	print STDERR "Failed to copy file to host $hsmhost. Unknown error.\n";
	exit 1;
    }
# build *.hsm file
    open FH, ">$fpath/$fname.hsm" or die ("Failed to build local stub $fpath/$fname.hsm\n");
    if ($i > 0) {
	print FH "Suffix .$i:$hsmhost:$rpath/$rname\n";
    }
    else {
	print FH "Suffix none:$hsmhost:$rpath/$rname\n";
    }
    close FH;
# check remote file
    if (! rfcmp("$fpath/$fname", $hsmhost, "$rpath/$rname")) {
	print STDERR "Error: Remote file is not the same as local file ($rc != $rc2)\n";
	if (remtest($hsmhost, "rm -f $rpath/$rname") != 0) {
	    print STDERR "Error: Failed to remove bad remote file $rpath/$rname.\n";
	}
	unlink "$fpath/$fname.hsm";
	exit 1;
    }
# remove local file unless -k
    if (! defined $opt_k) {
	if (run("$rm $fpath/$fname") != 0) {
	    print STDERR "Failed to remove file $fpath/$fname\n";
	    exit 1;
	}
    }
}

exit;