#!/usr/bin/perl -w

# CLI client for the FEX service for retrieving files
#
# see also: fexsend
#
# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
#
# Copyright: GNU General Public License

use 5.006;
use strict qw(vars subs);
use POSIX;
use Getopt::Std;
use Socket;
use IO::Handle;
use IO::Socket::INET;
use Encode;
use I18N::Langinfo qw(langinfo CODESET);

$0 =~ s:.*/::;
$| = 1;

our $SH;
our $bs = 2**16; # blocksize for tcp-reading and writing file

my $usage = <<EOD;
usage: $0 [-v] [-m limit] [-s filename] [-k] F*EX-URL ...
   or: $0 [-v] -d F*EX-URL ...
   or: $0 -l
   or: $0 -a
options: -v verbose mode
         -m limit kB/s
         -s save to filename (-s- means: write to STDOUT/pipe)
  	 -k keep on server
  	 -d delete without download
  	 -l list files on server
  	 -a get server address book
argument: F*EX-URL may be file number (see: $0 -l)
EOD
  
my $tmpdir = $ENV{FEXTMP} || $ENV{HOME}.'/.fex/tmp';
my $atype = '\.(tgz|tar|zip|7z)$';

our ($opt_h,$opt_v,$opt_l,$opt_a,$opt_d,$opt_m,$opt_s,$opt_k,$opt_z);
$opt_m = $opt_h = $opt_v = $opt_l = $opt_a = $opt_d = $opt_k = 0;
$opt_s = $opt_k = '';
getopts('hnvqldkazm:s:') or die $usage;
$opt_k = '?KEEP' if $opt_k;
if ($opt_m =~ /(\d+)/) { 
  $opt_m = $1 
} else { 
  $opt_m = 0
}
  
my $ffl; # F*EX files list (cache)

if ($opt_a) {
  my $cmd = "fexsend -@";
  if ($opt_v) {
    $cmd .= " -v";
    warn "$cmd\n";
  }
  exec $cmd or die "$0: cannot exec $cmd - $!\n";
  exit;
}

if ($opt_z) {
  my $cmd = "fexsend -Z";
  warn "$cmd\n" if $opt_v;
  exec $cmd;
  die "$0: cannot run $cmd : $!\n";
}

if ($opt_l) {
  my $cmd = "fexsend -L";
  if ($opt_v) {
    $cmd .= " -v";
    warn "$cmd\n";
  }
  open $cmd,"$cmd|" or die "$0: cannot run $cmd : $!\n";
  open $ffl,">$tmpdir/fexget" or die "$0: cannot open $tmpdir/fexget : $!\n";
  my $n;
  while (<$cmd>) {
    if (/\d MB http/) {
      $n++;
      printf {$ffl} "%4d) %s",$n,$_;
      s:http.*/::;
      printf        "%4d) %s",$n,$_;
    } else {
      print;
      print {$ffl} $_;
    }
  }
  exit;
}

die $usage if $opt_h;
die $usage unless @ARGV;

my ($file,%files,$download,$server,$port,$fop);

foreach my $url (@ARGV) {

  if ($url !~ /^http/) {
    unless (%files) {
      open $ffl,"$tmpdir/fexget" or die "$0: no $tmpdir/fexget, use first: $0 -l\n";
      my $from = '';
      while (<$ffl>) {
        if (/^from (.+) :$/) {
          $from = $1;
        } elsif (/^\s*(\d+)\)\s+\d+ MB (\S+)/) {
          push @{$files{all}},$2;
          push @{$files{$from}},$2;
        }
      }
      close $ffl;
    }

    if ($url =~ /^(\d+)$/) {
      $url = ${files{all}}[$1-1] or die "$0: unknown file number\n";
    }
  }

  if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/fop/\S+)}) {
    $server = $2;
    $port   = $4 || ($1?443:80);
    $fop    = $5;
  } else {
    die "$0: unknown F*EX URL $url\n";
  }

  if ($opt_d) {
    tcpconnect($server,$port) unless $SH;
    my @r = del($url);
    $_ = shift @r;
    if (/^HTTP.* 200/) {
      $file = $url;
      $file =~ s:.*/::;
      print "$file deleted\n";
    } else {
      s:HTTP/[\d\. ]+::;
      die "$0: server response: $_";
    }
    next;
  }

  $file = $url;
  $file =~ s:.*/::;
  $file =~ s:\?.*::;
  $file =~ s:%([a-f0-9]{2}):chr(hex($1)):ge;
  $file =~ s:/:_:g;

  tcpconnect($server,$port);
  
  # maybe UTF-8 filename? ==> ask server for full filename!
  if ($file =~ /_/) {
    print     "HEAD $fop HTTP/1.1\n" if $opt_v;
    print $SH "HEAD $fop HTTP/1.1\r\n\r\n";
    $_ = <$SH>;
    unless (defined $_ and /\w/) { 
      die "$0: no response from server\n";
    }
    unless (/^HTTP\/[\d.]+ 200/) {
      s:HTTP/[\d. ]+::;
      die "$0: server response: $_";
    }
    while (<$SH>) { 
      s/\r//;
      print "\t$_" if $opt_v;
      last if /^\r?\n/;
      if (/^Content-Disposition: attachment; filename="(.+)"/i) {
        $file = decode_utf8($1);
      }
    }
  }

  if ($opt_s) {
    $download = $opt_s;
  } elsif ($file =~ /$atype/) {
    unless (-d $tmpdir) {
      mkdir $tmpdir,0700 or die "$0: cannot create tmpdir $tmpdir - $!\n";
    }
    $download = "$tmpdir/$file";
  } else {
    $download = locale($file);
  }

  my $seek = 0;
  if (-f $download and $seek = -s $download) {
    print "found:\n";
    system qw(ls -l),$download;
    print "continue download on this file? [Yn] ";
    $_ = <STDIN>;
    if (/^\s*n/i) {
      $seek = 0;
    }
    # new connection because of probably server timeout
    tcpconnect($server,$port);
  }
  $download = download($url.$opt_k,$download,$seek);
  exit if $opt_s eq '-';
  unlink $download unless -s $download;
  exit 2 unless -f $download;

  if ($file =~ /$atype/) {
    print "Files in archive:\n";
    if ($file =~ /\.tgz$/) {
      system qw(tar tvzf),$download;
      &cont; 
      system qw(tar xvzf),$download;
    } elsif ($file =~ /\.tar$/) {
      system qw(tar tvf),$download;
      &cont; 
      system qw(tar xvf),$download;
    } elsif ($file =~ /\.zip$/i) {
      system qw(unzip -l),$download;
      &cont; 
      system qw(unzip),$download;
    } elsif ($file =~ /\.7z$/i) {
      system qw(7z l),$download;
      &cont; 
      system qw(7z x),$download;
    } else {
      die "$0: unknown archive $file\n"; 
    }
    if ($? == 0) {
      unlink $download;
    } else {
      die "$0: keeping $download\n";
    }
  }  

}
exit;

sub cont {
  print "extract these files? ";
  $_ = <STDIN>;
  unless (/^y/i) {
    print "keeping $download\n";
    exit;
  }
}

sub del {
  my $url = shift;
  my ($server,$port);
  my $del;
  my (@hh,@r);
  
  if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/fop/.+)}) {
    $server = $2;
    $port   = $4 || ($1?443:80);
    $del    = $5.'?DELETE';
  } else {
    die "$0: unknown F*EX URL $url\n";
  }
  
  push @hh,"GET $del HTTP/1.1",
           "Host: $server:$port",
           "User-Agent: fexget",
           "";
  
  foreach (@hh) {
    warn $_,"\n" if $opt_v;
    print $SH $_,"\r\n";
  }
  while (<$SH>) { 
    s/\r//;
    last if /^\n/;
    push @r,$_;
  }
  die "$0: no response from fex server $server\n" unless @r;
  grep { warn "\t$_" } @r if $opt_v;
  return @r;
}

sub download {
  my ($url,$file,$seek) = @_;
  my $save_file = $file;
  my ($server,$port,$ssl);
  my ($fop,$pipe);
  my (@hh,@r);
  my ($t0,$t1,$t2,$tt,$tm,$ts,$kBs,$b,$bt,$TB,$B,$length,$buf);
  local $_;

  $pipe = $file if $file eq '-';
  
  if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/fop/.+)}) {
    $server = $2;
    $port   = $4 || ($1?443:80);
    $fop    = $5;
  } else {
    die "$0: unknown F*EX URL $url\n";
  }
  
  push @hh,"GET $fop HTTP/1.1",
           "Host: $server:$port",
           "User-Agent: fexget";
  push @hh,"Range: bytes=$seek-" if $seek;
   
  foreach (@hh) {
    warn      $_,"\n" if $opt_v;
    print $SH $_,"\r\n";
  }
  print $SH "\r\n";
  $_ = <$SH>;
  die "$0: no response from fex server $server\n" unless $_;
  s/\r//;
  
  if (/^HTTP\/[\d.]+ 2/) {
    warn "\t$_" if $opt_v;
    while (<$SH>) {
      s/\r//;
      print "\t$_" if $opt_v;
      last if /^\r?\n/;
      if (/^Content-length:\s*(\d+)/i) { 
        $length = $1;
      } elsif (/^Content-Disposition: attachment; filename="(.+)"/i) {
        $save_file = decode_utf8($1);
        $save_file =~ s:.*/::;
      }
    }
  } else {
    s/HTTP\/[\d.]+ \d+ //;
    die "$0: bad server reply: $_";
  }

  if ($pipe) {
    *X = *STDOUT;
  } else {
    open X,'>>',locale($file) or die "$0: cannot write to $file - $!\n";
  }
  
  $t0 = $t1 = $t2 = $tt = time;
  $TB = $B = 0;
  printf "resuming at byte %d\n",$seek if $seek and not $pipe;
  while ($b = read $SH,$buf,$bs) {
    print X $buf;
    unless ($TB or $pipe) {
      printf "transfered: %d kB (%d%%) %d kB/s\r",
             int(($b+$seek)/1024),
             int(($b+$seek)/($length+$seek)*100),
             int($b/1024);
    }
    $B += $b;
    $TB += $b;
    $bt += $b;
    $t2 = time;
    while ($opt_m and (
      $t2 > $t0 and $TB/1024/(time-$t0) > $opt_m and $length-$TB > $opt_m)
      or
      $t2 == $t0 and $B > $opt_m*1024
    ) {
      if ($opt_v and $t2 > $t0) {
        printf "\n%d kB/s - sleeping...",int($TB/1024/($t2-$t0));
      }
      sleep 1;
      $t2 = time;
    }
    if ($t2 > $t1) {
      # smaller block size is better on slow links
      $bs = 4096 if $bs>4096 and $TB/($t2-$t0)<65536;
      unless ($pipe) {
        if ($TB<2*1024*1024) {
          printf "\rtransfered: %d kB (%d%%) %d kB/s        \r",
                 int(($TB+$seek)/1024),
                 int(($TB+$seek)/($length+$seek)*100),
                 int($bt/1024/($t2-$tt));
        } else {
          printf "\rtransfered: %d MB (%d%%) %d kB/s        \r",
                 int(($TB+$seek)/1048576),
                 int(($TB+$seek)/($length+$seek)*100),
                 int($bt/1024/($t2-$tt));
        }
      }
      # new calculation of transfer rate
      if ($t2-$tt>10) {
        $bt = 0;
        $tt = time;
      }
      while ($opt_m and $B/1024/(time-$t1) > $opt_m and $length-$TB > 5*$opt_m) {
        printf "\n%d kB/s - sleeping...",int($B/1024/(time-$t1)) if $opt_v;
        sleep 1;
      }
      $t1 = time;
      $B = 0;
    }
  }
  close $SH;
  close X;
  $tm = int(($t2-$t0)/60);
  $ts = $t2-$t0-$tm*60;
  $kBs = int($TB/1024/(($t2-$t0)||1));
  unless ($pipe) {
    if ($seek) {
      printf "$file: %d MB, last %d MB in %d:%02d = %d kB/s\n",
             int(($TB+$seek)/1048576),int($TB/1048576),$tm,$ts,$kBs;
    } else {
      printf "$file: %d MB in %d:%02d = %d kB/s\n",
             int($TB/1048576),$tm,$ts,$kBs;
    }
  }
  if ($TB != $length) {
    die "$0: $server annouced $length bytes, but only $TB bytes has been read\n";
  }
  
  if ($file ne $save_file) {
    if (-e $save_file) {
      print "\"$save_file\" already exists in CWD\n";
      print "overwrite it? ";
      $_ = <STDIN>;
      unless (/^y/i) {
        print "keeping $file\n";
        exit;
      }
    }
    print "$file --> $save_file\n";
    rename locale($file),locale($save_file) or 
    system 'mv',locale($file),locale($save_file) and exit 3;
    $file = $save_file;
  }
  return locale($file);
}


# set up tcp/ip connection
sub tcpconnect {
  my ($server,$port) = @_;
  
  if ($port == 443) {
    eval "use IO::Socket::SSL";
    $SH = IO::Socket::SSL->new(
      PeerAddr => $server,
      PeerPort => $port,
      Proto    => 'tcp',
    );
  } else {
    $SH = IO::Socket::INET->new(
      PeerAddr => $server,
      PeerPort => $port,
      Proto    => 'tcp',
    );
  }
  die "cannot connect $server:$port - $@\n" unless $SH;
  print "TCPCONNECT to $server:$port\n" if $opt_v;
}


sub locale {
  my $string = shift;
  my $CTYPE = langinfo(CODESET);

  if ($CTYPE) {
    if ($CTYPE =~ /UTF-?8/i) {
      return $string;
    } elsif (grep { $CTYPE =~ /^$_$/i } Encode->encodings()) {
      return encode($CTYPE,$string);
    } else {
      return encode('ISO-8859-1',$string);
    }
  }

  return $string;
}
