#!/usr/bin/perl

#
# Aspera command line web client
#
# (c) 2004, Aspera
#

use File::Basename;

# Verify arguments
if ($#ARGV < 0) {
  print "Usage: asperawebget <fasp-url>\n";
  exit 1;
}

#
# To enable debugging: export DEBUG=1
#
$DEBUG = 0;

# URL elements
$host;
$rpath;
$user;
$path;

# Transfer parameters
$auth    = 'yes';
$enc     = 'no';
$defrate = '1000';
$adapt   = 'yes';
$sshport = '22';
$port    = '33001';
$up      = 'no';

#
# Main program
#

print "Aspera Web Client\n";
&set_debug;

# Local path
$lpath = ".";

parse_fasp_url($ARGV[0]);
spawn_scp();

# 
# That was all!
#

sub parse_fasp_url {
    local($url)=pop(@_);

    # Check protocol
    ($fasp, $rest) = split('://', $url);
    ($fasp eq 'fasp') || err("Invalid protocol: $fasp");

    ($rpath, $query) = split('\?', $rest);
    dbg("rpath: $rpath");
    dbg("query: $query");

    # Parse the query list
    parse_fasp_query($query);

    if ($up eq 'yes') {
        &read_source_path;
    }

    # Parse path
    ($rhost, @pathlist) = split('/', $rpath);
    $path = join('/', @pathlist);
    dbg("path: $path");

    # Parse user:pass@host:port
    $pos = index($rhost, '@');
    if ($pos < 0) {
	    # No user and password
        $hostport = $rhost;
        print "Username: ";
        $user = <STDIN>;
        chomp($user);
        $pass = "";
    } else {
        ($userpass, $hostport) = split('@', $rhost);
        $pos = index($userpass, ':');
        if ($pos < 0) {
            # No password
            $user = $userpass;
            $pass = "";
        } else {
            ($user, $pass) = split(':', $userpass);
        }
    }

    # Parse host:port
    $pos = index($hostport, ':');
	if ($pos < 0) {
	    # No port
        $host = $hostport;
	    $sshport = 22;
	} else {
       ($host, $sshport) = split(':', $hostport);
    }

    dbg("user: $user pass: $pass");
    dbg("host: $host sshport: $sshport");
    dbg("path: $path");

    $rpath = $user.'@'.$host.':'.$path;
}

sub parse_fasp_query {
    local($query)=pop(@_);
    @nvlist = split('&', $query);
    foreach $nv (@nvlist) {
        ($n, $v) = split('=', $nv);
        dbg("$nv");
        ($v ne '') || err("Invalid URL: $n");
        if ($n eq 'auth') { $auth = $v; }
        if ($n eq 'enc') { $enc = $v; }
        if ($n eq 'defrate') { $defrate = $v; }
        if ($n eq 'targetrate') { $defrate = $v; }
        if ($n eq 'adapt')  { $adapt = $v; }
        if ($n eq 'policy') {
            if ($n eq 'fair') { $adapt = "yes"; }
        }
        if ($n eq 'port') { $port = $v; }
        if ($n eq 'up') { $up = $v; }
    }
}

sub parse_fasp_query_old {
    local($query)=pop(@_);
    @nvlist = split('&', $query);
    foreach $nv (@nvlist) {
        ($n, $v) = split('=', $nv);
        dbg("$nv");
        ($v ne '') || err("Invalid URL: $n");
        if ($n eq 'auth'    ) { $auth    = $v; }
        if ($n eq 'enc'     ) { $enc     = $v; }
        if ($n eq 'defrate' ) { $defrate = $v; }
        if ($n eq 'adapt'   ) { $adapt   = $v; }
        if ($n eq 'port'    ) { $port    = $v; }
        if ($n eq 'up'      ) { $up      = $v; }
    }
}

sub spawn_scp {

    if ($user eq '') {
    }
    spawn_transfer();
}

sub spawn_transfer {
    @scpargs;

    push(@scpargs, "-k2");
    if (($enc eq 'none') || ($enc eq 'no')) { push(@scpargs, "-T"); }
    if ($adapt eq 'yes') { push(@scpargs, "-Q"); }
    push(@scpargs, "-l$defrate");
    push(@scpargs, "-P$sshport");
    push(@scpargs, "-O$port");
    push(@scpargs, "-i".dirname(__FILE__)."/../etc/asperaweb_id_dsa.putty");

    if ($up eq 'yes') {
      push(@scpargs, "$lpath");
      push(@scpargs, "$rpath");
    } else {
      push(@scpargs, "$rpath");
      push(@scpargs, "$lpath");
    }

    # Off we go
    dbg("Run @scpargs");
    $rc = system('ascp', @scpargs);
}

sub read_source_path {
    print "File or directory to upload: ";
    $lpath = <STDIN>;
    chomp($lpath);
}

sub set_debug {
    $DEBUG = $ENV{"DEBUG"};
    dbg("Debugging enabled\n");
}

sub dbg {
    $DEBUG && print "@_\n";
}

sub err {
    print "@_\n";
    exit(1);
}

