#!/usr/bin/perl -w

# CLI client for the FEX service for retrieving files
#
# see also: fexsend
#
# Author: Ulli Horlacher <framstag@belwue.de>
#
# Perl Artistic Licence

use 5.010;
use strict qw'vars subs';
use Config;
use POSIX;
use Encode;
use Cwd 'abs_path';
use Getopt::Std;
use File::Basename;
use Socket;
use IO::Handle;
use IO::Socket::INET;
use Time::HiRes 'time';
use constant k => 2**10;
use constant M => 2**20;

eval 'use Net::INET6Glue::INET_is_INET6';

$| = 1;

our $SH;
our ($fexhome,$idf,$tmpdir,$windoof,$useragent,$cpid);
our ($xv,%autoview);
our $bs = 2**16; # blocksize for tcp-reading and writing file
our $version = 20200429;
our $CTYPE = 'ISO-8859-1';
our $fexsend = $ENV{FEXSEND};
our $del = '';
our $DEBUG = $ENV{DEBUG};
our $_0 = $0;
our $prg = $0;
our $proxy = '';
our $proxy_prefix = '';
our $chunksize = 0;
our $sleepwait = 1;

our ($opt_h,$opt_v,$opt_l,$opt_d,$opt_m,$opt_z,$opt_K,$opt_o,$opt_a,$opt_t);
our ($opt_q,$opt_s,$opt_k,$opt_i,$opt_V,$opt_X,$opt_f,$opt_P,$opt_L,$opt_H);
our ($opt_p,$opt_w,$opt_W);

our %SSL = (SSL_version => 'TLSv1_2');

my $sigpipe;
my $atype = '\.(tgz|tar|zip|7z)$';
my $status = 0;

unless ($version) {
  my @d = localtime((stat $0)[9]);
  $version = sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3])
}
$version .= '_sw' if abs_path($0) =~ m:/sw/:;

$ENV{LANGUAGE} = 'en';
$ENV{LC_MESSAGES} = 'C';

# inquire default character set
# cannot use "use I18N::Langinfo" because of no windows support!
eval {
  local $^W = 0;
  require I18N::Langinfo;
  I18N::Langinfo->import(qw'langinfo CODESET');
  $CTYPE = langinfo(CODESET());
};

if ($Config{osname} =~ /^mswin/i) {
  $windoof = $Config{osname};
  $ENV{HOME} = $ENV{USERPROFILE};
  $fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/fex';
  $tmpdir = $ENV{FEXTMP} || $ENV{TMP} || "$fexhome/tmp";
  $idf = "$fexhome/id";
  $useragent = sprintf("fexget-$version (%s %s)",
                       $Config{osname},$Config{archname});
  $SSL{SSL_verify_mode} = 0;
  chdir $ENV{USERPROFILE}.'\Desktop';
  # open XX,'>XXXXXX';close XX;
} else {
  # $fexget = $0;
  $prg =~ s:(.*)/::;
  $fexsend ||= "$1/fexsend";
  $del = "$1/del";
  $0 = "$prg @ARGV";
  $fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/.fex';
  $tmpdir = $ENV{FEXTMP} || "$fexhome/tmp";
  $idf = "$fexhome/id";
  if ($Config{osname} =~ /^darwin/i or $ENV{MACOS}) {
    $_ = `sw_vers -productVersion 2>/dev/null`||'';
    chomp;
    $useragent = "fexget-$version (MacOS $_)";
  } else {
    my $os;
    if (open my $osr,'/etc/os-release') {
      while (<$osr>) {
        $os = $1 if /PRETTY_NAME="(.+)"/;
      }
      close $osr;
    }
    unless ($os) {
      $os = `(lsb_release -d||uname -a)2>/dev/null`||'';
      chomp $os;
      $os =~ s/^Description:\s+//;
    }
    $useragent = "$prg-$version ($os)";
  }
}

if (-f ($_ = '/etc/fex/config.pl')) {
  eval { require } or warn $@;
}

if ($Config{osname} eq 'cygwin') {
  $SSL{SSL_verify_mode} = 0;
}

if (my $fua = $ENV{FUA}) { $useragent =~ s:^:$fua/: }
$ENV{FUA} = $useragent;
$ENV{FUA} =~ s/ .*//;

# import common functions
# if (open $fexsend,$fexsend) {
#   local $/;
#   $_ = <$fexsend>;
#   close $fexsend;
#   if (/\n(\#package FEX.*)/s) {
#     eval $1 or die $@;
#   } else {
#     die "$prg: package FEX missing in $fexsend\n";
#   }
# } else {
#   die "$prg: cannot open $fexsend - $!\n";
# }

my $usage = <<EOD;
usage:
  $prg [options] URL|NUMBER
  $prg [options] [-w] [-W] SENDER ['FILE'] ['COMMENT']
  $prg [options] -f URL|NUMBER EMAIL-ADDRESS
  $prg [options] -l [SENDER]
  $prg [options] -L
  $prg [options] -t NUMBER
  $prg -H
options:
  -v             verbose mode
  -q             quiet mode: no transfer status
  -i account     use ID data [account] from ID file
  -m max         max kB/s download rate
  -p size:wait   get file in chunks (size in MB, wait interval in seconds)
  -P proxy:port  use proxy for connection to the F*EX server
  -s filename    save to filename (-s- means: write to STDOUT/pipe)
  -o             overwrite existing file
  -k             keep on server after download
  -X             do not extract archive files or autoview file
  -d             delete without download
  -f             forward a file to another recipient
  -l             list files on server (prefixed with number)
  -L             list download URLs
  -t             list content of an archive file (.tar .tgz .zip .7z)
  -w             watch for one new file and then get it
  -W             watch for new files and then get them
  -H             show hints
arguments:
  URL            F*EX URL
  NUMBER         number from last "$prg -l"
  SENDER         sender address pattern (must contain @)
  FILE           filename pattern
  COMMENT        comment pattern
examples:
  $prg -l            # list files on server
  $prg -t 3          # list content of archive file number 3
  $prg 3             # get file number 3
  $prg 'framstag\@'   # get all files from framstag
  $prg -d @ '*.tmp'  # delete *.tmp files from all senders
EOD

my $hints = <<'EOD';
SENDER, FILE and COMMENT are sh-like pattern with ? and * special characters.
For SENDER * is automatically added to @
Example: the sender framstag@rus.uni-stuttgart.de is matched by:

framstag@rus.uni-stuttgart.de
*tag@rus*
framstag@
@rus.uni-stuttgart.de
@

Instead of sh-like pattern you can also use Perl regular expression when you
embed it in //, example: '/framstag@[\w.]+uni-stuttgart.de/'

In $HOME/.fex/config.pl you can set your prefered autoview applications:

%autoview = (
  '\.(gif|jpg|png|tiff?)' => 'view',
  '\.(avi|mp4|mov)'       => 'vlc -f',
  '\.pdf'                 => 'evince',
);

For HTTPS you can set the environment variables:
SSLVERIFY=1                 # activate server identity verification
SSLVERSION=TLSv1_2          # this is the default
SSLCAPATH=/etc/ssl/certs    # path to trusted (root) certificates
SSLCAFILE=/etc/ssl/cert.pem # file with trusted (root) certificates
SSLCIPHERLIST=HIGH:!3DES    # see http://www.openssl.org/docs/apps/ciphers.html

You can set these environment variables also in $HOME/.fex/config.pl, as well as
the $opt_* variables, e.g.:

$ENV{SSLVERSION} = 'TLSv1_2';
${'opt_+'} = 1;
$opt_m = 200;
EOD

if ($windoof and not @ARGV and not $ENV{PROMPT}) {
  # restart with cmd.exe to have mouse cut+paste
  my $cmd = "cmd /k \"$prg\"";
  # print "$cmd\n";
  exec $cmd;
  exit;
}

die $usage unless @ARGV;

$opt_m = $opt_h = $opt_v = $opt_l = $opt_d = $opt_K = $opt_o = $opt_a = 0;
$opt_V = $opt_X = $opt_f = $opt_L = $opt_H = $opt_t = $opt_q = 0;
$opt_w = $opt_W = 0;
${'opt_+'} = 0;
$opt_s = $opt_k = $opt_i = $opt_P = $opt_p = '';
$_ = "$fexhome/config.pl"; require if -f;
getopts('hvVHlLdtqkzoaXVwWf+m:s:i:K:P:p:') or die $usage;
$opt_k = '?KEEP' if $opt_k;

if ($opt_m =~ /(\d+)/) {
  $opt_m = $1
} else {
  $opt_m = 0
}

if ($opt_p =~ /^(\d+)$/) {
  $chunksize = $1;
  $sleepwait = 1;
} elsif ($opt_p =~ /^(\d+):?(\d*)$/) {
  $chunksize = $1;
  $sleepwait = $2;
}
$chunksize *= 1024*1024;

if ($opt_V) {
  print "Version: $version\n";
  exit;
}

if ($opt_h) {
  print $usage;
  exit;
}

if ($opt_H) {
  print $hints;
  exit;
}

# &get_ssl_env;

my $ffl = "$tmpdir/fexget"; 		# F*EX files list (cache)

my @rcamel = (
'[A
 (_*p _  _
   \\\\/ \/ \\
    \  __  )=*
    //\\\\//\\\\
',
"[A     \\\\/\\\\/ \n",
"[A    //\\\\//\\\\\n"
);

if ($opt_P) {
  if ($opt_P =~ /^([\w.-]+:\d+)(:(\d+))?/) {
    $proxy = $1;
    $chunksize = $3 || 0;
  } else {
    die "$prg: proxy must be: SERVER:PORT\n";
  }
}

# get fexlog
if ($opt_z) {
  my $cmd = "$fexsend -Z";
  $cmd .= " -i $opt_i" if $opt_i;
  warn "\$ $cmd\n" if $opt_v;
  exec $cmd;
  die "$prg: cannot run $cmd : $!\n";
}

if ($opt_l) {
  list(@ARGV);
  exit;
}

if ($opt_L) {
  my $cmd = "$fexsend -L";
  $cmd .= " -i $opt_i" if $opt_i;
  warn "\$ $cmd\n" if $opt_v;
  exec $cmd;
  die "$prg: cannot run $cmd : $!\n";
}

if (not($opt_a or $opt_s or $opt_t or $opt_d or $opt_o or $opt_f or
        $opt_w or $opt_W or @ARGV)) {
  &list;
  exit;
}

if ($opt_a) {
  $opt_X = $opt_a;
  die $usage if @ARGV;
  &list;
  print "\n";
  if (open $ffl,$ffl) {
    while (<$ffl>) {
      push @ARGV,$1 if /^\s+(\d+)/;
    }
    close $ffl;
  }
} else {
  unless (@ARGV) {
    if ($windoof) {
      my $url;
      for (;;) {
        print "download-URL: ";
        chomp($url = <STDIN>);
        if ($url =~ /^http/) {
          @ARGV = ($url);
          last;
        }
      }
    } else {
      die $usage;
    }
  }
}

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

if ($opt_w||$opt_W and $ARGV[0] !~ /@/) {
  die "$prg: no @ in sender, see: fexget -h\n";
}

if ($opt_f) {
  unless ($ENV{FEXID} or -f $ENV{HOME}.'/.fex/id') {
    die "$prg: no local FEXID\n";
  }
  $opt_f = pop(@ARGV);
  if ($opt_f =~ /^\d+$|^https?:/) {
    die "$prg: $opt_f is not an e-mail address\n";
  }
} elsif ($ARGV[0] =~ /@/ and $ARGV[0] !~ m:/fop/:) {
  my $from    = shift @ARGV;
  my $file    = shift @ARGV || '*';
  my $comment = shift @ARGV || '*';

  if (@ARGV) {
    die "usage: $prg [options] [-w] [-W] SENDER ['FILE'] ['COMMENT']\n";
  }

  $from =~ s/^\@/*@/;
  $from =~ s/\@$/@*/;
  my $from_re = pre($from);
  my $file_re = pre($file);
  my $comment_re = pre($comment);

  if ($opt_w or $opt_W) {
    $opt_o = 1;
    watch($from_re,$file_re,$comment_re);
    exit $status;
  }

  @ARGV = ();
  my $url;
  my $user = '';
  my $cmd = "$fexsend -/L";
  $cmd .= " -i $opt_i" if $opt_i;
  if ($opt_v) {
    # $cmd .= " -v";
    warn "\$ $cmd\n";
  }
  open $cmd,"$cmd|" or die "$prg: cannot run $cmd : $!\n";
  while (<$cmd>) {
    if (m{^Server/User: http.*/(.+)}i) {
      $user = $1;
      next;
    }
    if (/^from ($from_re) :/) {
      my $from = $1;
      while (<$cmd>) {
        if (/\w/) {
          next if $from =~ /^\Q$user/ and /\/xxx_\d{8}_\d{6}\./;
          s/\n/ ""\n/ unless /\"/;
          if (m:( *\d+ MB).*(http\S+/fop/\w+/($file_re)) ".*":) {
            my $mb = $1;
            my $url = $2;
            my $file = $3;
            if (/("$comment_re")$/) {
              $url{$url} = "$from:$file";
              push @{$files{$from}},"$mb $file $1";
              push @ARGV,$url;
            }
          }
        } else {
          last;
        }
      }
    }
  }
  close $cmd;
  if (%files) {
    print "\n";
    foreach my $from (keys %files) {
      print "from $from :\n";
      foreach my $file (@{$files{$from}}) {
        print "$file\n";
      }
      print "\n";
    }
    print 'continue? ';
    for (;;) {
      my $k = &ReadKey;
      if ($k =~ /y|\n/i) {
        print "yes\n";
        last;
      }
      if ($k =~ /n/i) {
        print "no\n";
        exit;
      }
    }
    print "\n";
  } else {
    die "$prg: no matching files found for '$from' '$file' '$comment'\n";
  }
}

my $nexturl = 0;

foreach my $url (@ARGV) {

  # do not overrun server
  if ($nexturl) {
    sleep 1;
    warn "\n";
  }
  $nexturl++;

  if ($url !~ /^http/) {
    &readfileslist unless %files;
    if ($url =~ /^(\d+)$/) {
      unless ($url = ${files{all}}[$1-1]) {
        warn "$prg: unknown file number $1\n";
        next;
      }
    } else {
      warn "$prg: $url is neither a F*EX URL nor a number\n";
      next;
    }
  }

  getfile($url);
}

exit $status;


sub getfile {
  my $url = shift;

  warn "$url{$url}\n" if $url{$url};

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

  if ($proxy) {
    if    ($port == 80)   { $proxy_prefix = "http://$server" }
    elsif ($port == 443)  { $proxy_prefix = "" }
    else                  { $proxy_prefix = "http://$server:$port" }
  }

  serverconnect($server,$port);

  if ($opt_f) {
    forward($url);
    return;
  }

  if ($opt_t) {
    if ($url =~ m{^http.*/fop/.*\.(tar|tgz|tar\.gz|zip|7z)$}) {
      listarchive($url);
      exit;
    } else {
      die "$prg: $url is not a F*EX archive URL\n";
    }
  }

  if ($opt_d) {
    if ($myfile{$url}) {
      vsystem(qw'fexsend -qd',$url);
    } else {
      del($url);
    }
    return;
  }

  if ($opt_K) {
    my @r = keep($url);
    $_ = shift @r;
    if (/^HTTP.* 200/) {
      $file = $url;
      $file =~ s:.*/::;
      print "$file kept\n";
    } else {
      s:HTTP/[\d\. ]+::;
      die "$prg: server response: $_";
    }
    return;
  }

  $download = download($server,$port,$fop);
  return unless defined $download;
  exit if $opt_s eq '-';
  unlink $download unless -s $download;
  return unless -f $download;

  if ($windoof) {
    print "READY\n";
    exit;
  }

  if (not $opt_X and $download =~ /\.gpg$/) {
    if (-t) {
      print "decrypt \"$download\"? ";
      $_ = <STDIN>||'y';
      unless (/^[y\n]/i) {
        print "keeping \"$download\"\n";
        return 0;
      }
    }
    if (system('gpg',$download) == 0) {
      unlink $download;
      $download =~ s/\.gpg$//;
    }
  }

  unless ($opt_X) {

    foreach my $a (keys %autoview) {
      if ($download =~ /$a$/i and $autoview{$a}) {
        printf "run \"%s %s\" [Yn] ? ",$autoview{$a},basename($download);
        $_ = <STDIN>||'';
        if (/^y|^$/i) {
          system sprintf("%s %s",$autoview{$a},shellquote($download))
        }
        return;
      }
    }

    if (0 and $ENV{DISPLAY} and $download =~ /\.(gif|jpg|png|tiff?)$/i) {
      # see also mimeopen and xdg-mime
      # http://unix.stackexchange.com/questions/144047/how-does-xdg-open-do-its-work
      if (my $xv = $xv || pathsearch('xv') || pathsearch('xdg-open')) {
        printf "run \"%s %s\" [Yn] ? ",basename($xv),basename($download);
        $_ = <STDIN>||'';
        system $xv,$download if /^y|^$/i;
        return;
      }
    }

    if ($download =~ /$atype/) {
      if ($download =~ /\.(tgz|tar.gz)$/) {
        if ($opt_o) {
          extract('tar tvzf','tar xvzf')
        } else {
          extract('tar tvzf','tar xvzkf')
        }
      } elsif ($download =~ /\.tar$/) {
        if ($opt_o) {
          extract('tar tvf','tar xvf')
        } else {
          extract('tar tvf','tar xvkf')
        }
      } elsif ($download =~ /\.zip$/i) {
        if ($opt_o) {
          extract('unzip -l','unzip -o')
        } else {
          extract('unzip -l','unzip')
        }
      } elsif ($download =~ /\.7z$/i) {
        if ($opt_o) {
          extract('7z l','7z x -y')
        } else {
          extract('7z l','7z x')
        }
      } else {
        die "$prg: unknown archive \"$download\"\n"
      }
      if ($? == 0) {
        unlink $download;
      } else {
        die "$prg: keeping \"$download\"\n";
      }
    } elsif ($download =~ /\/fp_\d+\.gz$/) {
      system("gunzip < $download");
      if ($? == 0) {
        unlink $download;
      } else {
        die "$prg: keeping \"$download\"\n";
      }
    }
  }

  return 0;
}


sub extract {
  my $l = shift;
  my $x = shift;
  my $d = $download;
  my $xd = abs_path('.');
  local $_;

  if (-t and not $windoof and not $opt_W and $useragent !~ /xxx/) {
    print "Files in archive:\n";
    system(split(' ',$l),$download);
    $d =~ s:.*/:./:;
    $d =~ s/\.[^.]+$//;
    $d =~ s:/*$:/:;
    $d =~ s:/xxx_\d+/:/:;
    for (;;) {
      $xd = inquire("extract to directory (\"-\" to keep archive): ",$d);
      last if $xd =~ s:^(\./*)*!?$::;
      if ($xd eq '-') {
        print "keeping $download\n";
        exit;
      }
      if ($xd !~ s/!$//) {
        if (-d $xd) {
          print "directory $xd does already exist, add \"!\" to overwrite\n";
          redo;
        }
        unless (mkdir $xd) {
          print "cannot mkdir $xd - $!\n";
          redo;
        }
      }
      unless (chdir $xd) {
        print "cannot chdir $xd - $!\n";
        redo;
      }
      last;
    }
  }
  print "extracting to $xd :\n" if $xd;
  vsystem(split(' ',$x),$download);
  # print "(extracted to $xd)\n" if $xd;
}

sub del {
  my $url = shift;
  my ($server,$port);
  my ($del,$file);
  my @r;
  local $_;

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

  sendheader("$server:$port","GET $del HTTP/1.1");
  while (<$SH>) {
    s/\r//;
    last if /^\n/; # ignore HTML output
    warn "<-- $_" if $opt_v;
    push @r,$_;
  }
  die "$prg: no response from fex server $server:$port\n" unless @r;

  $_ = shift @r;
  if (/^HTTP.* 200/) {
    ($file) = grep { $_ = $1 if /^X-File:\s+(.+)/ } @r;
    $file = $url unless $file;
    if ($file =~ m:SHARE/(.+)/archives/(.+)/(.+):) {
      printf "%s:%s_%s deleted\n",$1,$2,$3;
    } else {
      $file =~ s:.*/::;
      printf "%s deleted\n",locale(decode_utf8(urldecode($file)));
    }
  } elsif (/^HTTP.*need auth-ID/ and $url =~ m:.*/(.+):) {
    # warn "$prg: server needs auth-ID for deleting\n";
    my $file = $1;
    my @fexsend = ('fexsend');
    # push @fexsend,'-v' if $opt_v;
    push @fexsend,('-i',$opt_i) if $opt_i;
    my $cmd = "@fexsend -d $file .";
    warn "\$ $cmd\n" if $opt_v;
    system $cmd;
  } else {
    s:HTTP/[\d\. ]+::;
    die "$prg: server response: $_";
  }
}


sub forward {
  my $url = shift;
  my ($server,$port);
  my ($uri,$dkey,$list,$cmd,$n,$copy);
  my @r;

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

  sendheader(
    "$server:$port",
    "GET $uri?COPY HTTP/1.1",
  );

  $_ = <$SH>;
  die "$prg: no reply from fex server $server:$port\n" unless $_;
  warn "<-- $_" if $opt_v;

  if (/^HTTP.*already exists/) {
    if ($uri =~ m:/fop/(\w+)/:) {
      $dkey = $1;
    }
  } elsif (/^HTTP.*200/) {
    # ok!
  } else {
    s/^HTTP.... \d+ //;
    die "$prg: $_";
  }

  while (<$SH>) {
    s/\r//;
    last if /^\n/; # ignore HTML output
    $dkey = $1 if /^Location:.*\/(\w+)\/.+/;
    warn "<-- $_" if $opt_v;
  }

  warn "\$ fexsend -l\n" if $opt_v;
  system 'fexsend -l >/dev/null 2>&1';
  $list = $ENV{HOME}.'/.fex/tmp/fexlist';
  open $list,$list or die "$prg: cannot open $list - $!\n";
  while (<$list>) {
    if (/^\s+(\d+)\) (\w+)/ and $2 eq $dkey) {
      $n = $1;
      $cmd = "fexsend -b $n $opt_f";
      warn "\$ $cmd\n" if $opt_v;
      system $cmd;
      last;
    }
  }
  close $list;

  if ($n) {
    $cmd = "fexsend -d $n >/dev/null 2>&1";
    warn "\$ $cmd\n" if $opt_v;
    system $cmd;
  } else {
    warn "$prg: forwarding failed\n";
  }
}


sub keep {
  my $url = shift;
  my ($server,$port);
  my $keep;
  my (@hh,@r);

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

  push @hh,"GET $keep HTTP/1.1",
           "Host: $server:$port",
           "User-Agent: $useragent",
           "";

  foreach (@hh) {
    warn $_,"\n" if $opt_v;
    print $SH $_,"\r\n";
  }
  while (<$SH>) {
    s/\r//;
    last if /^\n/;
    push @r,$_;
  }
  die "$prg: no response from fex server $server\n" unless @r;
  grep { warn "\t$_" } @r if $opt_v;
  return @r;
}


sub download {
  my ($server,$port,$fop,$nocheck) = @_;
  my ($file,$download,$ssl,$pipe,$filesize,$checkstorage,$dkey);
  my (@hh,@r);
  my ($t0,$t1,$t2,$tt,$tm,$ts,$kBs,$b,$bt,$tb,$B,$buf);
  my $length = 0;
  my $seek = 0;
  my $tc = 0;
  local $_;
  local *X;

  if ($opt_s) {
    $file = $opt_s;
    if ($opt_s eq '-') {
      $pipe = $download = $opt_s;
    } elsif (-p $opt_s or -c $opt_s) {
      $download = $opt_s;
      $nocheck = 'pipe or character device';
    } else {
      $download = $file.'.tmp';
      $seek = -s $download || 0;
    }
  } else {
    # ask server for real file name
    sendheader(
      "$server:$port",
      "HEAD $proxy_prefix$fop HTTP/1.1",
    );
    my $reply = $_ = <$SH>;
    unless (defined $_ and /\w/) {
      die "$prg: no response from server\n";
    }
    warn "<-- $_" if $opt_v;
    unless (/^HTTP\/[\d.]+ 200/) {
      s:HTTP/[\d. ]+::;
      die "$prg: server response: $_";
    }
    while (<$SH>) {
      s/\r//;
      $_ = urldecode($_) if /%[A-Z0-9]{2}/;
      warn "<-- $_" if $opt_v;
      last if /^\r?\n/;
      if (/^Content-Disposition: attachment; filename="(.+)"/i) {
        $file = $1;
        # $file = locale(decode_utf8($file));
        $file =~ s:.*/::;
      }
    }
    unless ($file) {
      $file = $fop;
      $file =~ s:.*/::;
    }
    $download = $file.'.tmp';
    $seek = -s $download || 0;
  }

  $fop =~ m:/fop/(\w+)/: and $dkey=$1 or $dkey='';

  push @hh,"GET $proxy_prefix$fop$opt_k HTTP/1.1";
  push @hh,"Cookie: dkey=$dkey" if $dkey;
  push @hh,"Connection: close";
  push @hh,"Range: bytes=$seek-" if $seek;

  # HTTPS needs a new connection for actually downloading the file
  serverconnect($server,$port) if $opt_P and $port == 443;
  sendheader("$server:$port",@hh);
  $_ = <$SH>;
  die "$prg: no response from fex server $server\n" unless $_;
  s/\r//;

  if (/^HTTP\/[\d.]+ 2/) {
    warn "<-- $_" if $opt_v;
    while (<$SH>) {
      s/\r//;
      warn "<-- $_" if $opt_v;
      last if /^\r?\n/;
      if (/^Content-length:\s*(\d+)/i) {
        $length = $1;
      } elsif (/^X-Size: (\d+)/i) {
        $filesize = $1;
      }
    }
  } else {
    s/HTTP\/[\d.]+ \d+ //;
    die "$prg: bad server reply: $_";
  }

  if ($pipe) {
    *X = *STDOUT;
  } else {
    if ($opt_s and $opt_s eq $download) {
      open X,'>',$download or die "$prg: cannot write to \"$download\" - $!\n";
      $checkstorage = $filesize unless $nocheck;
    } else {
      my $df = qq'destination file "$file"';
      if (my @s = lstat $file) {
        unless ($opt_o) {
          warn "$prg: $df does already exist\n";
          $status = 1;
          return;
        }
        if (-l $file) {
          warn "$prg: $df is a symbolic link\n";
          $status = 1;
          return;
        }
        if (-d $file) {
          warn "$prg: $df is a directory\n";
          $status = 1;
          return;
        }
        unless (-f $file) {
          warn "$prg: $df is not a regular file\n";
          $status = 1;
          return;
        }
        if ($s[3] > 1) {
          warn "$prg: $df has hard links\n";
          $status = 1;
          return;
        }
      }
      if ($seek) {
        open X,'>>',$download or die "$prg: cannot write to \"$download\" - $!\n";
      } else {
        open X,'>',$download or die "$prg: cannot write to \"$download\" - $!\n";
        $checkstorage = $filesize unless $nocheck;
      }
    }
    if ($checkstorage and not $nocheck) {
      my $t0 = my $t1 = my $t2 = time;
      my $n = 0;
      my $buf = '.' x M;
      my $storagetest = $file.'.test';
      my $error = "$prg: cannot write \"$storagetest\"";
      open $storagetest,'>',$storagetest or die "$error - $!\n";
      print STDERR "checking storage...\r";
      while (-s $storagetest < $checkstorage) {
        syswrite $storagetest,$buf or do {
          unlink $storagetest;
          die "\n$error - $!\n";
        };
        $n++;
        $t2 = int(time);
        if ($t2 > $t1) {
          print STDERR "checking storage... ".$n." MB\r";
          $t1 = $t2;
        }
      }
      close $storagetest or do {
        unlink $storagetest;
        die "\n$error - $!\n";
      };
      print STDERR "checking storage... ".$n." MB ok!\n";
      unlink $storagetest;
      if (time-$t0 > 25) {
        # retry after timeout
        serverconnect($server,$port);
        return(download($server,$port,$fop,'nocheck'))
      }
    }
  }

  $t0 = $t1 = $t2 = int(time);
  $tb = $B = 0;
  printf STDERR "$prg: resuming at byte %s\n",$seek if $seek and not $chunksize;
  print $rcamel[0] if ${'opt_+'};
  while ($B < $length and $b = read $SH,$buf,$bs) {
    syswrite X,$buf;
    $B += $b;
    $tb += $b;
    $bt += $b;
    $t2 = time;
    if (${'opt_+'} and int($t2*10)>$tc) {
      print $rcamel[$tc%2+1];
      $tc = int($t2*10);
    }
    if (not $opt_q and int($t2) > $t1) {
      $kBs = int($bt/k/($t2-$t1));
      $kBs = int($tb/k/($t2-$t0)) if $kBs < 10;
      $t1 = $t2;
      $bt = 0;
      # smaller block size is better on slow links
      $bs = 4096 if $bs>4096 and $tb/($t2-$t0)<65536;
      if ($tb<10*M) {
        printf STDERR "%s: %d kB (%d%%) %d kB/s \r",
                      $download,
                      int(($tb+$seek)/k),
                      int(($tb+$seek)/($length+$seek)*100),
                      $kBs;
      } else {
        printf STDERR "%s: %d MB (%d%%) %d kB/s        \r",
                      $download,
                      int(($tb+$seek)/M),
                      int(($tb+$seek)/($length+$seek)*100),
                      $kBs;
      }
    }
    if ($opt_m) {
      if ($t2 == $t0 and $B > $opt_m*k) {
        warn "\nsleeping...\r" if $opt_v;
        sleep 1;
      } else {
        while ($t2 > $t0 and $tb/k/($t2-$t0) > $opt_m) {
          warn "\nsleeping...\r" if $opt_v;
          sleep 1;
          $t2 = time;
        }
      }
    }
    last if $chunksize and $B >= $chunksize;
  }
  close $SH;
  close X;

  print $rcamel[2] if ${'opt_+'};

  $tt = $t2-$t0;
  $tm = int($tt/60);
  $ts = $tt-$tm*60;
  $kBs = int($tb/k/($tt||1));
  unless ($opt_q) {
    if ($seek) {
      printf STDERR "%s: %d MB, last %d MB in %d s (%d kB/s)      \n",
                    $file,int(($tb+$seek)/M),int($tb/M),$tt,$kBs;
    } else {
      printf STDERR "%s: %d MB in %d s (%d kB/s)      \n",
                    $file,int($tb/M),$tt,$kBs;
    }
  }

  if ($tb < $length) {
    if ($windoof) {
      sleep(3);
      exec "\"$prg\" @ARGV";
      exit;
    } else {
      if ($chunksize) {
        if ($sleepwait) {
          my $wait = $sleepwait;
          while ($wait) {
            print STDERR "next connect in $wait s  \r";
            sleep 1;
            $wait--;
          }
        }
      } else {
        warn "$prg: $server annouced $length bytes, but only $tb bytes has been read\n";
        warn "$prg: retrying after 30 s\n";
        sleep(30);
      }
      serverconnect($server,$port);
      return(download($server,$port,$fop,'nocheck'))
    }
  }

  unless ($pipe or -p $download or -c $download) {
    my @s = stat $file if -e $file;
    rename $download,$file
      or die "$prg: cannot rename \"$download\" to \"$file\" - $!\n";
    chmod $s[2],$file if @s;
  }

  $_ = sprintf("%s/%s",getcwd(),$file);
  s:/+:/:g;
  return $_;
}


sub list {
  my $sender = shift;
  my $user = ' ';
  my $cmd = "$fexsend -/L";
  my $n;

  $cmd .= " -i $opt_i" if $opt_i;
  if ($opt_v) {
    # $cmd .= " -v";
    warn "\$ $cmd\n";
  }

  open $cmd,"$cmd|" or die "$prg: cannot run $cmd : $!\n";
  open $ffl,'>',$ffl or die "$prg: cannot open $ffl : $!\n";

  $sender //= '@';

  while (<$cmd>) {
    if (m{^Server/User: http.*/(.+)}i) {
      $user = $1;
      warn $_ if $opt_i;
      print {$ffl} $_;
      if ($sender eq '.') {
        $sender = "\\Q$user\\E";
      } else {
        $sender .= '@' if $sender !~ /@/;
        $sender =~ s/^\@/.*@/;
        $sender =~ s/\@$/@.*/;
      }
      next;
    }
    if (/^from /) {
      if (not $opt_l and /^from \Q$user :/) {
        while (<$cmd>) { last if /^$/ } next;
      }
#?      if (length $sender and not /^from \Q$sender :/) {
#?        while (<$cmd>) { last if /^$/ } next;
#?      }
    }
    if (/\d MB .*http/) {
      s/\n/ ""\n/ unless /\"/;
      next if /\/xxx_\d{8}_\d{6}\.(gz|tgz|tar) /;
      $n++;
      $_ = sprintf "%5s %s","#$n",$_;
      print {$ffl} $_;
      s: http[^\"]*/: :;
      print;
    } else {
      print {$ffl} $_;
      print;
    }
  }
  close $ffl;
}


sub watch {
  my $from_re = shift;
  my $file_re = shift;
  my $comment_re = shift;
  my $sp = "^($from_re) \\d+ (http\\S+/($file_re)) \"$comment_re\"";
  my $cmd = "$fexsend -~ FUPWATCH";

  $cmd .= " -i $opt_i" if $opt_i;
  if ($opt_v) {
    # $cmd .= " -v";
    warn "\$ $cmd | fpg '$sp'|\n";
  }

  $cpid = open $cmd,"$cmd|" or die "$prg: cannot run $cmd : $!\n";
  sleep 1;
  warn "\n" if $opt_v;
  while (<$cmd>) {
    warn $_ if $opt_v;
    if (/$sp/) {
      my $durl = $2;
      if ($opt_v) {
        $opt_v = 0;
        getfile($durl);
        $opt_v = 1;
        warn "\n";
      } else {
        $url{$durl} = "$1:$3";
        warn "\n";
        getfile($durl);
      }
      exit $status if $opt_w;
    }
  }
}


sub del_re {
  my $from_re = shift;
  my $file_re = shift;
  my $comment_re = shift;
  my $sp = "^($from_re) \\d+ (http\\S+/($file_re)) \"$comment_re\"";

}


sub listarchive {
  my $url = shift;
  my $list = '';
  my $server = '';
  my $cmd = "wget -qSO- $url?!";
  my $uri;
  local $_;

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

  sendheader(
    "$server:$port",
    "GET $uri?LISTARCHIVE HTTP/1.1",
  );

  $_ = <$SH>;
  die "$prg: no reply from fex server $server:$port\n" unless $_;
  warn "<-- $_" if $opt_v;

  if (/^HTTP.* Bad Request/) {
    die "$prg: fexserver $server:$port does not support LISTARCHIVE\n";
  } elsif (/^HTTP.*200/) {
    # ok!
  } else {
    s/^HTTP.... \d+ //;
    die "$prg: $_";
  }

  while (<$SH>) {
    s/\r//;
    warn "<-- $_" if $opt_v;
    if (/^X-Message: Bad Request/) {
      die "$prg: fexserver $server:$port does not support LISTARCHIVE\n";
    }
    last if /^<pre>/;
    printf "%-10s %s\n",$1,$2 if /<!-- (\S+:) (.*) -->/;
  }
  print "\n";
  while (<$SH>) {
    last if /^</;
    s/&amp;/&/g;
    s/&lt;/</g;
    $list .= $_;
  }
  print $list if $list;
}


sub readfileslist {
  my $from = '';
  my $user = '';

  %files = ();
  %myfile = ();

  open $ffl,$ffl or die "$prg: no $ffl, use first: $prg -l\n";
  while (<$ffl>) {
    if (m{^server/user: .*/(.+)}i) {
      $user = $1;
    } elsif (/^from (.+) :$/) {
      $from = $1;
    } elsif (/#(\d+)\s+\d+ MB.* (http\S+\/(\S+)) "(.*)"/) {
      push @{$files{all}},$2;
      push @{$files{$from}},$2;
      $url{$2} = "$from:$3";
      $myfile{$2} = $2 if $from eq $user;
    }
  }
  close $ffl;
}


sub pathsearch {
  my $prg = shift;

  foreach my $dir (split(':',$ENV{PATH})) {
    return "$dir/$prg" if -x "$dir/$prg";
  }
}


{
  my $tty;

  sub inquire {
    my $prompt = shift;
    my $default = shift;
    local $| = 1;
    local $_;

    if (defined $default) {
      unless ($tty) {
        chomp($tty = `tty 2>/dev/null`);
        eval { local $^W; require "sys/ioctl.ph"; };
      }

      if (defined(&TIOCSTI) and $tty and open($tty,'>',$tty)) {
        print $prompt;
        # push default answer into keyboard buffer
        foreach my $a (split("",$default)) { ioctl($tty,&TIOCSTI,$a) }
        chomp($_ = <STDIN>||'');
      } else {
        $prompt =~ s/([\?:=]\s*)/ [$default]$1/ or $prompt .= " [$default] ";
        print $prompt;
        chomp($_ = <STDIN>||'');
        $_ = $default unless length;
      }
    } else {
      print $prompt;
      chomp($_ = <STDIN>||'');
    }

    return $_;
  }
}


# sh pattern to Perl regular expression
sub pre {
  local $_ = shift;
  if (m:^/(.+)/$:) {
    return $1;
  } else {
    s/\./\\./g;
    s/(?<!\\)\?/./g;
    s/(?<!\\)\*/.*/g;
    s/([()+{}\|])/\\$1/g;
    s/^\^/\\^/;
    s/\$$/\\\$/;
    return $_;
  }
}

### common functions ###

sub mtime {
  my @d = localtime((stat shift)[9]);
  return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]);
}


sub urldecode {
  local $_ = shift;
  s/\%([a-f\d]{2})/chr(hex($1))/ige;
  return $_;
}


sub serverconnect {
  my ($server,$port) = @_;
  my $connect = "CONNECT $server:$port HTTP/1.1";
  local $_;

  if ($proxy) {
    tcpconnect(split(':',$proxy));
    if ($port == 443) {
      nvtsend($connect,"");
      $_ = <$SH>;
      s/\r//;
      warn "<-- $_"if $opt_v;
      unless (/^HTTP.1.. 200/) {
        die "$prg: proxy error : $_";
      }
      &enable_ssl;
      $SH = IO::Socket::SSL->start_SSL($SH,%SSL);
    }
  } else {
    tcpconnect($server,$port);
  }
}


# set up tcp/ip connection
sub tcpconnect {
  my ($server,$port) = @_;

  if ($SH) {
    close $SH;
    undef $SH;
  }

  if ($port == 443) {
    # eval "use IO::Socket::SSL qw(debug3)";
    &enable_ssl;
    $SH = IO::Socket::SSL->new(
      PeerAddr => $server,
      PeerPort => $port,
      Proto    => 'tcp',
      %SSL
    );
  } else {
    $SH = IO::Socket::INET->new(
      PeerAddr => $server,
      PeerPort => $port,
      Proto    => 'tcp',
    );
  }

  if ($SH) {
    autoflush $SH 1;
    binmode $SH;
  } else {
    die "$prg: cannot connect $server:$port - $@\n";
  }

  warn "TCPCONNECT to $server:$port\n" if $opt_v;
}


sub sendheader {
  my $sp = shift;
  my @head = @_;
  my $head;

  push @head,"Host: $sp";
  push @head,"User-Agent: $useragent";

  foreach $head (@head) {
    chomp $head;
    warn "--> $head\n" if $opt_v;
    print {$SH} $head,"\r\n";
  }
  warn "-->\n" if $opt_v;
  print {$SH} "\r\n";
}


sub nvtsend {
  local $SIG{PIPE} = sub { $sigpipe = "@_" };

  $sigpipe = '';

  die "$prg: internal error: no active network handle\n" unless $SH;
  die "$prg: remote host has closed the link\n" unless $SH->connected;

  foreach my $line (@_) {
    warn "--> $line\n" if $opt_v;
    print {$SH} $line,"\r\n";
    if ($sigpipe) {
      undef $SH;
      return 0;
    }
  }

  return 1;
}


sub shellquote {
  local $_ = shift;
  s/([^\w\@\/!^%:_.,=+-])/\\$1/g;
  return $_;
}


sub debug {
  print "## DEBUG: @_\n" if $DEBUG;
}


sub locale {
  my $string = shift;

  # my @x = Encode->encodings(':all');  die "$CTYPE - @x";
  if ($CTYPE) {
    if ($CTYPE =~ /UTF-?8/i) {
      return $string;
    } elsif (grep { $CTYPE =~ /^$_$/i } Encode->encodings(':all')) {
      return encode($CTYPE,decode('UTF8',$string));
    } else {
      return encode('ISO-8859-1',decode('UTF8',$string));
    }
  }

  return $string;
}


sub enable_ssl {
  eval "use IO::Socket::SSL";
  die "$prg: cannot load IO::Socket::SSL\n" if $@;
  # needed for CentOS (Redhat, too?)
  foreach (qw'/etc/ssl/cert.pem /etc/ssl/certs/ca-bundle.crt') {
    $SSL{SSL_ca_file} = $_ if -f;
  }
  &get_ssl_env;
  eval '$SSL{SSL_verify_mode} = 0 if Net::SSLeay::SSLeay() <= 9470143';
  if ($opt_v) {
    foreach my $v (keys %SSL) {
      printf STDERR "%s => %s\n",$v,$SSL{$v};
    }
  }
}


sub get_ssl_env {
  # set SSL/TLS options
  if (defined($ENV{SSLVERIFY})) {
    $SSL{SSL_verify_mode} = $ENV{SSLVERIFY};
  }
  foreach my $opt (qw(
    SSL_version
    SSL_cipher_list
    SSL_verify_mode
    SSL_ca_path
    SSL_ca_file)
  ) {
    my $env = uc($opt);
    $env =~ s/_//g;
    $SSL{$opt} = $ENV{$env} if defined($ENV{$env});
  }

  if ($SSL{SSL_verify_mode} and $SSL{SSL_verify_mode} ne 'SSL_VERIFY_NONE') {
    &search_ca;
    unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) {
      die "$prg: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n";
    }
  } elsif (defined($SSL{SSL_verify_mode})) {
    # user has set SSLVERIFY=0 !
  } else {
    &search_ca;
    $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file};
  }
}


sub search_ca {
  local $_;

  return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path};

  foreach (qw(/etc/ssl/certs/ca-certificates.crt)) {
    if (-f) {
      $SSL{SSL_ca_file} = $_;
      return;
    }
  }

  foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) {
    if (-d) {
      $SSL{SSL_ca_path} = $_;
      return;
    }
  }
}


# from MIME::Base64::Perl
sub encode_b64 {
  my $res = "";
  my $eol = "\n";
  my $padding;

  pos($_[0]) = 0;
  $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
  $res =~ tr|\` -_|AA-Za-z0-9+/|;
  $padding = (3-length($_[0])%3)%3;
  $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
  return $res;
}


# from MIME::Base64::Perl
sub decode_b64 {
  local $_ = shift;
  my $uu = '';
  my ($i,$l);

  tr|A-Za-z0-9+=/||cd;
  s/=+$//;
  tr|A-Za-z0-9+/| -_|;
  return "" unless length;

  $l = (length)-60;
  for ($i = 0; $i <= $l; $i += 60) {
    $uu .= "M" . substr($_,$i,60);
  }
  $_ = substr($_,$i);
  if (length) {
    $uu .= chr(32+(length)*3/4) . $_;
  }
  return unpack("u",$uu);
}


sub inputline {
  my $prompt = shift;
  my $default = shift||'';
  my $term = new Term::ReadLine $prg;

  $term->ornaments(0) unless $ENV{PERL_RL};
  return $term->readline($prompt,$default)||'';
}


sub vexec {
  vsystem(@_);
  exit $?;
}


sub vsystem {
  my @cmd = @_;
  my $cmd;
  my $shellmeta = '[\\\'"`*?&|<>(){};]';
  local $_;

  if ($opt_v) {
    if (-t STDIN) { print STDERR '$ ' }
    else          { print STDERR '| ' }
    if (scalar(@cmd) == 1) {
      warn "@cmd\n";
    } else {
      my @w;
      foreach (@cmd) {
        if (/\'/) {
          push @w,shellquote($_);
        } elsif (/[^\w\/:=~^%@,.+-]/) {
          push @w,"'$_'";
        } else {
          push @w,$_;
        }
      }
      warn "@w\n";
    }
  }

  $_ = "@cmd";
  if (scalar(@cmd) == 1 and /\s/ and not (/^\w+=/ or /$shellmeta/)) {
    @cmd = split;
  }

  if (scalar(@cmd) == 1) {
    $cmd = "@cmd";
    $cmd =~ s/\|&$/ 2>&1|/;
    if ($cmd =~ s/\|$//) {
      my @a = `$cmd`;
      if (wantarray) {
        map { chomp } @a;
        return @a;
      } else {
        chomp $a[0] if scalar(@a) == 1;
        return join('',@a);
      }
    } else {
      system $cmd;
    }
  } else {
    system @cmd;
  }
}


# read one key from terminal in raw mode
sub ReadKey {
  my $key;
  local $SIG{INT} = sub { stty('reset'); exit };

  stty('raw');
  # loop necessary for ESXi support
  while (not defined $key) { $key = getc(STDIN) }
  stty('reset');
  return $key;
}


sub stty {
  if (shift eq 'raw') {
    system qw'stty -echo -icanon eol',"\001";
  } else {
    system qw'stty echo icanon eol',"\000";
  }
}


END { kill 9,$cpid if $cpid }
