File: fexsend

package info (click to toggle)
fex 20200429-1
links: PTS, VCS
area: non-free
in suites: sid
size: 3,532 kB
sloc: perl: 32,103; sh: 410; javascript: 53; makefile: 42
file content (5859 lines) | stat: -rwxr-xr-x 149,697 bytes
parent folder | download | duplicates (2)
#!/usr/bin/perl -w

# CLI client for the F*EX service (send, list, delete)
#
# see also: fexget
#
# Author: Ulli Horlacher <framstag@belwue.de>
#
# Perl Artistic Licence

# BEGIN { $SIG{__WARN__} = sub { die @_ } }

use 5.010;
use strict qw(vars subs);
use Encode;
use Config;
use Socket;
use IO::Handle;
use IO::Socket::INET;
use Getopt::Std;
use File::Basename;
use Term::ReadLine;
use Sys::Hostname;
use Cwd qw(abs_path getcwd);
use Fcntl qw(:flock :mode);
use Digest::MD5 qw(md5_hex);
use Time::HiRes qw(time);
# use Smart::Comments;
use constant kB => 2**10;
use constant MB => 2**20;

our $CTYPE = 'ISO-8859-1';

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

eval 'use Net::INET6Glue::INET_is_INET6';
eval {
  local $^W = 0;
  require I18N::Langinfo;
  I18N::Langinfo->import(qw'langinfo CODESET');
  $CTYPE = langinfo(CODESET());
};

$| = 1;

our ($SH,$fexhome,$idf,$fextmp,$useragent,$editor,$nomail);
our ($windoof,$cygwin,$macos);
our ($transferfile,$share_);
our ($anonymous,$public);
our ($frecipient);
our ($FEXID,$FEXXX,$HOME);
our (%alias);
our $version = 20200429;
our $_0 = $0;
our $prg = $0;
our $FEXOPT = $ENV{FEXOPT}||'';
our $nmtime = 0;
our $command = '';
our ($fexsend,$fexget);

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

my $sigpipe;
my $chunksize = 0;
my $sleepwait = 1;
my $xn = '\d{8}_\d{6}';
my ($xlist,$xp);

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/:;

&update if "@ARGV" eq 'UPDATE';

if ($Config{osname} =~ /^mswin/i) {
  # http://slu.livejournal.com/17395.html
  $windoof = $Config{osname};
  $HOME = $ENV{USERPROFILE};
  $fexhome = $ENV{FEXHOME} || $HOME.'\fex';
  $fextmp = $ENV{FEXTMP} || "$fexhome\\tmp";
  $idf = "$fexhome\\id";
  $editor = $ENV{EDITOR} || 'notepad.exe';
  $useragent = sprintf("fexsend-$version (%s %s)",
                      $Config{osname},$Config{archname});
  $SSL{SSL_verify_mode} = 0;
} else {
  $prg =~ s:(.*/):: or die "$0: cannot find path\n";
  $fexsend = $1.'fexsend';
  $fexget  = $1.'fexget';
  $0 = "$prg @ARGV";
  if ($Config{osname} =~ /^darwin/i or $ENV{MACOS}) {
    # https://superuser.com/questions/61185/why-do-i-get-files-like-foo-in-my-tarball-on-os-x
    $ENV{COPYFILE_DISABLE} = 1;
    # http://stackoverflow.com/questions/989349/running-a-command-in-a-new-mac-os-x-terminal-window
    $macos = $Config{osname};
    $HOME = (getpwuid($<))[7]||$ENV{HOME};
    $fexhome = $HOME.'/.fex';
    $fextmp = $ENV{FEXTMP} || "$fexhome/tmp";
    $fextmp =~ s:/$::;
    $idf = "$fexhome/id";
    chmod 0600,$idf;
    $editor = $ENV{EDITOR} || 'open -W -n -e';
    $_ = `sw_vers -productVersion 2>/dev/null`||'';
    chomp;
    $useragent = "fexsend-$version (MacOS $_)";
  } else {
    $HOME = (getpwuid($<))[7]||$ENV{HOME};
    $fexhome = $HOME.'/.fex';
    $fextmp = $ENV{FEXTMP} || "$fexhome/tmp";
    $idf = "$fexhome/id";
    chmod 0600,$idf;
    $editor = $ENV{EDITOR} || 'vi';
    my ($os,$osp,$osn,$osv);
    if (open my $osr,'/etc/os-release') {
      while (<$osr>) {
        $osp = $1 if /^PRETTY_NAME="(.+)"/;
        $osn = $1 if /^NAME="(.+)"/;
        $osv = $1 if /^VERSION="(.+)"/;
      }
      close $osr;
    }
    if ($osp and $osp =~ /\d/) {
      $os = $osp;
    } elsif ($osn and $osv) {
      $os = "$osn $osv";
    } else {
      $os = `(lsb_release -d||uname -a)2>/dev/null`||'';
      chomp $os;
      $os =~ s/^Description:\s+//;
    }
    $useragent = "fexsend-$version ($os)";
  }
}
if ($Config{osname} eq 'cygwin' or $ENV{CYGWIN}) {
  # https://cygwin.com/faq/faq.html#faq.using.fixing-fork-failures
  $cygwin = 1;
  $SSL{SSL_verify_mode} = 0;
}

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

if (my $fua = $ENV{FUA}) {
  if ($useragent =~ /(\S+)/ and $fua !~ /\Q$1/) {
    $useragent = "$fua/$useragent";
  } else {
    $useragent = $fua;
  }
}
$ENV{FUA} = $useragent;
$ENV{FUA} =~ s/ .*//;

# force tar format (SUSE uses pax!)
$ENV{TAR_OPTIONS} .= ' --format=gnu';

my $from = '';
my $to = '';
my $id = '';
my $skey = '';
my $gkey = '';
my $okey = '';
my $pkey = '';
my $share = '';
my $atype = '';		# archive type
my $fexcgi;		# F*EX CGI URL
my @files;		# files to send
my @ifiles;		# files to send from index file
my %AB = ();		# server based address book
my ($server,$port,$sid,$https);
my $proxy = '';
my $proxy_prefix = '';
my $proxy_authorization = '';
my $features = '';
my $timeout = 30; 	# server timeout
my $fexlist = "$fextmp/fexlist";
my ($usage,$hints);
my $xx = $prg =~ /\bxx$/;
my $xxx = $prg =~ /\bxxx$/;

if ($xx) {
  $usage = "
usage:
  send file(s):                xx FILE...
  send all files including .*: xx ./DIRECTORY
  send STDIN:                  xx -
  send pipe:                   ... | xx
  get file(s) or STDIN:        xx
  get file(s) no-questions:    xx --

options:
  -v            verbose mode
  -m KBS        limit throughput (KBS kB/s)
  -p SIZE:WAIT  send file in chunks (SIZE MB, WAIT seconds)

examples:
  dmesg | xx
  xx project
  xx --
";
} elsif ($xxx) {
  $usage = "
$prg: internet clipboard with versioning
file upload:       $prg [-m LIMIT] [-k DAYS] [-w] [-q] [-p] [-z] [-Z] FILE...
pipe upload: ... | $prg [-m LIMIT] [-k DAYS] [-w] [-q] [-t] [COMMENT]
download:          $prg [-m LIMIT] [-o] [DATE_TIME|URL|-]
delete:            $prg -d [DATE_TIME|URL|REGEXP|-]
other:             $prg [-l] [-w] [-u] [-x] [-X] [-k DAYS DATE_TIME|URL]
options:
  -m  limit throughput (kB/s)
  -k  keep DAYS (default: 1 day)
  -w  show wget download command
  -q  quiet mode: no transfer status info
  -p  add path for single file argument
  -z  force compression
  -0  force no compression
  -Z  use zip
  -T  use tar (default for UNIX)
  -t  text mode (URL content displayble by webbrowser)
  -o  overwrite existing files
  -d  delete
  -l  list
  -u  generate upload function to be used by other users
  -x  show xxx propagation shell code (with your F*EX ID!)
  -X  same as -x, but generate URL shell command
upload arguments:
  .* files are default excluded, to include use .FILE or ./DIRECTORY
download or delete argument:
  -  last upload (in overwrite mode for download)
examples:
  $prg *jpg           # upload all jpg files
  $prg -m 1000 -k 5 . # upload current directory with 1000 kB/s and keep 5 days
  ls -l | $prg -t     # upload directory listing in text format
  $prg -d -           # delete last upload
  $prg                # interactive usage: download, list, delete
see also: fexsend, fexget, fexpack, fexstore, fexsync
";

  $hints = '
xxx is the extension of the F*EX clipboard xx with versioning.

With xxx you can store files or directories or pipe data of any size.

Files or directories beginning with a "." will not be transfered unless you use
an argument with such a name.
".del" and ".snapshot*" are always excluded!

The default keep time is 1 day, then the upload will expire.
If you need a longer keep time, then use option -k
For verbose mode you can use option -v

xxx autodetermines whether compression is suggestive by using container taz,
see: fexsend -H

You can use different F*EX accounts with fexsend and xxx:
xxx uses the [xx] F*EX id (env $FEXXX) if it is there, otherwise the regular
F*EX id (env $FEXID).
';

} else {
  $usage = "
usage:
  $prg [options] FILE[...] [@] RECIPIENT[,...]
  $prg [special option]
  $prg -l ['RECIPIENT-REGEXP']
  $prg -f NUMBER RECIPIENT[,...]
  $prg -x NUMBER [-C -k -D -K]
options:
  -v            verbose mode
  -a ARCHIVE    put files in archive (.zip .7z .tar .tgz) without .* files
  -A ARCHIVE    put files in archive (.zip .7z .tar .tgz) with .* files
  -# FILELIST   exclude files (# is list separator) from archive
  -0            do not compress files for .zip and .7z archives
  -d            delete file on fex server
  -o            overwrite mode, do not try to resume
  -m KBS        limit throughput (KBS kB/s)
  -p SIZE:WAIT  send file in chunks (SIZE MB, WAIT seconds)
  -i ACCOUNT    use ID data [ACCOUNT] from ID file
  -C 'COMMENT'  add COMMENT to notification email
  -k MAX        keep file MAX days on fex server
  -D            delay auto-delete after download
  -K            no auto-delete after download
  -M            MIME-file (to be displayed in recipient's webbrowser)
  -s STREAM     read data from pipe and upload it with STREAM name
  -r ADDRESS    use Reply-To ADDRESS in notification email
  -n            send no notification email, just show the download URL
  -/            do not upload the file, but tell the server to link it
  -= ALIAS      use ALIAS as filename
  -^            add date_time to filename
  -q            quiet mode
  -+            undocumented feature - test it :-)
special options:
  -I          initialize ID file or show ID
  -I ACCOUNT  add alternate ID data (secondary logins) to ID file
  -l          list sent files (numbers needed for -f -x -d -N)
  -u          list download URLs of sent files (show NUMBERs)
  -f NUMBER   forward already uploaded file to another recipient
  -x NUMBER   use -C -k -D -K for already uploaded file
  -d NUMBER   delete file on fex server
  -N NUMBER   resend notification email
  -Q          check quotas
  -U          generate upload URL with bash function (-U+ for archives)
  -T UP:DOWN  test internet speed with upload and download MBs
  -@          edit server address book (aliases)
  -S          show server/user settings and auth-ID
  -V          show version and installation/upgrade hint
  -H          show hints and examples and more options
examples:
  $prg visualization.mp4 framstag\@rus.uni-stuttgart.de
  $prg -a images.zip *.jpg webmaster\@belwue.de,metoo
  lshw | $prg -s hardware.list admin\@belwue.de
";
# usage: $prg -R FEX-URL email
#         -R FEX mail  self-register your email address at FEX server

  $hints = '
fexsend hints and more options:

usage: fexsend [options] file recipient(s)

Recipient can be a comma separated address list. Example:
  fexsend big.file framstag@rus.uni-stuttgart.de,webmaster@belwue.de

Recipient can be an alias from your server address book
(use "fexsend -@" to edit it). Example:
  fexsend big.file framstag

Recipient can be a SKEY URL, which you have received from a regular F*EX user.
When using this URL you are a subuser of this full user and the file will be
sent to him. Example:
  fexsend big.file http://fex.rus.uni-stuttgart.de/fup?skey=4285f8cdd881626524fba686d5f0a83a

Recipient can be a GKEY URL, which you have received from a regular F*EX user.
Using this URL you are a member of his group and the file will be sent to all
members of this group. Example:
  fexsend big.file http://fex.rus.uni-stuttgart.de/fup?gkey=50d26547b1e8c1110beb8748fc1d9444

Recipient can be a OKEY URL, which you have received from a regular F*EX user.
Using this URL you can send exactly one file. Example:
  fexsend big.file http://fex.rus.uni-stuttgart.de/fup?to=framstag@rus.uni-stuttgart.de?okey=HZ6UEkCQ

When you use "FEX-URL/anonymous" as recipient and your F*EX administrator has
allowed anonymous upload for your IP address then no auth-ID is needed.

"." as recipient means fex to yourself and show the download URL after upload
without sending a notification email. Example:
  fexsend software.tar .

"+" as recipient means fex to yourself and show the download URL immediatelly.
With this URL the file can be downloaded while the upload is still in progress!
Example:
  fexsend big_VM.tar +

"//" as recipient means fex to yourself and create extra short download URL.
Example:
  fexsend software.tar //

If you want a Bcc of the notification email then add \'!bcc!\' to the comment:
fexsend -C \'!bcc! for me and you\' ...

To manage your subuser and groups or forward or redirect files, use a
webbrowser with the URL from "fexsend -U", e.g.:  firefox $(fexsend -U)

If you want to copy-forward an already uploaded file to another recipient,
then you first have to query the file number with:
  fexsend -l
and then copy-forward it with:
  fexsend -b # other@address
Where # is the file number.

You can list an uploaded file in more detail with
  fexsend -l #
Where # is the file number.

If you want to modify the keep time, comment or auto-delete behaviour of an
already uploaded file then you first have to query the file number with:
  fexsend -l
and then for example set the keep time to 30 days with:
  fexsend -x # -k 30
Where # is the file number.

To list files sent only to yourself, use:
  fexsend -l .

To list files sent to others, but yourself, use:
  fexsend -l -

To show the content of your id file, use:
  fexsend -I -

With option -. the server sends a short instead of a detailed notification
email to the recipient.

With option -a (excludes .* files) or -A (includes .* files) you can send
several files or whole directories within a single archive file.
".del" and ".snapshot*" are always excluded!
To keep the full path inside the archive, add a trailing / to the directory
name, example: fexsend -a example.tar keep/this/directory/path/ .

With option -O USER you can generate an onetime upload URL
(USER must be an email address).

Option -# uses shell pattern to exclude files.

The archive types tar and tgz are build on-the-fly (streaming) whereas archive
types zip and 7z need a temporary archive file in $HOME/.fex/tmp/ (disk space!)

When you use the pseudo archive type taz, then fexsend will determine whether
compression is suggestive by inspecting all file names and then uses either
tar or tgz archive. Suggestive means: total size must be less than 2 GB and at
least 20% must be compressable.

With option -s you can send any data coming from a pipe (STDIN) as a file
without wasting local disc space.

With option -p SIZE:WAIT you can send your file in chunks.
This may be necessary if you have a firewall/gateway with a tcp transfer
limitation (e.g. Arbor). The option parameter SIZE:WAIT specifies the chunk
size in MB and the time to wait between the chunks in seconds. Examples:
fexsend -p 100  data.tar someone@some.where # 100 MB chunks
fexsend -p 10:3 data.tar someone@some.where # 10 MB chunks with 3 s wait time

With option -X you can specify any URL parameter, e.g.:
fexsend -X autodelete=yes ...
fexsend -X \'autodelete=no&locale=german\' ...

With option -F you activate female mode.

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 "man ciphers" from openssl

Partner programs:
fexget is for downloading.                     See: fexget -h
fexpush is for archive sharing.                See: fexpush -h
fexpull is for archive sharing.                See: fexpull -h
xx is an internet clipboard.                   See: xx -h
xxx is an internet clipboard with versioning.  See: xxx -h
fexpack is a named internet clipboard.         See: fexpack -h

fexsend stores the login data (server, user and auth-ID) in the file
$HOME/.fex/id
The format of this file is ([data] is optional):

server-URL[!proxy[:port[:chunk-size]]
email-address
auth-ID

For temporary usage of a HTTP proxy use:
  fexsend -P your_proxy:port:chunksize_in_MB file recipient
Example:
  fexsend -P wwwproxy.uni-stuttgart.de.de:8080:1024 4GB.tar .

For temporary usage of an alternative F*EX server or user use:
  FEXID="FEXSERVER USER AUTHID" fexsend file recipient
Example:
  FEXID="fex.belwue.de gaga@belwue.de blubb" fexsend big.file framstag@belwue.de

When using http (and not https), then your auth-ID will be sent encrypted with
a one-time session ID, offered by the F*EX server. This will no happen, when
you use an http proxy, because most proxys do not support connection keep alive.

You can define aliases (and optional fexsend options) in $HOME/.fex/config.pl:
  %alias = (
    \'alias1\' => \'user1@domain1.org\',
    \'alias2\' => \'user2@domain2.org\',
    \'both\'   => \'user1@domain1.org,user2@domain2.org\',
    \'extra\'  => \'extra@special.net:-i other -K -k 30\',
  );

fexsend also respects aliases in $HOME/.mutt/aliases
The alias priority is (descending):
$HOME/.fex/config.pl
$HOME/.mutt/aliases
fexserver address book

In $HOME/.fex/config.pl you can also set the SSL* environment variables and the
$opt_* variables, e.g.:

$ENV{SSLVERSION} = \'TLSv1_2\';
${\'opt_+\'} = 1;  # equivalent to option -+
$opt_0 = 1;        # equivalent to option -0
$opt_m = 200;      # equivalent to option -m 200
';
}

$usage =~ s/^\n//;

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

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

autoflush STDOUT;
autoflush STDERR;

if ($windoof and not @ARGV and not $ENV{PROMPT}) {
  # restart with cmd.exe to have mouse cut+paste
  exec qw'cmd /k',$prg,'-W';
  exit;
}

unless (-d $fexhome) {
  mkdir $fexhome or die "$prg: cannot create $fexhome - $!\n";
  chmod 0700,$fexhome;
}

unless (-d $fextmp) {
  mkdir $fextmp or die "$prg: cannot create $fextmp - $!\n";
  chmod 0700,$fextmp;
}

if (-d $fextmp and my @s = stat($fextmp)) {
  if ($< ne $s[4]) {
    die "$prg: not owner of $fextmp\n";
  }
  my $yt = time-24*60*60;
  foreach my $tmp (glob "$fextmp/*") {
    if (@s = stat $tmp) {
      unlink $tmp if $yt > $s[9];
    }
  }
} else {
  die "$prg: $fextmp is not a directory\n";
}


my @_ARGV = @ARGV; # save arguments

our ($opt_q,$opt_h,$opt_H,$opt_v,$opt_m,$opt_c,$opt_k,$opt_d,$opt_l,$opt_I,
     $opt_K,$opt_D,$opt_u,$opt_f,$opt_a,$opt_C,$opt_R,$opt_M,$opt_L,$opt_Q,
     $opt_A,$opt_i,$opt_z,$opt_Z,$opt_b,$opt_P,$opt_x,$opt_X,$opt_V,$opt_U,
     $opt_s,$opt_o,$opt_g,$opt_F,$opt_n,$opt_r,$opt_S,$opt_N,$opt_T,$opt_O,
     $opt_p,$opt_t,$opt_w,$opt_0);

if ($xx) {
  $opt_q = 1 if @ARGV and $ARGV[-1] eq '--' and pop @ARGV or not -t STDOUT;
  $opt_h = $opt_v = $opt_I = 0;
  $opt_X = $opt_p = $opt_m = $opt_i = '';
  $_ = "$fexhome/config.pl"; require if -f;
  getopts('hvI.m:p:i:') or die $usage;
} elsif ($xxx) {
  $opt_h = $opt_H = $opt_v = $opt_g = $opt_d = $opt_I = $opt_u = 0;
  $opt_l = $opt_L = $opt_x = $opt_X = $opt_o = $opt_t = $opt_w = 0;
  $opt_k = $opt_z = $opt_Z = $opt_T = $opt_q = $opt_p = $opt_0 = 0;
  $opt_m = '';
  getopts('hHvlLdIuxXopzZTtwq.0m:k:') or die $usage;
  if ($opt_g+$opt_d+$opt_u+$opt_l+$opt_L+$opt_x+$opt_X > 1) {
    die "$prg: you cannot mix options -d -g -u -l -x -X\n";
  }
  $opt_x ||= $opt_X;
  @ARGV = ('-') unless -t STDOUT or @ARGV;
  $opt_g = 1 if -t STDIN and not @ARGV and
                not $opt_l||$opt_L||$opt_u||$opt_x||$opt_d||$opt_I;
  if ($opt_w) {
    $ENV{opt_w} = $opt_w;
    $opt_l = $opt_w if -t STDIN and not @ARGV;
  }
} else {
  if ($macos and not @ARGV) {
    &ask_file;
  }
  $opt_h = $opt_v = $opt_m = $opt_c = $opt_d = $opt_l = $opt_I = 0;
  $opt_H = $opt_K = $opt_D = $opt_R = $opt_M = $opt_L = $opt_Q = $opt_0 = 0;
  $opt_x = $opt_o = $opt_g = $opt_V = $opt_U = $opt_F = $opt_n = $opt_q = 0;
  $opt_S = $opt_N = $opt_u = 0;
  ${'opt_@'} = ${'opt_!'} = ${'opt_+'} = ${'opt_.'} = ${'opt_/'} = 0;
  ${'opt_^'} = 0;
  ${'opt_='} = ${'opt_~'} = ${'opt_#'} = ${'opt_?'} = '';
  $opt_k = $opt_f = $opt_C = $opt_i = $opt_b = $opt_P = $opt_X = '';
  $opt_a = $opt_A = $opt_s = $opt_r = $opt_T = $opt_p = $opt_O = '';
  $_ = "$fexhome/config.pl"; require if -f;
  unshift @ARGV,split if $_ = $ENV{FEXSEND_OPT};
  getopts('hHvdonVDKlILuURWMFzZqQS@0!+./^?~:r:m:k:f:a:A:s:C:i:b:O:p:P:x:X:N:T:=:#:')
    or die $usage;

  if ($opt_V) {
    $useragent =~ /fexsend-(.+)/;
    print "Version: $1\n";
    if ("@ARGV" ne '.' and abs_path($_0) !~ m:/sw/:) {
      print "Upgrade: wget fex.belwue.de/download/fex.pl && perl fex.pl\n";
    }
    exit;
    if (not @ARGV and -w $_0) {
      print "Update fexsend? "; # ex "upgrade fexsend"
      $_ = <STDIN>||'';
      if (/^y/i) {
        my $url = 'http://fex.belwue.de/download/fexsend';
        warn "$prg: downloading $url\n";
        my $new = `wget -qO- $url`;
        if ($new !~ /update fexsend/) { die "fexsend: bad update\n" }
        if ($new =~ /version = (\d+)/ and $1 le $version) {
          warn "$prg: version $version is uptodate\n";
          exit;
        }
        $_0 = abs_path($_0);
        system "vv -vs '$_0' 2>/dev/null || rsync -av '$_0' '$_0~'";
        exit $? if $?;
        open $_0,'>',$_0 or die "$prg: cannot write $_0 - $!\n";
        print {$_0} $new;
        close $_0;
        exec $_0,qw'-V .';
      }
    }
    exit;
  }

  if ($opt_K and $opt_D) {
    die "$prg: you cannot use both options -D and -K\n";
  }

  if ($opt_a and $opt_A) {
    die "$prg: you cannot use both options -a and -A\n";
  }

  $opt_a = $opt_A if $opt_A;
  $opt_l = $opt_u if $opt_u;

  if ($opt_a and $opt_c) {
    $opt_a =~ s/\.tar$/.tgz/;
  }

  if ($opt_a and $opt_s) {
    die "$prg: you cannot use both options -a and -s\n";
  }

  if ($opt_g and $opt_c) {
    $opt_c = 0;
  }

  if ($opt_A) {
    $xlist = ${'opt_#'} . '#.del#.snapshot*#.fex/tmp';
  } else {
    $xlist = ${'opt_#'} . '#.*';
  }
  $xlist =~ s/^#//;

  $xp = $xlist;
  $xp =~ s/\./\\./g;
  $xp =~ s/\+/\\+/g;
  $xp =~ s/\?/./g;
  $xp =~ s/\*/.*/g;
  $xp =~ s/\#/|/g;
#  $xp = "#|$xp";

  $opt_f ||= $opt_b;
  if ($opt_f and $opt_f !~ /^\d+$/) {
    die "$prg: option -f needs a number, see $prg -l\n";
  }

  if ($opt_I and $opt_R) {
    die "$prg: you cannot use both options -I and -R\n";
  }

  $command =
    ($opt_d)		? 'DELETE':
    ($opt_l or $opt_L)	? 'LIST':
    ($opt_Q)		? 'CHECKQUOTA':
    ($opt_S)		? 'LISTSETTINGS':
    ($opt_Z)		? 'RECEIVEDLOG':
    ($opt_z)		? 'SENDLOG':
    (${'opt_!'})	? 'FOPLOG':
  '';

  $opt_D =
    ($opt_D) ? 'DELAY':
    ($opt_K) ? 'NO':
  $opt_D;
}

die $usage if $opt_m and $opt_m !~ /^\d+/;

if ($opt_h) {
  female_mode("show help?") if $opt_F;
  print $usage;
  exit;
}

if ($opt_H) {
  if (0 and -t STDOUT) {
    exec "$prg -H |".($ENV{PAGER}||'less');
  } else {
    print $hints;
  }
  exit;
}

if ($opt_R) {
  &register;
  exit;
}

if ($opt_I) {
  if ($xx or $xxx) { &show_id }
  else             { &init_id }
  exit;
}

if ($xx or $xxx) {


  # alternativ ID?
  if ($opt_i) {
    $proxy = $proxy_prefix = '';
    open $idf,$idf or die "$prg: cannot open $idf - $!\n";
    while (<$idf>) {
      if (/^\[$opt_i\]/) {
        get_id($idf);
        last;
      }
    }
    close $idf;
    die "$prg: no [$opt_i] in $idf\n" unless $_;
  } elsif ($FEXXX = $ENV{FEXXX}) {
    $FEXXX = decode_b64($FEXXX) if $FEXXX !~ /\s/;
    ($fexcgi,$from,$id) = split(/\s+/,$FEXXX);
    warn "using ID from \$FEXXX\n" if $opt_v;
  } elsif (open $idf,$idf) {
    while (<$idf>) {
      if (/^\[xx\]/) {
        $proxy = $proxy_prefix = '';
        get_id($idf);
        warn "using ID from $idf [xx]\n" if $opt_v;
        last;
      }
    }
    close $idf;
  }

  unless ($id) {
    if ($FEXID = $ENV{FEXID}) {
      $FEXID = decode_b64($FEXID) if $FEXID !~ /\s/;
      ($fexcgi,$from,$id) = split(/\s+/,$FEXID);
      warn "using ID from \$FEXID\n" if $opt_v;
    } else {
      if (open $idf,$idf) {
        get_id($idf);
        close $idf;
        warn "using ID from $idf\n" if $opt_v;
      }
    }
  }

  unless ($id) {
    die "$prg: no $idf or \$FEXID or \$FEXXX available\n";
  }

} else {

  # alternativ ID?
  if ($opt_i) {
    $proxy = $proxy_prefix = '';
    open $idf,$idf or die "$prg: cannot open $idf - $!\n";
    while (<$idf>) {
      if (/^\[$opt_i\]/) {
        get_id($idf);
        last;
      }
    }
    close $idf;
    die "$prg: no [$opt_i] in $idf\n" unless $_;
  } else {
    if ($ENV{FEXXX} and not $ENV{FEXID} and not -f $idf) {
      $ENV{FEXID} = $ENV{FEXXX};
    }
    if ($FEXID = $ENV{FEXID}) {
      $FEXID = decode_b64($FEXID) if $FEXID !~ /\s/;
      ($fexcgi,$from,$id) = split(/\s+/,$FEXID);
      die "$prg: no id in \$FEXID\n" unless $id;
      $id =~ s/^PKEY:// and $pkey = $id;
      warn "using ID from \$FEXID\n" if $opt_v;
    } else {
      if ($windoof and not -f $idf) { &init_id }
      if (open $idf,$idf) {
        get_id($idf);
        close $idf;
        warn "using ID from $idf\n" if $opt_v;
      }
    }
  }
}

if (0 and not $proxy and $proxy = $ENV{http_proxy}) {
  if ($proxy =~ s{(http://)(\S+:\S+)@}{$1}) {
    $proxy_authorization = encode_b64($2);
  }
  if ($proxy =~ m{(http://\S+)(:(\d+))?}) {
    $proxy_prefix = $1.($2||'');
  }
}

if ($xxx) {
  &xxx;
  exit;
}

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

if ($opt_T) {
  my ($up,$down);

  $usage = "usage: $prg -T MB_up[:MB_down] [fexserver]\n";
  if ($opt_T =~ /^(\d+)$/) {
    $up = $down = $1;
  } elsif ($opt_T =~ /^(\d+):(\d+)$/) {
    $up = $1;
    $down = $2;
  } else {
    die $usage;
  }

  if (@ARGV) {
    nettest($ARGV[0],$up,$down);
  } elsif ($fexcgi) {
    nettest($fexcgi,$up,$down);
  } else {
    nettest('fex.belwue.de',$up,$down);
  }
  exit;
}

if (@ARGV > 1 and $ARGV[-1] =~ /(^|\/)anonymous/) {
  $fexcgi = $1 if $ARGV[-1] =~ s:(.+)/::;
  die "usage: $prg [options] file FEXSERVER/anonymous\n" unless $fexcgi;
  $anonymous = $from = 'anonymous';
  $sid = $id = 'ANONYMOUS';
} elsif (@ARGV > 1 and $id eq 'PUBLIC') {
  $public = $sid = $id;
} elsif (@ARGV > 1 and $ARGV[-1] =~ m{^(https?://[\w.-]+(:\d+)?/fup.*\?[sgo]key=\w+)}) {
  $fexcgi = $1;
  if ($fexcgi =~ /skey=(\w+)/) {
    $skey = $1;
    if ($command) {
      die "$prg: command $command not allowed for subuser\n";
    }
  }
  if ($fexcgi =~ /gkey=(\w+)/) {
    $gkey = $1;
    if ($command) {
      die "$prg: command $command not allowed for groupuser\n";
    }
  }
  if ($fexcgi =~ /okey=(\w+)/) {
    $okey = $1;
    if ($command) {
      die "$prg: command $command not allowed for onetime user\n";
    }
  }
} else {

  if ($ENV{FEXSERVER} and not $ENV{GATEWAY_INTERFACE} and not $opt_i) {
    $fexcgi = $ENV{FEXSERVER};
  }

  if (not -e $idf and not ($fexcgi and $from and $id)) {
    die "$prg: no ID file $idf found, use \"fexsend -I\" to create it\n";
  }

  unless ($fexcgi) {
    die "$prg: no FEX URL found, use \"$prg -u URL\" or \"$prg -I\"\n";
  }

  unless ($from and $id) {
    die "$prg: no sender found, use \"$prg -f FROM:ID\" or \"$prg -I\"\n";
  }

  if ($fexcgi !~ /^http/) {
    if ($fexcgi =~ /:443/) { $fexcgi = "https://$fexcgi" }
    else                   { $fexcgi = "http://$fexcgi" }
  }

}

$server = $fexcgi;

$port = 80;
$port = 443 if $server =~ s{https://}{};
$port = $1  if $server =~ s/:(\d+)//;

if ($port == 443) {
  # $opt_s and die "$prg: cannot use -s with https due to stunnel bug\n";
  # $opt_g and die "$prg: cannot use -g with https due to stunnel bug\n";
  $https = $port;
}

$server =~ s{http://}{};
$server =~ s{/.*}{};

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

# xx: special file exchange between own accounts
if ($xx) {
  if ($opt_v) {
    print "server: $server:$port\n";
    print "user: $from\n";
    # printf "FEXXX=%s\n",encode_b64($FEXXX);
  }
  $transferfile = "$fextmp/STDFEX";
  open my $lock,'>>',$transferfile
    or die "$prg: cannot write $transferfile - $!\n";
  flock($lock,LOCK_EX|LOCK_NB)
    or die "$prg: $transferfile is locked by another process\n";
  truncate $transferfile,0;
  if (not @ARGV and -t) {
    &get_xx($transferfile);
  } else {
    &send_xx($transferfile);
  }
  exit;
}


# regular fexsend

if (${'opt_?'} or
    ($windoof or $cygwin) and not @ARGV and $useragent !~ /^\w+\// and not
    ($opt_l or $opt_L or $opt_Q or $opt_A or $opt_U or $opt_I or
     $opt_f or $opt_x or $opt_N or ${'opt_~'}))
{ &inquire }

unless (length $opt_C) {
  $opt_C = $ENV{FEXCOMMENT}||'';
}

if (${'opt_.'}) {
  $opt_C = "!SHORTMAIL! $opt_C";
}

if ($opt_n or $opt_C =~ /^(NOMAIL|!#!)/) {
  $opt_C = $nomail = 'NOMAIL';
}

if ((not ($opt_q||$skey||$gkey||$okey||$anonymous) and ($opt_i||${'opt_/'}
       or $ENV{FEXID}) and $useragent !~ m:/:))
{ print "server/user: $fexcgi/$from\n" }

my $A = "@ARGV";
if    ($opt_f) 				 { &forward }
elsif ($opt_x) 				 { &modify }
elsif ($opt_N) 				 { &renotify }
elsif ($opt_Q) 				 { &query_quotas }
elsif ($opt_S) 				 { &query_settings }
elsif ($opt_l or $opt_L)		 { &list }
elsif ($opt_U)				 { command('GENUKEY',@ARGV) }
elsif ($opt_O)				 { command("GENOKEY:$opt_O") }
elsif ($opt_z or $opt_Z or ${'opt_!'})	 { &get_log }
elsif (${'opt_@'})			 { edit_address_book($from) }
elsif (${'opt_~'})			 { command(${'opt_~'}) }
elsif ($opt_d and $anonymous)		 { &purge }
elsif ($opt_d and $A =~ /^[\d ]+$/)	 { &delete_file_number }
elsif ($opt_d and $A =~ m:^http.*/fop/:) { &delete_file_url }
elsif ($opt_V||$opt_v and not @ARGV)   	 { exit }
else                                     { &send_fex }
exit;


# initialize ID file or show ID
sub init_id {
  my $tag;
  my $proxy = '';

  if ($opt_I) {
    $tag = shift @ARGV;
    die $usage if @ARGV;
  }

  $fexcgi = $from = $id = '';

  unless (-d $fexhome) {
    mkdir $fexhome or die "$prg: cannot create FEXHOME $fexhome - $!\n";
    chmod 0700,$fexhome;
  }

  # show ID
  if (not $tag and open $idf,$idf) {
    if ($opt_i) {
      while (<$idf>) {
        last if /^\[$opt_i\]/;
      }
    }
    $fexcgi = <$idf>;
    $from   = <$idf>;
    $id     = <$idf>;
    close $idf;
    if ($id) {
      chomp($fexcgi,$from,$id);
      $FEXID = encode_b64("$fexcgi $from $id");
      if (-t STDIN) {
        print "# server: $fexcgi\n";
        print "# user: $from\n";
        print "# hint: to edit the ID file \$HOME/.fex/id use \"$prg -I .\" #\n";
        print "export FEXID=$FEXID;history -d \$((HISTCMD-1))\n";
      } else {
        print "FEXID=$FEXID\n";
      }
      exit;
    } else {
      die "$prg: no ID data found\n";
    }
  }

  if ($tag) {
    if ($tag eq '.') {
      exec $ENV{EDITOR}||'vi',$idf;
    }
    if ($tag eq '-') {
      open $idf,$idf or die "$prg: cannot open $idf - $!\n";
      print while <$idf>;
      exit;
    }
    if ($tag =~ /^FEXID=(\S+)$/) {
      $FEXID = $1;
      if (-f $idf) {
        die "$prg: $idf does already exist\n".
            "$prg: use \"$prg -I .\" to edit it\n";
      }
      ($fexcgi,$from,$id) = split(/\s+/,decode_b64($FEXID));
      unless ($id) {
        die "$prg: $FEXID is not a valid FEXID\n";
      }
      if (open $idf,'>',$idf) {
        print {$idf} "$fexcgi\n",
                     "$from\n",
                     "$id\n";
        close $idf;
        print "data written to $idf\n";
        exit;
      } else {
        die "$prg: cannot write to $idf - $!\n";
      }
    }
  }

  if ($tag) { print "F*EX server URL for [$tag]: " }
  else      { print "F*EX server URL: " }
  $fexcgi = <STDIN>;
  $fexcgi =~ s/[\s\n]//g;
  die "you MUST provide a FEX-URL!\n" unless $fexcgi;
  if ($fexcgi =~ /\?/) {
    $from = $1 if $fexcgi =~ /\bfrom=(.+?)(&|$)/i;
    $id   = $1 if $fexcgi =~ /\bid=(.+?)(&|$)/i;
    # $skey = $1 if $fexcgi =~ /\bskey=(.+?)(&|$)/i;
    # $gkey = $1 if $fexcgi =~ /\bgkey=(.+?)(&|$)/i;
    die "$prg: cannot use GKEY URL in ID file\n" if $fexcgi =~ /gkey=/i;
    die "$prg: cannot use SKEY URL in ID file\n" if $fexcgi =~ /skey=/i;
    $fexcgi =~ s/\?.*//;
  }
  unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) {
    die "\"$fexcgi\" is not a legal FEX-URL!\n";
  }
  $fexcgi =~ s:/fup/*$::;
  print "proxy address (hostname:port or empty if none): ";
  $proxy = <STDIN>;
  $proxy =~ s/[\s\n]//g;
  if ($proxy =~ /^[\w.-]+:\d+$/) {
    $proxy = "!$proxy";
  } elsif ($proxy =~ /\S/) {
    die "wrong proxy address format\n";
  } else {
    $proxy = "";
  }
  if ($proxy) {
    print "proxy POST limit in MB (use 2048 if unknown): ";
    $_ = <STDIN>;
    if (/(\d+)/) {
      $proxy .= "[$1]";
    }
  }
  if ($skey) {
    $from = 'SUBUSER';
    $id = $skey;
  } elsif ($gkey) {
    $from = 'GROUPMEMBER';
    $id = $gkey;
  } elsif ($okey) {
    $from = 'ONETIMEUSER';
    $id = $okey;
  } else {
    unless ($from) {
      print "Your email address as registered at $fexcgi: ";
      $from = <STDIN>;
      $from =~ s/[\s\n]//g;
      die "you MUST provide your email address!\n" unless $from;
    }
    unless ($from =~ /^[_:=\w\-\.\/\@\%\+]+$/) {
      die "\"$from\" is not a legal email address!\n";
    }
    unless ($id) {
      print "Your auth-ID for $from at $fexcgi: ";
      $id = <STDIN>;
      $id =~ s/[\s\n]//g;
      die "you MUST provide your ID!\n" unless $id;
    }
  }
  if (open $idf,'>>',$idf) {
    print {$idf} "\n[$tag]\n" if $tag and -s $idf;
    print {$idf} "$fexcgi$proxy\n",
                 "$from\n",
                 "$id\n";
    close $idf;
    print "data written to $idf\n";
  } else {
    die "$prg: cannot write to $idf - $!\n";
  }
}


sub show_id {
  my ($fexcgi,$from,$id);
  if (open $idf,$idf) {
    $fexcgi = <$idf>;
    # $fexcgi = <$idf> if $fexcgi =~ /^\[.+\]/;
    $from   = <$idf>;
    $id     = <$idf>;
    while (<$idf>) {
      if (/^\[xx\]/) {
        $fexcgi = <$idf>;
        $from   = <$idf>;
        $id     = <$idf>;
      }
    }
    close $idf;
    die "$prg: too few data in $idf" unless defined $id;
    chomp($fexcgi);
    chomp($from);
    chomp($id);
    $FEXXX = encode_b64("$fexcgi $from $id");
    if (-t STDIN) {
      print "# server: $fexcgi\n";
      print "# user: $from\n";
      print "export FEXXX=$FEXXX;history -d \$((HISTCMD-1))\n";
    } else {
      print "FEXXX=$FEXXX\n";
    }
  } else {
    die "$prg: cannot read $idf - $!\n";
  }
}


sub register {
  my $fs = shift @ARGV or die $usage;
  my $mail = shift @ARGV or die $usage;
  my $port;
  my ($server,$user,$id);

  die "$prg: $idf does already exist\n" if -e $idf;

  if ($fs =~ /^https/) {
    die "$prg: cannot handle https at this time\n";
  }

  $fs =~ s{^http://}{};
  $fs =~ s{/.*}{};
  if ($fs =~ s/:(\d+)//) { $port = $1 }
  else                   { $port = 80 }

  tcpconnect($fs,$port);
  sendheader("$fs:$port","GET $proxy_prefix/fur?user=$mail&verify=no HTTP/1.1");
  http_response();

  # header
  while (<$SH>) {
    s/\r//;
    warn "<-- $_" if $opt_v;
    last if /^\s*$/;
  }

  while (<$SH>) {
    s/\r//;
    warn "<-- $_" if $opt_v;
    if (m{http://(.*)/fup\?from=(.+)&ID=(.+)}) {
      $server = $1;
      $user = $2;
      $id = $3;

      if (open F,">$idf") {
        print F "$server\n",
                "$user\n",
                "$id\n";
        close F;
        chmod 0600,$idf;
        print "user data written to $idf\n";
        print "you can now fex!\n";
        exit;
      } else {
        die "$prg: cannot write to $idf - $!\n";
      }
    }
  }

  die "$prg: no account data received from F*EX server\n";

}


# menu for MacOS users
sub menu {
  my $key;
  my $new;
  local $_;

  system 'clear';
  print "\n";
  print "fexsend-$version\n";

  for (;;) {
    if (open $idf,$idf) {
      $fexcgi = getline($idf) and
      $from   = getline($idf) and
      $id     = getline($idf);
      close $idf;
      last if $id;
    }
    &set_ID;
  }

  print "\n";
  print "$from on $fexcgi\n";
  print "\n";

  for (;;) {
    print "\n";
    print "[s]  send a file or directory\n";
#   print "[u]  update fexsend\n";
    print "[l]  change login data (user, server, auth-ID)\n";
    print "[h]  help\n";
    print "[q]  quit\n";
    print "\n";
    print "your choice: ";
    $key = ReadKey(0);
    if ($key eq 'q') {
      print "$key\n";
      print "\n";
      print "Type [Cmd]W to close this window.\n";
      exit;
    }
    if ($key eq 'h') {
      print "$key\n";
      print
        "\n".
        "With fexsend you can send files of any size to any email address.\n".
        "\n".
        "At the recipient or file prompt [ENTER] brings you to this option menu.\n".
        "\n".
        "To send more than one file:\n".
        "When you enter * at the file prompt, you will be first asked for an archive name\n".
        "and then you can drag+drop multiple files.\n".
        "\n".
        "Do not forget to terminate each input line with [ENTER].\n".
        "\n".
        "See http://fex.rus.uni-stuttgart.de/ for more information.\n";
      next;
    }
    if (0 and $key eq 'u') {
      print "$key\n";
      if ($prg =~ m:(^/client/|/sw/):) {
        print "\n";
        print "use swupdate to update fexsend!\n";
        next;
      }
      $new = $prg.'.new';
      system qw'wget -nv -O',$new,'http://fex.belwue.de/download/fexsend';
      chmod 0755,$new;
      system qw'perl -c',$new;
      if ($? == 0) {
        rename $new,$prg;
        exec $prg;
      } else {
        print "\n";
        print "cannot install new fexsend\n";
      }
      next;
    }
    if ($key eq 'l') {
      print "$key\n";
      system 'clear';
      &set_ID;
      next;
    }
    if ($key eq 's' or $key eq "\n") {
      print "s\n";
      &ask_file;
      next;
    }
  }
  exit;
}


# for MacOS
sub ask_file {
  my ($file,$comment,$recipient,$archive,$size,$cmd,$key);
  my @files;
  my $qfiles;
  local $_;

  system 'clear';

  &set_ID unless -s $idf;

  print "\n";
  print "Enter [ENTER] after each input line.\n";
  print "\n";

  for (;;) {
    print "Recipient(s): ";
    $recipient = <STDIN>;
    chomp $recipient;
    $recipient =~ s/^\s+//;
    $recipient =~ s/\s+$//;
    $recipient =~ s/[\s;,]+/,/g;
    &menu unless $recipient;
    last if $recipient =~ /\w/ or $recipient eq '.';
  }

  for (;;) {
    print "\n";
    print "Drag a file into this window or hit [ENTER] ";
    print $archive ? "to continue.\n" : "for menu options.\n";
    print "File to send: ";
    $file = <STDIN>||'';
    chomp $file;
    $file =~ s/^\s+//;
    $file =~ s/ $// if $file !~ /\\ $/;
    &menu unless $file or $archive;
    if ($file eq '*') {
      print "Archive name: ";
      $archive = <STDIN>||'';
      chomp $archive;
      next unless $archive;
      $archive =~ s/^\s+//g;
      $archive =~ s/\s+$//g;
      next;
    }
    if ($file) {
      unless (-e $file) {
        $file =~ s/\\\\/\000/g;
        $file =~ s/\\//g;
        $file =~ s/\000/\\/g;
      }
      unless (-r $file) {
        print "\"$file\" is not readable\n";
        next;
      }
      my $qf = shellquote($file);
      if (`du -ms $qf` =~ /^(\d+)/) {
        $size += $1;
        printf "%d MB\n",$1;
      }
      if ($archive) {
        push @files,$file;
        next;
      }
    }
    if ($archive) {
      $archive =~ s/[^\w=.+-]/_/g;
      $archive =~ s/^\./_./g;
      next unless @files;
      $qfiles = join(' ',map(shellquote($_),@files));
      if ($size < 2048) {
        $archive .= '.zip';
      } else {
        $archive .= '.tar';
      }
    }
    print "\n";
    print "Comment: ";
    $comment = <STDIN>||'';
    chomp $comment;
    print "\n";
    if ($comment =~ s/^:\s*-/-/) {
      $cmd = shellquote($_0)." $comment ";
      if ($archive) {
        $cmd .= '-A '.shellquote($archive).' '.$qfiles;
      } else {
        $cmd .= shellquote($file);
      }
      $cmd .= ' '.shellquote($recipient);
      print $cmd,"\n";
      system $cmd;
    } else {
      print shellquote($prg)." -C '$comment' ";
      if ($archive) {
        printf "-A %s %s %s\n",shellquote($archive),$qfiles,$recipient;
        system $prg,'-C',$comment,'-A',$archive,@files,$recipient;
      } else {
        printf "%s %s\n",shellquote($file),$recipient;
        system $prg,'-C',$comment,$file,$recipient;
      }
    }
    print "\n";
    print "[s]  send another file to $recipient\n";
    print "[n]  send another file to another recipient\n";
    print "[q]  quit\n";
    print "\n";
    print "your choice: ";
    for (;;) {
      $key = ReadKey(0);
      &ask_file if $key eq 'n';
      if ($key eq 's' or $key eq "\n") {
        print "s\n";
        last;
      }
      if ($key eq 'q') {
        print "$key\n";
        exit;
      }
    }
    $file = $comment = $archive = '';
    @files = ();
  }
}


sub set_ID {
  my ($server,$port,$user,$logo);
  local $_;

  print "\n";
  for (;;) {
    print "F*EX server URL: ";
    $server = <STDIN>;
    $server =~ s/[\s\n]//g;
    if ($server =~ s:/fup/(\w+)$::) {
      $_ = decode_b64($1);
      if (/(from|user)=(.+)&id=(.+)/) {
        $user = $2;
        $id = $3;
      }
    }
    $server =~ s:/fup.*::;
    $server =~ s:/+$::;
    next if $server !~ /\w/;
    if ($server =~ s/^https:..// or $server =~ /:443/) {
      $server =~ s/:.*//;
      $port = 443;
      eval "use IO::Socket::SSL";
      if ($@) {
        print "\nno perl SSL modules installed - cannot use https\n\n";
        next;
      }
      $SH = IO::Socket::SSL->new(
        PeerAddr => $server,
        PeerPort => $port,
        Proto    => 'tcp',
        %SSL
      );
    } else {
      $server =~ s:^http.//::;
      if ($server =~ s/:(\d+)//) {
        $port = $1;
      } else {
        $port = 80;
      }
      $SH = IO::Socket::INET->new(
        PeerAddr => $server,
        PeerPort => $port,
        Proto    => 'tcp',
      );
    }
    unless ($SH) {
      print "\ncannot connect to $server:$port - $!\n\n";
      next;
    }
    sendheader(
      "$server:$port",
      "GET /logo.jpg HTTP/1.0",
      "Connection: close",
    );
    $_ = <$SH>||'';
    unless (/HTTP.1.1 200/) {
      print "\nbad server reply: $_\n";
      next;
    }
    while (<$SH>) { last if /^\s*$/ }
    local $/;
    $logo = <$SH>||'';
    close $SH;
    if (length $logo < 9999) {
      print "\n$server is not a F*EX server!\n\n";
      next;
    }
    open $logo,">$fextmp/fex.jpg";
    print {$logo} $logo;
    close $logo;
    last;
  }

  for (;;) {
    last if $user;
    print "Your login (email address): ";
    $user = <STDIN>;
    $user =~ s/[\s\n]//g;
    if ($user !~ /.@[\w.-]+$/) {
      print "\"$user\" is not a valid email address!\n";
      next;
    }
  }

  for (;;) {
    last if $id;
    print "Your auth-ID for this account: ";
    $id = <STDIN>;
    $id =~ s/[\s\n]//g;
  }

  open $idf,'>',$idf or die "$prg: cannot write to $idf - $!\n";
  print {$idf} "$server\n",
               "$user\n",
               "$id\n";
  close $idf;
  print "\n";
  print "Login data written to $idf\n\n";
  print "fexing test file to $user:\n\n";
  system "$prg -o -M -C test $fextmp/fex.jpg $user";
  print "\n";
  if ($? != 0) {
    print "fexsend failed, login data is invalid, try again\n";
    &set_ID;
  } else {
    print "fexsend test succeeded!\n";
    sleep 3;
  }
}



sub nettest {
  my $url = shift;
  my $up = shift;
  my $down = shift;
  my $bs = 2**16;
  my ($length,$t0,$t1,$t2,$tt,$tb,$tc,$B,$kBs,$bt);

  my $nettest = $sid = 'nettest';

  $port ||= 80;
  if ($url =~ s:^https.//::) {
    $https = $port = 443;
  } else {
    $url =~ s:^http.//::;
    $port = $1 if $url =~ s/:(\d+)//;
  }
  $url =~ s/[\/:].*//;
  $server = $url;

  if ($up) {
    serverconnect($server,$port);
    checkrecipient($nettest,$nettest);
    warn "$prg: send to $server:$port\n";
    formdatapost(
      from	=> $nettest,
      to	=> $nettest,
      id	=> $nettest,
      file	=> $nettest,
      size	=> $up*MB,
      comment	=> 'NOSTORE',
    );
  }

  if ($down) {
    serverconnect($server,$port);
    warn "$prg: receive from $server:$port\n";
    sendheader("$server:$port","GET $proxy_prefix/ddd/$down HTTP/1.0");
    $_ = <$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 /^$/;
        $length = $1 if /^Content-Length:\s*(\d+)/i;
      }
    } else {
      s/HTTP\/[\d.]+ \d+ //;
      die "$prg: bad server reply: $_";
    }

    unless ($length) {
      die "$prg: no Content-Length header in server reply\n";
    }


    if (${'opt_+'}) {
      print $rrcamel[0];
      $tc = 0;
    }

    $t0 = $t1 = $t2 = int(time);
    $B = 0;
    while ($B < $length) {
      $b = read $SH,$_,$bs or die "$prg: cannot read after $B bytes - $!\n";
      # defined($_ = <$SH>) or die "$prg: cannot read after $B bytes - $!\n";
      # $b = length;
      $B += $b;
      $bt += $b;
      $t2 = time;
      if (${'opt_+'} and int($t2*10)>$tc) {
        print $rrcamel[$tc%2+1];
        $tc = int($t2*10);
      }
      if (int($t2) > $t1) {
        $kBs = int($bt/kB/($t2-$t1));
        $t1 = $t2;
        $bt = 0;
        printf STDERR "nettest: %d MB (%d%%) %d kB/s        \r",
          int($B/MB),int(100*$B/$length),$kBs;
      }
    }
    close $SH;

    $tt = $t2-$t0;
    $kBs = int($B/kB/($tt||1));
    if (${'opt_+'}) {
      print $rrcamel[1];
      print $rrcamel[2];
    }
    printf STDERR "nettest: %d MB in %d s = %d kB/s        \n",
      int($B/MB),$tt,$kBs;
  }
}


# 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
  $key = getc(STDIN) while not defined $key;
  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";
  }
}


sub send_xx {
  my $transferfile = shift;
  my $file = '';
  my (@r,@tar,$dir);
  local $_;

  $SIG{PIPE} = $SIG{INT} = sub {
    unlink $transferfile;
    exit 3;
  };

  @tar = qw'tar -cvz';
  push @tar,qw'--exclude=.snapshot* --exclude=.fex/tmp';

  if (-t) {
    if ("@ARGV" eq '-') {
      # store STDIN to transfer file
      shelldo("gzip >> $transferfile");
    } elsif (@ARGV) {
      # local $opt_v = 1; # show tar command
      # print "making tar transfer file $transferfile :\n";
      # single file? then add this directly
      if (scalar @ARGV == 1) {
        # strip path if not ending with /
        if ($ARGV[0] =~ m:(.+)/(.+): and $2 !~ m:/$:) {
          ($dir,$file) = ($1,$2);
          chdir $dir or die "$prg: $dir - $!\n";
        } else {
          $file = $ARGV[0];
        }
        if (-l $file) {
          shelldo(@tar,qw'--dereference -f',$transferfile,$file);
        } else {
          shelldo(@tar,'-f',$transferfile,$file);
        }
      } else {
        # remove common path
        my $dir = dirname($ARGV[0]);
        foreach (@ARGV) {
          unless (/^\Q$dir\E\/./) {
            undef $dir;
            last;
          }
        }
        if (defined($dir) and chdir $dir) {
          @ARGV = grep { s:^\Q$dir\E\/::; } @ARGV;
        }
        shelldo(@tar,'-f',$transferfile,@ARGV);
      }
      if ($?) {
        unlink $transferfile;
        if ($? == 2) {
          die "$prg: interrupted making tar transfer file\n";
        } else {
          die "$prg: error while making tar transfer file\n";
        }
      }
    }
  } else {
    # write input from pipe to transfer file
    shelldo("gzip >> $transferfile");
  }

  die "$prg: no transfer file\n" unless -s $transferfile;

  serverconnect($server,$port);
  query_sid($server,$port);

  @r = formdatapost(
    from	=> $from,
    to		=> $from,
    id		=> $sid,
    file	=> $transferfile,
    comment	=> 'NOMAIL',
    autodelete	=> $transferfile =~ /STDFEX/ ? 'NO' : 'DELAY',
  );

  # open P,'|w3m -T text/html -dump' or die "$prg: w3m - $!\n";
  # print P @r;
  http_response(@r);
  if ($transferfile =~ /:/ and $prg ne 'xxx') {
    if ("@r" =~ /\s(X-)?Location: (http.*?)\s/) {
      print "wget -qO - $2 | tar xvzf -\n";
    }
  }

  unlink $transferfile;
}


sub query_quotas {
  my (@r,$r);
  local $_;

  female_mode("query quotas?") if $opt_F;

  @r = formdatapost(
    from	=> $from,
    to		=> $from,
    command	=> $command,
  );
  die "$prg: no response from fex server $server\n" unless @r;
  $_ = shift @r;
  unless (/^HTTP.* 2/) {
    s:HTTP/[\d\. ]+::;
    die "$prg: server response: $_\n";
  }
  if (($_) = grep(/^X-Sender-Quota/,@r) and /(\d+)\s+(\d+)/) {
    print "sender quota (used): $1 ($2) MB\n";
  } else {
    print "sender quota: unlimited\n";
  }
  if (($_) = grep(/^X-Recipient-Quota/,@r) and /(\d+)\s+(\d+)/) {
    print "recipient quota (used): $1 ($2) MB\n";
  } else {
    print "recipient quota: unlimited\n";
  }
}


sub command {
  my (@r,$r);
  my ($psp,$owner,$share,$archive,$avt,$dkey);
  my $command = shift;
  local $_;

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

  if ($command eq 'FUPWATCH') {
    warn "$prg: querying $psp/$from\n";
    @r = formdatapost(
      from	=> $from,
      to	=> $from,
      command	=> $command,
    );
    die "$prg: no response from fex server $server\n" unless @r;
    die "$prg: server does not support FUPWATCH\n" if $features !~ /FUPWATCH/;
    $_ = shift @r;
    unless (/^HTTP.* 2/) {
      s:HTTP/[\d\. ]+::;
      die "$prg: server response: $_\n";
    }
    while (<$SH>) {
      warn "<-- $_" if $opt_v;
      if (/^(\S+) (\S+) (\S+) (\w+) (\d+) (".*")$/) {
        printf "%s %d %s/fop/%s/%s %s\n",$1,$5,$psp,$4,$3,$6;
      }
    }
    die "$prg: server has closed the connection\n";
  }

  if ($command eq 'GENUKEY') {
    @r = formdatapost(
      from	=> $from,
      to	=> $from,
      command	=> $command,
    );
    die "$prg: no response from fex server $server\n" unless @r;
    $_ = shift @r;
    unless (/^HTTP.* 2/) {
      s:HTTP/[\d\. ]+::;
      die "$prg: server response: $_\n";
    }
    if (grep /^Content-Type: text\/html/,@r) {
      die "$prg: no $command support on $server:$port\n";
    }
    my $ukey = '';
    while (shift @r) {
      $ukey = $1 if /^X-UKEY: (\w+)/;
    }
    $ukey ||= shift @r;
    if ($ukey) {
      if ($ukey =~ /_$/) {
        # xxx / xup
        print "FUP=$psp/fup?ukey=$ukey\n";
        exit;
      }
      if ($ENV{FUA} =~ /fexpack/) {
        print "# upload URL and bash function for copy&paste\n";
        print "# upload key is valid for one day!\n";
        print "FUP=$psp/fup?ukey=$ukey\n";
        print
          'fup(){ ',
          'local a t;',
          'a=$(basename "$1");',
          '[ -r "$1" ]||{ echo "usage: fup FILE...";return; };',
          '[ -z "$2" ]||{ echo -n "archive name: ";read a; };',
          't="${TMPDIR:-/tmp}/fup_$a.tar";',
          'echo $t:;',
          'tar cvf "$t" "$@"&&curl',
          ' -F "keep=1"',
          ' -F "comment=[$(logname)@$(hostname)]"',
          ' -F "file=@$t"',
          ' $FUP|cat;',
          'rm "$t";',
      } else {
        print "# upload URL and bash function for others to send you files\n";
        print "# upload key is valid for one day!\n";
        print "FUP=$psp/fup?ukey=$ukey#$from\n";
        print 'fup(){ ';
        if ("@ARGV" eq '+' or ${'opt_+'}) {
          print
            'local a t c;',
            'a=$(basename "$1");',
            '[ -r "$1" ]||{ echo "usage: fup FILE...";return; };',
            '[ -z "$2" ]||{ echo -n "archive name: ";read a; };',
            'echo -n "comment: ";read -e c;',
            't="${TMPDIR:-/tmp}/fup_$a.tar";',
            'echo $t:;',
            'tar cvf "$t" "$@"&&curl',
            ' -F "comment=[$(logname)@$(hostname)] $c"',
            ' -F "file=@$t"',
            ' $FUP|cat;',
            'rm "$t";',
        } else {
          print
            '[ -f "$1" ]&&{ printf "comment: ";read -e c;',
            'curl -F "file=@$1" "$FUP?comment=$c"|cat;}||',
            '{ echo usage: fup FILE;};',
        }
      }
      print "};fup\n";
    } else {
      die "$prg: no UKEY reply from $server\n";
    }
    exit;
  }

  if ($command =~ /^GENOKEY:\S/) {
    @r = formdatapost(
      from	=> $from,
      to	=> $from,
      command	=> $command,
    );
    die "$prg: no response from fex server $server\n" unless @r;
    $_ = shift @r;
    unless (/^HTTP.* 2/) {
      s:HTTP/[\d\. ]+::;
      die "$prg: server response: $_\n";
    }
    unless (grep /^Content-Type: text\/plain/,@r) {
      die "$prg: no $command support on $server:$port\n[@r]";
    }
    foreach (@r) {
      if (/okey=/) {
        print "$_\n";
        exit;
      }
    }
    die "$prg: no okey in server reply\n";
  }

  if ($command eq 'LISTSHARE') {
    if ("@ARGV" =~ /^(\S+):share=(\S+)$/) {
      $owner = $1;
      $share = $2;
    } else {
      die "usage: $prg -~ LISTSHARE OWNER:share=SHARE\n"
    }
    @r = formdatapost(
      from	=> $from,
      to	=> "@ARGV",
      command	=> $command,
    );
    die "$prg: no response from fex server $server\n" unless @r;
    $_ = shift @r;
    unless (/^HTTP.* 2/) {
      s:HTTP/[\d\. ]+::;
      die "$prg: server response: $_\n";
    }
    if (grep /^Content-Type: text\/html/,@r) {
      die "$prg: no archive sharing support on $server:$port\n";
    }
    # skip HTTP header
    while (shift @r) { }
    my $sx = '';
    if ($pkey) {
      $sx = md5_hex("$1:$pkey") if $id =~ /^MD5H:(\w+)/;
    } else {
      $sx = md5_hex("$1:$id") if $sid =~ /^MD5H:(\w+)/;
    }
    foreach my $line (@r) {
      if ($line =~ /^(\S+):owner:-$/) {
        $owner = $1;
        next;
      } elsif ($line =~ /^(\S+\@\S+):([a-z]+):(\w+)$/) {
        my $suser = $1;
        my $access = $2;
        my $pkey = $3;
        $pkey = pack('H*',$pkey) ^ $sx if $sx;
        $line = "$psp/fas/$owner/$share/$suser/$pkey (access=$access)";
      } elsif ($line =~ s/^((\S+) (\S+)(.*\" ))(\w+)$/$1/) {
        $archive = $2;
        $avt = $3;
        $dkey = $5;
        $dkey = pack('H*',$dkey) ^ substr($sx,0,8) if $sx;
        $line .= sprintf "%s/fop/%s/%s_%s",$psp,$dkey,$archive,$avt;
      }
      print $line,"\n";
    }
    exit;
  }

  if ($command eq 'LISTSHARES') {
    @r = formdatapost(
      from	=> $from,
      command	=> $command,
    );
    die "$prg: no response from fex server $server\n" unless @r;
    $_ = shift @r;
    unless (/^HTTP.* 2/) {
      s:HTTP/[\d\. ]+::;
      die "$prg: $server response: $_\n";
    }
    if (grep /^Content-Type: text\/html/,@r) {
      die "$prg: no archive sharing support on $server:$port\n";
    }
    # skip HTTP header
    while (shift @r) { }
    foreach (@r) { print "$_\n" }
    exit;
  }

  if ($command =~ /^SHAREUSER:(\S+\@[\w.-]+):[a-z]+$/) {
    my $suser = $1;
    if ("@ARGV" =~ /^(\S+):share=(\S+)$/) {
      $owner = $1;
      $share = $2;
    } else {
      die "usage: $prg -~ SHAREUSER:USER:ACCESS OWNER:share=SHARE\n"
    }
    @r = formdatapost(
      from	=> $from,
      to	=> "@ARGV",
      command	=> $command,
    );
    die "$prg: no response from fex server $server\n" unless @r;
    $_ = shift @r;
    unless (/^HTTP.* 2/) {
      s:HTTP/[\d\. ]+::;
      die "$prg: $server response: $_\n";
    }
    if (grep /^Content-Type: text\/html/,@r) {
      die "$prg: no archive sharing support on $server:$port\n";
    }
    my $sx = '';
    if ($pkey) {
      $sx = md5_hex("$1:$pkey") if $id =~ /^MD5H:(\w+)/;
    } else {
      $sx = md5_hex("$1:$id") if $sid =~ /^MD5H:(\w+)/;
    }
    # skip HTTP header
    while (shift @r) { }
    $_ = shift @r;
    if (s/^pkey=//) {
      if (/MD5H:(\w+)/) {
        $pkey = pack('H*',$1) ^ $sx;
      } else {
        $pkey = $_;
      }
      print "$psp/fas/$owner/$share/$suser/$pkey\n";
    } else {
      print "$_\n";
    }
    exit;
  }

  if ($command =~ /^COPYARCHIVE:\S+:\S+:\S+:\S+:\S+/) {
    if ("@ARGV" =~ /^(\S+)$/) {
      $from = $1;
    } else {
      die "usage: $prg -~ COPYARCHIVE:SHARE:ARCHIVE:VERSION.CONTAINER:NEWSHARE:NEWARCHIVE OWNER\n";
    }
    @r = formdatapost(
      from	=> $from,
      to	=> $from,
      command	=> $command,
    );
    die "$prg: no response from fex server $server\n" unless @r;
    $_ = shift @r;
    unless (/^HTTP.* 2/) {
      s:HTTP/[\d\. ]+::;
      die "$prg: $server response: $_\n";
    }
    if (grep /^Content-Type: text\/html/,@r) {
      die "$prg: no archive sharing support on $server:$port\n";
    }
    while (@r) {
      $_ = shift @r;
      last if /^$/;
    }
    print "$_\n" foreach @r;
    exit;
  }

  if ($command =~ /^DOX(SYNC|DEL|LIST):./ or $command eq 'DOXLIST') {
    # die "$prg: fexserver does not support DOX\n" if $features !~ /DOX/;
    @r = formdatapost(
      from	=> $from,
      command	=> $command,
    );
    die "$prg: no response from fex server $server\n" unless @r;
    $_ = shift @r;
    unless (/^HTTP.* 2/) {
      s:HTTP/[\d\. ]+::;
      die "$prg: $server response: $_\n";
    }
    unless (/^HTTP.* 222/) {
      die "$prg: no DOX support on $server\n";
    }
    while (<$SH>) {
      warn "<-- $_" if $opt_v;
      if ($command =~ /DOXSYNC/) {
        s/^\s+//;
      } elsif ($command eq 'DOXLIST') {
        if (/^(\d+) (\d+) (.+)/) {
          my @d = localtime($1);
          $_ =  sprintf("%d-%02d-%02d %02d:%02d:%02d %7d MB %s\n",
                        $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0],$2,$3);
        }
      }
      print;
    }
    exit;
  }

  die "$prg: unknown command $command\n";
}


sub query_settings {
  my (@r,$r);
  local $_;

  female_mode("query settings?") if $opt_F;

  if ($FEXID) {
    print "ID data from \$FEXID\n";
  } elsif (-f $idf) {
    print "ID data from $idf\n";
  } else {
    die "$prg: found no ID\n";
  }
  print "server: $fexcgi\n";
  print "user: $from\n";
  print "auth-ID: $id\n";
  print "login URL: ";
  &show_URL;

  @r = formdatapost(
    from	=> $from,
    to		=> $from,
    id		=> $sid,
    command	=> $command,
  );
  die "$prg: no response from fex server $server\n" unless @r;
  $_ = shift @r;
  unless (/^HTTP.* 2/) {
    s:HTTP/[\d\. ]+::;
    die "$prg: server response: $_\n";
  }
  if (($_) = grep(/^X-Autodelete/,@r) and /:\s+(\w+)/) {
    print "autodelete: $1\n";
  }
  if (($_) = grep(/^X-Default-Keep/,@r) and /(\d+)/) {
    print "default keep: $1 days\n";
  }
  if (($_) = grep(/^X-Default-Keep-Archives/,@r) and /(\d+)/) {
    print "default archive keep: $1 days\n";
  }
  if (($_) = grep(/^X-Default-Locale/,@r) and /:\s+(\w+)/) {
    print "default locale: $1\n";
  }
  if (($_) = grep(/^X-MIME/,@r) and /:\s+(\w+)/) {
    print "display file with browser: $1\n";
  }
  if (($_) = grep(/^X-Sender-Quota/,@r) and /(\d+)\s+(\d+)/) {
    print "sender quota (used): $1 ($2) MB\n";
  } else {
    print "sender quota: unlimited\n";
  }
  if (($_) = grep(/^X-Recipient-Quota/,@r) and /(\d+)\s+(\d+)/) {
    print "recipient quota (used): $1 ($2) MB\n";
  } else {
    print "recipient quota: unlimited\n";
  }
}


# list spool
sub list {
  my (@r,$r);
  my ($data,$dkey,$to);
  my $n = 0;
  my $s = 1;
  my $a = shift @ARGV || '@';
  local $_;

  female_mode("list spooled files?") if $opt_F;

  if ($opt_l) {
    if ($a =~ /^\d+$/) {
      open $fexlist,$fexlist or die "$prg: $fexlist - $!\n";
      while (<$fexlist>) {
        if (/#(\d+) (\w+) (.+)/ and $1 eq $a) {
          serverconnect($server,$port) unless $SH;
          sendheader(
            "$server:$port",
            "GET $proxy_prefix/fop/$2/$2?LIST HTTP/1.1",
          );
          $_ = <$SH>||'';
          s/\r//;
          warn "<-- $_" if $opt_v;
          if (/^HTTP.* 200/) {
            warn "<-- $_" if $opt_v;
            while (<$SH>) {
              s/\r//;
              if (/^\n/) {
                print;
                print while <$SH>;
              }
            }
          } elsif (s:HTTP/[\d\. ]+::) {
            die "$prg: server response: $_";
          } else {
            die "$prg: no response from fex server $server\n";
          }
          exit;
        }
      }
      die "$prg: file \#$a not found in fexlist\n";
    }
  }

  @r = formdatapost(
    from	=> $from,
    to		=> $opt_l ? '*' : $from,
    command	=> $command,
  );
  die "$prg: no response from fex server $server\n" unless @r;
  $_ = shift @r;
  unless (/^HTTP.* 200/) {
    s:HTTP/[\d\. ]+::;
    die "$prg: server response: $_\n";
  }

  # list sent files
  if ($opt_l) {
    open $fexlist,'>',$fexlist or die "$prg: cannot write $fexlist - $!\n";
    foreach (@r) {
      last if m:</pre>:;
      next unless /<pre>/ or $data;
      $data = 1;
      if (/<a href=".*dkey=(\w+).*?">/) { $dkey = $1 }
      else                              { $dkey = '' }
#     $_ = decode_utf8($_);
#      $_ = locale($_);
      s/<.*?>//g;
      s/&quot;/\"/g;
      s/&lt;/</g;
      s/&amp;/&/g;
      if (/^(to (.+) :)/) {
        $to = $2;
        if ($a eq '.') {
          $s = $to eq $from ? 1 : 0;
        } elsif ($a eq '-') {
          $s = $to eq $from ? 0 : 1;
        } else {
          $s = $to =~ /$a/;
        }
        if ($opt_u) {
          s/to/for/;
          print "\n$_\n" if $s;
        } else {
          print "\n$_\n" if $s;
          print {$fexlist} "\n$_\n";
        }
      } elsif (s/.* (\d+) MB //) {
        my $size = $1;
        $n++;
        if ($s) {
          if ($opt_u and /( [+-] )(\S+)/) {
            my $file = $2;
            $file =~ s/[^\w.,@~^=+-]/_/g;
            printf "  %s/fop/%s/%s\n",$fexcgi,$dkey,$file;
          } else {
            printf "%4s %8d MB %s\n","#$n",$size,$_;
          }
        }
        printf {$fexlist} "%4s %s %s\n","#$n",$dkey,$_ unless $opt_u;
      }
    }
    close $fexlist;
  }

  # list received files
  if ($opt_L) {
    my $show = 1;
    my $user;
    foreach (@r) {
      s/&quot;/\"/g;
      s/&apos;/\'/g;
      s/&lt;/</g;
      s/&amp;/&/g;
      # locale must be english!
      if ($a eq '.' and /Files for (\S+)/) {
        # only files from = to = user
        $user = $1;
      }
      next unless /<pre>/ or $data;
      $data = 1;
      last if m:</pre>:;
      if (/(from (\S+) :)/) {
        if ($user) {
          $show = $2 eq $user ? 1 : 0;
        }
        print "\n$1\n" if $show;
      }
      if ($show and
          m{(\d+) (MB.*)<a href="(https?://.*/fop/\w+/.+)">(.+)</a>( ".*")?}) {
        printf "%8d %s%s%s\n",$1,$2,$3,($5||'');
      }
    }
  }
}


sub show_URL {
  printf "%s/fup/%s\n",$fexcgi,encode_b64("from=$from&id=$id");
}


sub get_log {
  my (@r);
  local $_;

  @r = formdatapost(
    from	=> $from,
    to		=> $from,
    id		=> $sid,
    command	=> $command,
  );
  die "$prg: no response from fex server $server\n" unless @r;
  $_ = shift @r;
  unless (/^HTTP.* 200/) {
    s:HTTP/[\d\. ]+::;
    die "$prg: server response: $_\n";
  }
  while (shift @r) {}
  foreach (@r) { print "$_\n" }
  exit;
}


sub show_address_book {
  my (%AB,@r);
  my $alias;
  local $_;

  %AB = query_address_book($server,$port,$from);
  foreach $alias (sort keys %AB) {
    next if $alias eq 'ADDRESS_BOOK';
    $_ = sprintf "%s = %s (%s) # %s\n",
                 $alias,
                 $AB{$alias},
                 $AB{$alias}->{options},
                 $AB{$alias}->{comment};
    s/ \(\)//;
    s/ \# $//;
    print;
  }
}


sub purge {
  die "$prg: not yet implemented\n";
}


sub delete_file_number {
  my ($to);

  while (@ARGV) {
    $opt_d = shift @ARGV;
    die "usage: $prg -d #\n" if $opt_d !~ /^\d+$/;

    open $fexlist,$fexlist or die "$prg: $fexlist - $!\n";
    while (<$fexlist>) {
      if (/^to (.+\@.+) :/) {
        $to = $1;
      } elsif (/#(\d+) (\w+) .*? [+-] (\S+)/ and $1 eq $opt_d) {
        delete_file_dkey($2,$3);
        last;
      }
    }
    close $fexlist;
    sleep 1; # do not overrun server
  }

  exit;
}


sub delete_file_url {
  if (scalar(@ARGV) != 1) {
    die "usage: $prg -d FEXURL\n";
  }
  if ("@ARGV" =~ m:^http.*/fop/(\w+)/(.+):) {
    delete_file_dkey($1,$2);
  } else {
    die "$prg: @ARGV is not a FEXURL\n";
  }
  exit;
}


sub delete_file_dkey {
  my ($dkey,$file) = @_;
  local $_;

  serverconnect($server,$port) unless $SH;
  query_sid($server,$port);
  sendheader(
    "$server:$port",
    "GET $proxy_prefix/fop/$dkey/$file?DELETE&id=$sid HTTP/1.1",
  );
  $_ = <$SH>||'';
  s/\r//;
  warn "<-- $_" if $opt_v;
  if (/^HTTP.* 200/) {
    while (<$SH>) {
      s/\r//;
      last if /^\n/; # ignore HTML output
      warn "<-- $_" if $opt_v;
      if (/^X-File: (.+)\/(.+)\/(.+)/) {
        if ($1 eq $2) {
          printf "%s deleted\n",decode_utf8(urldecode($3));
        } else {
          printf "%s for %s deleted\n",decode_utf8(urldecode($3)),$1;
        }
      }
    }
    undef $SH;
  } elsif (s:HTTP/[\d\. ]+::) {
    die "$prg: server response: $_";
  } else {
    die "$prg: no response from fex server $server\n";
  }
}


sub delete_file {
  my ($from,$to,$file) = @_;
  local $_;

  unless ($SH) {
    serverconnect($server,$port);
    query_sid($server,$port) unless $anonymous;
  }

  $to = $from if $to eq '.';

  $file = urlencode($file);
  sendheader(
    "$server:$port",
    "GET $proxy_prefix/fop/$to/$from/$file?id=$sid&DELETE HTTP/1.1",
  );

  while (<$SH>) {
    s/\r//;
    warn "<-- $_" if $opt_v;
    last if /^\s*$/;
  }
}


sub urlencode {
  local $_ = shift;
#  $_ = encode_utf8($_) if utf8::is_utf8($_);
# s/([^~^_:,;+*.!$#<>(){}\[\]\@\w\-])/'%'.uc(unpack("H2",$1))/ge;
  s/([^~^_:,;+*.!#\@\w\-])/'%'.uc(unpack("H2",$1))/ge;
  return $_;
}


sub send_fex {
  my @to;
  my $file = '';
  my @files = ();
  my ($data,$aname,$alias);
  my (@r,$r);
  my $t0 = time;
  my @transferfiles;
  my $vp = '\d{8}_\d{6}'; # fexpush version pattern
  local $_;

  if ($from =~ /^SUBUSER|GROUPMEMBER$/) {
    $to = '_';
  } else {
    # look for single @ in arguments
    for (my $i=1; $i<$#ARGV; $i++) {
      if ($ARGV[$i] eq '@') {
        $ARGV[$i] = join(',',@ARGV[$i+1 .. $#ARGV]);
        $#ARGV = $i;
        last;
      }
    }
    $to = pop @ARGV or die $usage;
    if ($to eq '.' or $to eq '+') {
      $nomail ||= $to;
      $opt_M ||= $to;
    }
    if ($to eq ':') {
      $to = $from;
      $nomail = $opt_C ||= 'NOMAIL';
    }
    if ($opt_g and $to =~ /,/) {
      die "$prg: encryption is supported to only one recipient\n";
    }
    if ($to =~ m{^https?://.*/fup\?skey=(\w+)}) {
      $from = 'SUBUSER';
      $to = '_';
      $id = $1;
    }
    if ($to =~ m{^https?://.*/fup\?gkey=(\w+)}) {
      $from = 'GROUPMEMBER';
      $to = '_';
      $id = $1;
    }
    if ($to =~ m{^https?://.*/fup\?to=(\S+)\?okey=(\w+)}) {
      $from = 'ONETIMEUSER';
      $to = $1;
      $id = $2;
    }
  }

  @to = split(',',$to);

  die $usage unless @ARGV or $opt_a or $opt_s;
  die $usage if $opt_s and @ARGV;

  if ($cygwin and scalar(@ARGV) == 1 and not $opt_a) {
    my $a = $ARGV[0];
    $opt_a = basename($a).'.zip' if -d $a;
  }

  if (not $opt_a and not $opt_d and scalar(@ARGV) == 1) {
    $_ = $ARGV[0];
    if (not -e and /(.+)\.(tar|tgz|zip|7z)$/ and -e $1) {
      @ARGV = ($1);
      s:.*/::;
      s/[^\w_.+-]/_/g;
      $opt_a = $_;
    }
  }

  if ($opt_a and scalar(@ARGV) == 1) {
    my $a = $ARGV[0];
    if (-d $a and $a !~ m:/$:) {
      my $dir = abs_path($a);
      @ARGV = (basename($dir));
      $dir = dirname($dir);
      chdir $dir or die "$prg: cannot cd $dir - $!\n";
      warn "\$ cd $dir\n" if $opt_v;
    }
  }

  if ($opt_a and not $opt_A) {
    my @A = ();
    foreach my $a (@ARGV) {
      if ($a eq '.') {
        push @A,glob('*');
      } elsif ($a =~ m:^\.|/\.:) {
        die "$prg: cannot send $a with option -a, use -A instead\n";
        push @A,glob('*');
      } else {
        push @A,$a;
      }
    }
    @ARGV = @A;
  }

  # early serverconnect necessary for X-Features info
  serverconnect($server,$port);

  if ($anonymous) {
    my $aok;
    sendheader("$server:$port","GET /SID HTTP/1.1");
    $_ = <$SH>||'';
    s/\r//;
    die "$prg: no response from fex server $server\n" unless $_;
    warn "<-- $_" if $opt_v;
    if (/^HTTP.* [25]01/) {
      while (<$SH>) {
        s/\r//;
        warn "<-- $_" if $opt_v;
        last unless /\w/;
        $aok = $_ if /X-Features:.*ANONYMOUS/;
      }
      die "$prg: no anonymous support on server $server\n" unless $aok;
    } else {
      die "$prg: bad response from server $server : $_\n";
    }
  } elsif ($public) {
  } else {

    query_sid($server,$port);

    if ($from eq 'SUBUSER') {
      $skey = $sid;
      # die "skey=$skey\nid=$id\nsid=$sid\n";
    }

    if ($from eq 'GROUPMEMBER') {
      $gkey = $sid;
    }

    if ($to eq '.' or $to eq '+') {
      # @to = ($from);
    } elsif ($to =~ /(.+):share=(.+)/) {
      $frecipient = $1;
      $share = $2;
    } elsif ($to =~ m:^(//.*):) {
      my $xkey = $1;
      if ($features =~ /XKEY/) {
        @to = ($from);
        $opt_C = $xkey;
      } else {
        die "$prg: server does not support XKEY\n";
      }
    } elsif (grep /^[^@]*$/,@to and not ($skey or $gkey or $okey or $share)) {
      %AB = query_address_book($server,$port,$from);
      if ($proxy) {
        serverconnect($server,$port);
        query_sid($server,$port);
      }
      foreach $to (@to) {
        # alias in local config?
        if ($alias{$to}) {
          if ($alias{$to} =~ /(.+?):(.+)/) {
            my $ato = $1;
            my $opt = $2;
            my @argv = @_ARGV;
            pop @argv;
            # special extra upload
            system $prg,split(/\s/,$opt),@argv,$ato;
            $to = '';
          } else {
            $to = $alias{$to};
          }
        }
        # alias in server address book?
        elsif ($AB{$to}) {
          # do not substitute alias with expanded addresses because then
          # keep and autodelete options from address book will get lost
          # $to = $AB{$to};
        }
        # look for mutt aliases
        elsif ($to !~ /@/ and $to ne $from) {
          $to = get_mutt_alias($to);
        }
      }
    }

    $to = join(',',grep /./,@to) or exit;
    $share_ = $to =~ /:share=_$/;

    if (
      not ($skey or $gkey or $okey or $share)
      and $from ne $to
      and $to ne '.'
      and $to ne '+'
      and $features =~ /CHECKRECIPIENT/
      and $command !~ /^(DELETE|LIST|RECEIVEDLOG|SENDLOG|FOPLOG)$/
    ) {
      checkrecipient($from,$to);
      if ($proxy) {
        serverconnect($server,$port);
        query_sid($server,$port);
      }
    }
  }

  if (@ARGV > 1 and not ($opt_a or $opt_s or $opt_d)) {
    $opt_a = inputline("Archive name (name.tar, name.tgz or name.zip) or ".
                       "[ENTER] to send file for file:\n");
    $opt_a =~ s/^\s+//;
    $opt_a =~ s/\s+$//;
    $opt_a =~ s/\//_/g;
  }

  if ($macos and not $opt_a and -d "@ARGV") {
    my $dir = "@ARGV";
    my $qdir = shellquote($dir);
    if (`du -s $qdir` =~ /^(\d+)/ and $1 < 2**21) {
      $opt_a = "$dir.zip";
    } else {
      $opt_a = "$dir.tar";
    }
  }

  if ($opt_s) {
    $opt_s =~ s/^=//;
    $opt_s =~ s:.*/::;
    $opt_s =~ s/[^\w_.+-]/_/g;
    @files = ($opt_s);
  } elsif ($opt_a) {
    $opt_a =~ s/^=//;
    $opt_a =~ s:/+$::;
    if ($opt_a =~ /(.+)\.(zip|tar|tgz|taz|7z)$/) {
      $aname = $1;
      $atype = $2;
      # no file argument left?
      unless (@ARGV) {
        # use filename as archive name
        push @ARGV,$aname;
      }
      $aname =~ s:.*/::;
      $aname =~ s/[^\w_.+-]/_/g;
    } else {
      die "$prg: archive name must be one of ".
          "$opt_a.tar $opt_a.tgz $opt_a.taz $opt_a.zip\n";
    }
    if ("@ARGV" =~ /^\[(\S+)\]$/) {
      die "$prg: cannot read \"$1\"\n" unless -r $1;
    } else {
      foreach my $file (@ARGV) {
        die "$prg: cannot read \"$file\"\n" unless -l $file or -r $file;
      }
    }
    $opt_a =~ s:.*/::;
    $opt_a =~ s/[^\w_.+-]/_/g;
    $opt_a .= ".$atype" if $opt_a !~ /\.$atype$/;

    if (0 and $useragent !~ /\// and scalar(@ARGV) > 1) {
      # remove common path
      my $dir = dirname($ARGV[0]);
      foreach (@ARGV) {
        unless (/^\Q$dir\E\/./) {
          undef $dir;
          last;
        }
      }
      if (defined($dir) and chdir $dir) {
        @ARGV = grep { s:^\Q$dir\E\/::; } @ARGV;
      }
    }

    if ($useragent =~ /fexsync/) {
      if ($features !~ /CCCSYNC/) {
        die "$prg: fexserver does not support fexsync\n";
      }
      if ($opt_C =~/^DOX/ and $features !~ /DOX/) {
        die "$prg: fexserver does not support fexdox\n";
      }
    }

    if (${'opt_^'}) {
      nmtime(@ARGV);
      my @d = localtime $nmtime;
      my $dt .= sprintf("_%d%02d%02d_%02d%02d%02d",
                        $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
      $opt_a =~ s/(.+)\./$1$dt./;
    }

    $transferfile = "$fextmp/$opt_a";
    unlink $transferfile;
    if ($atype eq 'zip') {
      print "Making fex archive ($opt_a):\n" unless $opt_q;
      if ($windoof) {
        system(qw'7z a -tzip',$transferfile,@ARGV);
        @files = ($transferfile);
      } elsif ($macos and scalar(@ARGV) == 1) {
        ## ditto-zip is now handled by formdatapost()
        system 'true';
        @files = ($opt_a);
      } else {
        # zip archives must be < 2 GB, so split as necessary
        # @files = zipsplit($transferfile,@ARGV);
        # if (scalar(@files) == 1) {
        #  $transferfile = $files[0];
        #  $transferfile =~ s/_1.zip$/.zip/;
        #  rename $files[0],$transferfile;
        #  @files = ($transferfile);
        # }
        @files = zip($transferfile,@ARGV);
      }
      @transferfiles =  @files;
    } elsif ($atype eq '7z') {
      print "Making fex archive ($opt_a):\n" unless $opt_q;
      # http://www.7-zip.org/
      my @sz = qw'7z a -t7z';
      push @sz,'-mx0' if $opt_0 or not compressable(@ARGV);
      foreach my $x (split('#',$xlist)) { push @sz,"-xr!$x" }
      vsystem(@sz,$transferfile,@ARGV);
      @transferfiles = @files = ($transferfile);
    } elsif ($atype eq 'tar') {
      if ($windoof) {
        print "Making fex archive ($opt_a):\n" unless $opt_q;
        system(qw'7z a -ttar',$transferfile,@ARGV);
        @transferfiles = @files = ($transferfile);
      } else {
        ## tar is handled by formdatapost()
        # system(qw'tar cvf',$transferfile,@ARGV);
        @files = ($opt_a);
      }
    } elsif ($atype eq 'tgz') {
      if ($windoof) {
        die "$prg: archive type tgz not available, use tar, zip or 7z\n";
      } else {
        ## tgz is handled by formdatapost()
        # system(qw'tar cvzf',$transferfile,@ARGV);
        @files = ($opt_a);
      }
    } elsif ($atype eq 'taz') {
      if ($windoof) {
        die "$prg: archive type taz not available, use tar, zip or 7z\n";
      } else {
        ## taz is handled by formdatapost()
        @files = ($opt_a);
      }
    } else {
      die "$prg: unknown archive format \"$atype\"\n";
    }

    if (@transferfiles) {

      # error in making transfer archive?
      if ($?) {
        unlink @transferfiles;
        die "$prg: $! - aborting upload\n";
      }

      # maybe timeout, so make new connect
      if (time-$t0 >= $timeout) {
        serverconnect($server,$port);
        query_sid($server,$port) unless $anonymous;
      }

    }

  } else {

    unless (@ARGV) {
      if ($windoof) {
        &inquire;
      } else {
        die $usage;
      }
    }

    foreach (@ARGV) {
      my $file = $_;
      unless ($opt_d) {
        unless (-f $file) {
          if (-e $file) {
            die "$prg: \"$file\" is not a regular file, try option -a\n"
          } else {
            die "$prg: \"$file\" does not exist\n";
          }
        }
        die "$prg: cannot read \"$file\"\n" unless -r $file;
      }
      push @files,$file;
    }
  }

  if (${'opt_/'}) {
    foreach my $file (@files) {
      my @s = stat($file);
      unless (@s and ($s[2] & S_IROTH) and -r $file) {
        die "$prg: \"$file\" is not world readable\n";
      }
    }
  }

  my $nextfile = 0;
  foreach my $file (@files) {

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

    unless (-s $file or $opt_d or $opt_a or $opt_s) {
      die "$prg: cannot send empty file \"$file\"\n";
    }
    female_mode("send file $file?") if $opt_F;

    if (basename($file) =~ /^ARCHIVE_SHARES?$/ and $features !~ /\bFAS\b/) {
      die "$prg: server $server:$port has no archive sharing support\n";
    }

    @r = formdatapost(
      from		=> $from,
      to		=> $to,
      replyto		=> $opt_r,
      id		=> $sid,
      file		=> $file,
      keep		=> $opt_k,
      comment		=> $opt_C,
      command		=> $command,
      autodelete	=> $opt_D,
    );

    if ($opt_s) {
      if (@r) {
        if (($from eq $to or $to eq '.') and not $opt_q) {
          my $xxx = $useragent =~ /xxx/;
          foreach (@r) {
            if ($xxx and /Location: (http\S+)/) {
              my $url = $1;
              warn $_;
              if ($url =~ /xxx.bash/) {
                print "# copy this bash command to your other account to temporary\n";
                print "# install the F*EX clients (including xxx) with your F*EX ID\n";
                print "eval \$(wget -qO - $url)\n";
                exit;
              }
              if ($url =~ /($xn)/) {
                print "xxx $1\n";
                if ($ENV{opt_w}) {
                  if (/Location: .*\.txt$/) {
                    print "wget -qO- $url\n";
                  } elsif (/Location: .*\.gz$/) {
                    print "wget -qO- $url | gunzip\n";
                  }
                }
              }
            }
            if (/Location: (http.*\.gz$)/) {
              my $url = $1;
              if ($share_ and $url =~ /\/__$vp/) {
                print "wget -qO- $url | gunzip\n";
              }
            } elsif (/Location:/) {
              print;
            }
          }
        }
        exit;
      } else {
        die "$prg: no server response\n";
      }
    }

    if (not @r or not grep /\w/,@r) {
      die "$prg: no response from server\n";
    }

    next if "@r" eq '0';
    # already transfered
    if ("@r" =~ /^Location: (http.*)/) {
      foreach (@r) {
        print "Location: $1\n" if /^Location: (http.*)/;
      }
#      my $url = $1;
#      if ($useragent =~ /xxx/) {
#        if ($cygwin) {
#          print "Location: $url\n";
#        }
#        print "fexget $1\n";
#      } elsif ($useragent =~ /zip|autofex/ or $cygwin) {
#        print "Location: $url\n";
#      } else {
#        print "FOP=$url\n";
#        if ($url =~ /\.tar$/) {
#          print "wget -qO - \$FOP | tar -xvf -\n";
#        } elsif ($url =~ /\.(tgz|tar\.gz)$/) {
#          print "wget -qO - \$FOP | tar -xvzf -\n";
#        } elsif ($url =~ /\.tar\.bz2$/) {
#          print "FOP=$url\n";
#          print "wget -qO - \$FOP | bunzip2 | tar -xvf -\n";
#        } elsif ($url =~ m:.*/(.+):) {
#          print "rm -f $1; ";
#          print "wget -c \$FOP\n";
#        }
#      }
      next;
    }

    if ("@r" =~ /INTERNAL ERROR.*<pre>(.+)<\/pre>/s) {
      die "$prg: server error: $1\n";
    }

    if ($r[0] =~ /^HTTP.* 201 (.+)/) {
      print "$1\n";
      exit;
    }

    if (($r) = grep /^ERROR:/,@r) {
      if ($anonymous and $r =~ /purge it/) {
        die "$prg: file is already on server for $to - use another anonymous recipent\n";
      } elsif ($r =~ /timeout/i) {
        close $SH;
        retry("timed out");
      } else {
        $r =~ s/.*?:\s*//;
        $r =~ s/<.+?>//g;
        $r =~ s/^HTTP\/1.. \d+ //;
        die "$prg: server error: $r\n";
      }
    }
    unless ($opt_d) {
      if (scalar(@r) == 1) {
        die "$prg: server error: @r\n";
      } else {
        if ($r[0] !~ /HTTP.1.. 2/) {
          if ($r[0] =~ /HTTP.[\s\d.]+(.+)/) {
            die "$prg: server error: $1\n";
          } else {
            die "$prg: server error:\n".join("\n",@r)."\n";
          }
        }
      }
    }
    if ("@r" =~ /<h3>(.*?)</) {
      print "$1\n";
    }

    if ($useragent =~ /fexsync/) {
      if ($opt_C =~ /^DOX/) {
        foreach (@r) {
          print "$1\n" if /^Location: (.+)/;
        }
      }
      exit;
    }

    if ($opt_a !~ /^afex_\d+\.tar$/ and $file !~ /afex_\d+\.tar$/) {
      # print grep({s/^(X-Recipient:.*\((.+)\))/Parameters: $2\n/i} @r);
      my $nonot = 0;
      my $recipient = '';
      my @location = ();
      foreach (@r) {
        if ($useragent =~ /dox/) {
          if (/^(X-)?(Recipient: \S+)/i) {
            # $recipient = $2."\n";
          }
          if (m:^(X-)?(Location.*/dox/.*):i) {
            push @location,$2."\n";
          }
        } else {
          if (/^(X-)?(Recipient.*)/i) {
            $recipient = $2."\n";
            if (/notification=no/i) { $nonot = 1 }
            else                    { $nonot = 0 }
          }
          if (/^(X-)?(Location.*)/i) {
            push @location,$2."\n";
          }
        }
      }
      if ($from eq $to or $from =~ /^\Q$to\E@/i
          or $nomail or $anonymous or $nonot)
      {
        if ($id =~ /^PKEY:/) {
          $recipient =~ s/ \(.*//;;
          print $recipient;
        } else {
          print $recipient if $useragent !~ /xxx/;
          print @location  if $to ne '.' and $to ne '+';
        }
      }
      if (grep /\/__$vp/,@location) {
      } elsif ($to eq '.') {
        if ($useragent =~ /autofex|zip/) {
          print @location;
          exit;
        } elsif ($useragent =~ /xxx/) {
          if ("@location" =~ /(http\S+xxx_($xn)\S+)/) {
            print "xxx -o $2\n";
          }
          if ($ENV{opt_w}) {
            my $cmd;
            foreach (@location) {
              if (/(http\S+xxx_($xn)\S+)/) {
                my $url = $1;
                if ($url =~ /\.tar$/) {
                  print "FOP=$url\n";
                  $cmd = "wget -qO - \$FOP | tar -xvf -\n";
                } elsif ($url =~ /\.(tar\.gz|tgz)$/) {
                  print "FOP=$url\n";
                  $cmd = "wget -qO - \$FOP | tar -xvzf -\n";
                } elsif ($url =~ /.*\/(.+\.zip)$/) {
                  print "FOP=$url\n";
                  $cmd = "wget -c $url && unzip $1 && rm $1\n";
                } elsif ($url =~ /\.txt$/) {
                  $cmd = "wget -qO - $url\n";
                } else {
                  $cmd = "wget -c $url\n";
                }
              }
            }
            print $cmd;
          }
          exit;
        } elsif (@location) {
          print @location;
#          my $cmd;
#          foreach (@location) {
#            if (/(http.*\.(tar|tg(z))$)/) {
#              my $z = $3||'';
#              print "FOP=$1\n";
#              $cmd = "wget -qO - \$FOP | tar -xv$z -f -\n";
#            } elsif (m:(http.*/(.+)):) {
#              print "FOP=$1\n";
#              $cmd = "rm -f $2; wget \$FOP\n";
#            }
#          }
#          print $cmd;
        }
      } elsif ($share_) {
        print @location;
      }
      foreach (@r) {
        if (/<!-- %W: (.+) -->/) {
          $_ = $1;
          s/&lt;/</g;
          s/&gt;/>/g;
          warn "Warning: $_\n";
        }
      }
      print @location if $to eq '+';
    }
  }

  if (@r and $from =~ /^fexmaster@/ and $from ne $to and $to ne '.' and
      $useragent !~ m:/:)
  {
    foreach (@r) {
      print "$1\n" if /^X-(Recipient: .+)/;
      print "$1\n" if /^X-(Location: http.+)/;
    }
  }

  # delete transfer tmp file
  unlink $transferfile if $transferfile;
}


sub forward {
  my (@r);
  my ($to,$n,$dkey,$file,$req);
  my ($status,$fp);
  local $_;

  # look for single @ in arguments
  for (my $i=1; $i<$#ARGV; $i++) {
    if ($ARGV[$i] eq '@') {
      $ARGV[$i] = join(',',@ARGV[$i+1 .. $#ARGV]);
      $#ARGV = $i;
      last;
    }
  }

  # if ($windoof and not @ARGV) { &inquire }
  $to = pop @ARGV or die $usage;
  $to = $from if $to eq '.';
  if ($to !~ /@/ and $to ne $from) {
    $to = get_mutt_alias($to);
  }

  open $fexlist,$fexlist or die "$prg: $fexlist - $!\n";
  while (<$fexlist>) {
    if (/#(\d+) (\w+) .\s*\d+ d. ([+-] )?(.+)/ and $1 eq $opt_f) {
      $n = $1;
      $dkey = $2;
      $file = $4;
      if ($file =~ s/ "(.*)"$//) {
        $opt_C ||= $1 if $1 ne 'NOMAIL';
      }
      last;
    }
  }
  close $fexlist;

  unless ($n) {
    die "$prg: file #$opt_f not found in fexlist\n";
  }

  female_mode("forward file #$opt_f?") if $opt_F;

  serverconnect($server,$port);
  query_sid($server,$port);

  $req = "GET $proxy_prefix/fup?"
        ."from=$from&ID=$sid&to=$to&dkey=$dkey&command=FORWARD";
  $req .= "&comment=$opt_C"	if $opt_C;
  $req .= "&keep=$opt_k"	if $opt_k;
  $req .= "&autodelete=$opt_D"	if $opt_D;
  $req .= "&$opt_X"		if $opt_X;
  $req .= " HTTP/1.1";
  sendheader("$server:$port",$req);
  http_response();
  $fp = $file;
  $fp =~ s/[^\w_.-]/.+/g; # because of UTF8 filename
  $status = 1;
  while (<$SH>) {
    warn "<-- $_" if $opt_v;
    if (/copy-forwarded to/) {
      $status = 0;
      print;
    }
  }

  if ($status) {
    die "$prg: server failed, rerun command with option -v\n";
  }
  exit;
}


sub renotify {
  my (@r);
  my ($to,$n,$dkey,$file,$req,$recipient);
  local $_;

  die $usage if @ARGV;

  open $fexlist,$fexlist or die "$prg: $fexlist - $!\n";
  while (<$fexlist>) {
    if (/#(\d+) (\w+) .\s*\d+ d. (.+)/ and $1 eq $opt_N) {
      $n = $1;
      $dkey = $2;
      last;
    }
  }
  close $fexlist;

  unless ($n) {
    die "$prg: file #$opt_N not found in fexlist\n";
  }

  female_mode("resend notification for file #$opt_N?") if $opt_F;

  serverconnect($server,$port);
  query_sid($server,$port);

  $req = "GET $proxy_prefix/fup?"
        ."from=$from&ID=$sid&dkey=$dkey&command=RENOTIFY"
        ." HTTP/1.1";
  sendheader("$server:$port",$req);
  http_response();
  while (<$SH>) {
    s/\r//;
    warn "<-- $_" if $opt_v;
    last if /^\s*$/;
    if (/^X-Notify: (.+)\/(.+)\/(.+)/) {
      $recipient = $1;
      $file = $3;
    }
  }

  if ($file) {
    print "notification email for $file has been resent to $recipient\n";
  } else {
    if ($opt_v) {
      die "$prg: server failed\n";
    } else {
      die "$prg: server failed, rerun command with option -v\n";
    }
  }

  exit;
}


sub modify {
  my (@r);
  my ($n,$dkey,$file,$req);
  local $_;

  die $usage if @ARGV;
  die $usage unless $opt_C or $opt_k or $opt_D;

  open $fexlist,$fexlist or die "$prg: $fexlist - $!\n";
  while (<$fexlist>) {
    if ($opt_x =~ /^\d+$/) {
      if (/#(\d+) (\w+) .\s*\d+ d. . (.+)/ and $1 eq $opt_x) {
        $n = $1;
        $dkey = $2;
        $file = $3;
        $file =~ s/ "(.*)"$//;
        last;
      }
    } else {
      if (/#(\d+) (\w+) .\s*\d+ d. . (.+)/ and $2 eq $opt_x) {
        $n = $1;
        $dkey = $2;
        $file = $3;
        $file =~ s/ "(.*)"$//;
        last;
      }
    }
  }
  close $fexlist;

  unless ($n) {
    die "$prg: file #$opt_x not found in fexlist\n";
  }

  female_mode("modify file #$opt_x?") if $opt_F;

  serverconnect($server,$port);
  query_sid($server,$port);

  $req = "GET $proxy_prefix/fup?"
        ."from=$from&ID=$sid&dkey=$dkey&command=MODIFY";
  $req .= "&comment=$opt_C"	if $opt_C;
  $req .= "&keep=$opt_k"	if $opt_k;
  $req .= "&autodelete=$opt_D"	if $opt_D;
  $req .= " HTTP/1.1";
  sendheader("$server:$port",$req);
  http_response();
  while (<$SH>) {
    s/\n*$/\n/;
    warn "<-- $_" if $opt_v;
    print if /\Q$file/;
  }

  exit;
}


sub get_xx {
  my $transferfile = shift;
  my $ft = '';
  local $_;

  # get transfer file from FEX server
  unless ($SH) {
    serverconnect($server,$port);
    query_sid($server,$port);
  }

  xxget($from,$sid,$transferfile);

  # empty file?
  unless (-s $transferfile) {
    unlink $transferfile;
    exit;
  }

  if ($ft = `file $transferfile 2>/dev/null`) {
    if ($ft =~ /compressed/) {
      rename $transferfile,"$transferfile.gz";
      shelldo(ws("gunzip $transferfile.gz"));
    }
    $ft = `file $transferfile`;
  }
  # file command failed, so we look ourself into the file...
  elsif (open $transferfile,$transferfile) {
    read $transferfile,$_,4;
    close $transferfile;
    # gzip magic?
    if (/\x1F\x8B\x08\x00/) {
      rename $transferfile,"$transferfile.gz";
      shelldo(ws("gunzip $transferfile.gz"));
      # assuming tar
      $ft = 'tar archive';
    }
  }

  if ($ft =~ /tar archive/ and -t STDOUT) {
    rename $transferfile,"$transferfile.tar";
    $transferfile .= '.tar';
    if ($opt_q) {
      $_ = 'y';
    } else {
      print "Files in transfer-container:\n\n";
      shelldo(ws("tar tvf $transferfile"));
      print "\nExtract these files? [Yn] ";
      $_ = <STDIN>;
    }
    if (/^n/i) {
      print "keeping $transferfile\n";
    } else {
      my $untar = "tar xvf";
      # if ($> == 0 and `tar --help 2>&1` =~ /gnu/) {
      #  $untar = "tar --no-same-owner -xvf";
      # }
      vsystem("$untar $transferfile && rm $transferfile");
      die "$prg: error while untaring, see $transferfile\n" if -f $transferfile;
    }
  } else {
    exec 'cat',$transferfile;
  }
  exit;
}


sub formdatapost {
  my %P = @_;
  my ($boundary,$filename,$length,$buf,$file,$fpsize,$resume,$seek,$nettest);
  my ($flink);
  my (@hh,@hb,@r,@pv,$to);
  my ($bytes,$tbytes,$b,$t,$bt);
  my ($t0,$t1,$t2,$tt,$tc);
  my $readahead;	# flag if pipe is read ahead
  my $bs = 2**16;	# blocksize for reading and sending file
  my $fileid = int(time);
  my $chunk = 0;
  my $filesize = 0;
  my $connection = '';
  my $pct = '';
  my $dittodir = '.';
  my ($tar,$ditto,$aname,$atype,$list,$error,$location,$checkrecipient);
  local $_;

  $_ = $P{command}||'';
  $checkrecipient = $_ if /CHECKRECIPIENT/i;

  if (defined($file = $P{file})) {

    $to = $AB{$P{to}} || $P{to}; # for gpg

    if ($_ = $P{comment}) {
      $_ = encode_utf8($_);
      s/%/%25/g;
      s/([^ -~])/urlencode($1)/eg;
      $P{comment} = $_;
    }

    # special file: stream from STDIN
    if ($opt_s) {
      $filename = encode_utf8($file);
      $filesize = -1;
    } elsif (not $opt_a) {
      # $opt_c and $opt_g are no longer active, because cannot resume
      if ($opt_c) {
        my ($if,$of);
        $if = shellquote($file);
        $transferfile = $fextmp . '/' . basename($file) . '.gz';
        $of = shellquote($transferfile);
        shelldo("gzip <$if>$of");
        $filesize = -s $transferfile;
        die "$prg: cannot gzip \"$file\"\n" unless $filesize;
        $file = $transferfile;
      } elsif ($opt_g) {
        my ($if,$of);
        $if = shellquote($file);
        $transferfile = $fextmp . '/' . basename($file) . '.gpg';
        $of = shellquote($transferfile);
        shelldo("gpg -e -r $to <$if>$of");
        $filesize = -s $transferfile;
        die "$prg: cannot gpg \"$file\"\n" unless $filesize;
        $file = $transferfile;
      }
    }

    # special file: tar-on-the-fly
    if (not $windoof and $opt_a and $file =~ /(.+)\.(tar|tgz|taz)$/) {
      $aname = $1;
      $atype = $2;
      $list  = "$fextmp/$aname.list";
      $error = "$fextmp/$aname.error";
      $tar = 'tar -c';
      $tar .= 'v' unless $opt_q;
      if (-t STDOUT and not $opt_q and
          `tar --help 2>/dev/null` =~ /--index-file/)
      { $tar .= " --index-file=$list" }
      foreach my $x (split('#',$xlist)) {
        if ($x eq '.') {
          $tar .= " --exclude='.*'";
        } else {
          $x =~ s/\'/\\\'/g;
          $tar .= " --exclude='$x'";
        }
      }
      $tar .= " -f-";
      if ("@ARGV" =~ /^\[(\S+)\]$/) {
        # [fileslist]
        $tar .= ' -T '.shellquote($1);
      } else {
        foreach (@ARGV) {
          s:/+$::;
          $_ = '/' if /^$/;
          $tar .= ' '.shellquote($_);
        }
      }
      if ($atype eq 'taz') {
        if (compressable(@ARGV)) {
          $atype = 'tgz';
        } else {
          $atype = 'tar';
        }
        $opt_a =~ s/taz$/$atype/;
      }
      $tar =~ s/-cv/-cvz/ if $atype eq 'tgz';

      # print "calculating archive size... ";
      print "Making fex archive ($opt_a):\n" unless $opt_q;
      warn "\$ $tar\n" if $opt_v;
      open $tar,"$tar 2>$error|" or die "$prg: cannot run tar - $!\n";
      $t0 = int(time) if -t STDOUT;
      while ($b = read $tar,$_,$bs) {
        $filesize += $b;
        if ($t0) {
          $t1 = int(time);
          if (not $opt_q and -t STDOUT and $t1>$t0) {
            printf "Archive size: %d MB\r",int($filesize/MB);
            $t0 = $t1;
          }
        }
      }
      printf "Archive size: %d MB\n",int($filesize/MB) if -t STDOUT and not $opt_q;
      unless (close $tar) {
        $_ = '';
        if (open $error,$error) {
          local $/;
          $_ = <$error>;
          close $error;
        }
        unlink $list,$error;
        die "$prg: tar error:\n$_";
      }
      unlink $error;
      $file = "$aname.$atype";
      $filename = encode_utf8($file);
      undef $SH; # force reconnect (timeout!)
    }

    # special file: ditto-zip-on-the-fly
    # ditto: Can't archive multiple sources
    elsif ($macos and $opt_a and $file =~ /(.+)\.(zip)$/ and scalar(@ARGV) == 1)
    {
      $aname = $1;
      $atype = $2;
      $list  = "$fextmp/$aname.list";
      $error = "$fextmp/$aname.error";
      $ditto = 'ditto -c -k --sequesterRsrc --keepParent';
      if (-d "@ARGV" and "@ARGV" =~ m:^(.+)/(.+):) {
        $dittodir = $1;
        $file = $2;
        $file =~ s/([^\w\-\@\#%,.=+_:])/\\$1/g;
        $ditto .= ' '.$file;
      } else {
        foreach (@ARGV) {
          $file = $_;
          $file =~ s/([^\w\-\@\#%,.=+_:])/\\$1/g;
          $ditto .= ' '.$file;
        }
      }
      # print "calculating archive size... ";
      debug("cd $dittodir;$ditto -");
      open $ditto,"cd $dittodir;$ditto - 2>$error|"
        or die "$prg: cannot run ditto - $!\n";
      $t0 = int(time) if -t STDOUT;
      while ($b = read $ditto,$_,$bs) {
        $filesize += $b;
        if ($t0) {
          $t1 = int(time);
          if (not $opt_q and -t STDOUT and $t1>$t0) {
            printf "Archive size: %d MB\r",int($filesize/MB);
            $t0 = $t1;
          }
        }
      }
      printf "Archive size: %d MB\n",int($filesize/MB) if -t STDOUT and not $opt_q;
      unless (close $ditto) {
        $_ = '';
        if (-s $error and open $error,$error) {
          local $/;
          $_ = <$error>;
          close $error;
        }
        unlink $list,$error;
        die "$prg: ditto-zip error:\n$_";
      }
      unlink $error;
      $file = "$aname.$atype";
      $filename = encode_utf8($file);
      undef $SH; # force reconnect (timeout!)
    }

    elsif ($P{to} eq 'nettest') {
      $filename = $nettest = 'nettest';
      $filesize = $P{size};
      $fileid = 0;
    }

    # single file
    elsif (not $opt_s) {
      if (${'opt_^'} and my @s = stat $file) {
        my @d = localtime($s[9]);
        my $dt = sprintf('_%d%02d%02d_%02d%02d%02d',
                         $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
        ${'opt_='} = $file;
        ${'opt_='} =~ s/(.+?)\./$1$dt./ or ${'opt_='} .= $dt;
      }
      $filename = encode_utf8(${'opt_='} || $file);
      # $filename = urlencode($filename);

      if ($windoof) {
        $filename =~ s/^[a-z]://;
        $filename =~ s/.*\\//;
      }
      $filename =~ s:.*/::;
      $filename =~ s:[\r\n]+: :g;
      if ($opt_d) {
        $filesize = 0;
      } elsif (not $opt_s) {
        $filesize = -s $file or die "$prg: \"$file\" is empty or not readable\n";
      }
    }

    unless ($opt_d or $nettest) {
      if (0 and $opt_g) {
        $filesize = -1;
        $fileid = int(time);
      } else {
        if ($opt_a) {
          # index file?
          if ($tar and "@ARGV" =~ /^\[(\S+)\]$/) {
            my $if = $1;
            open $if,$if or die "$prg: cannot open $if - $!\n";
            while (<$if>) {
              chomp;
              push @ifiles,$_;
            }
            close $if;
            if (@ifiles) {
              $fileid = md5_hex(fmd(@ifiles));
            } else {
              $fileid = int(time);
            }
          } else {
            $fileid = md5_hex(fmd(@ARGV));
          }
        } elsif ($opt_s) {
          $fileid = randstring(32);
        } else {
          $fileid = fileid($file);
        }
      }
    }

  } else {
    $file = $filename = '';
    $filesize = 0;
  }

  FORMDATAPOST:

  @hh = (); # HTTP header
  @hb = (); # HTTP body
  @r = ();  # HTTP reply
  $seek = 0;
  $resume = '';
  $chunk++;

  if (not $SH or $transferfile) {
    serverconnect($server,$port);
    query_sid($server,$port) unless $anonymous or $nettest;
  }

  $P{id} = $sid; # ugly hack!

  $filename =~ s/\\/_/g; # \ is a illegal character for fexsrv

  if ($file and not $xx and not $nettest) {
    if ($opt_o and not $opt_d and $P{to} ne '+') {
      # delete before overwrite
      delete_file($from,$to,$filename);
      serverconnect($server,$port);
      query_sid($server,$port) unless $anonymous;
      $P{id} = $sid; # ugly hack!
    } elsif (not($opt_s or $opt_d or $opt_l or $opt_L or ${'opt_/'})) {
      # ask server if this file has been already sent
      ($seek,$location) = query_file($server,$port,
        $frecipient||$P{to},$P{from},$P{id},$filename,$fileid);
      $seek = 0 if $P{to} eq '+' and $opt_o;
      if ($filesize == $seek) {
        unlink $list if $list;
        if ($share) {
          warn "$prg: archive $file is already in share $share\n";
          exit;
        } else {
          warn "$prg: $file has been already transferred\n";
        }
        if ($location) {
          if ($nomail and not $pkey or $share_ or $P{from} eq $P{to}) {
            return "Location: $location\n";
          }
          if ($from =~ /^fexmaster@/) {
            print "Location: $location\n";
          }
          return 0;
        }
      } elsif ($seek and $seek < $filesize) {
        $resume = " (resuming at byte $seek)";
      } elsif ($filesize <= $seek) {
        $seek = 0;
      }
      if ($location and $P{to} eq '+') {
        print "Location: $location\n";
      }
    }
    if ($proxy) {
      sleep 1;    # do not overrun proxy
      serverconnect($server,$port);
    }
  }

  # file part size
  if ($chunksize and ($proxy and $port != 443 or not $proxy)
      and $filesize - $seek > $chunksize - $bs) {
    if ($features !~ /MULTIPOST/) {
      die "$prg: server does not support chunked multi-POST\n";
    }
    $opt_o = 0; # no overwriting mode for next chunks
    $fpsize = $chunksize - $bs;
  } else {
    $fpsize = $filesize - $seek;
  }

  $boundary = randstring(48);

  $P{seek} = $seek;
  $P{filesize} = $filesize;
  $P{keep} = '00' if defined $P{keep} and $P{keep} eq '0';

  # send HTTP POST variables
  if ($skey) {
    $P{skey} = $skey;
    @pv = qw'from to skey keep autodelete comment seek filesize';
  } elsif ($gkey) {
    $P{gkey} = $gkey;
    @pv = qw'from to gkey keep autodelete comment seek filesize';
  } elsif ($okey) {
    $P{okey} = $okey;
    @pv = qw'from to okey keep autodelete comment seek filesize';
  } elsif ($pkey) {
    $P{pkey} = $sid;
    @pv = qw'from to pkey comment command seek filesize';
  } else {
    @pv = qw'from to id replyto keep autodelete comment command seek filesize';
  }
  foreach my $v (@pv) {
    if ($P{$v}) {
      my $name = uc($v);
      push @hb,"--$boundary";
      push @hb,"Content-Disposition: form-data; name=\"$name\"";
      push @hb,"";
      # push @hb,encode_utf8($P{$v});
      push @hb,$P{$v};
    }
  }

  # at last, POST the file
  if ($file) {
    push @hb,"--$boundary";
    push @hb,"Content-Disposition: form-data; ".
             qq'name="FILE"; filename="$filename"';
    unless ($opt_d) {
      if ($opt_M) { push @hb,"Content-Type: application/x-mime" }
      else        { push @hb,"Content-Type: application/octet-stream" }
      if (${'opt_/'}) {
        $flink = abs_path($file);
        push @hb,"Content-Location: $flink";
      } else {
        push @hb,"Content-Length: $fpsize"; # optional header! NOT filesize!
        push @hb,"X-File-ID: $fileid";
      }
      push @hb,"";
    }
    push @hb,"";
    # prevent proxy chunked mode reply
    $connection = "close";
  }

  push @hb,"--$boundary--";

  if ($fpsize < 0) {
    $length = $fpsize;
  } else {
    $length = length(join('',@hb)) + scalar(@hb)*2 + $fpsize;
  }

  if ($file and not $opt_d) {
    if ($flink) { $hb[-2] = $flink }
    else        { $hb[-2] = '(file content)' }
  }
  # any other extra URL arguments
  my $opt_X = '';
  $opt_X = "?LOCALE=english" if $P{command};
  $opt_X = "?$::opt_X" if $::opt_X and ($file or $checkrecipient);

  # HTTP header
  push @hh,"POST $proxy_prefix/fup$opt_X HTTP/1.1";
  push @hh,"Host: $server:$port";
  push @hh,"User-Agent: $useragent";
  push @hh,"Content-Length: $length";
  push @hh,"Content-Type: multipart/form-data; boundary=$boundary";
  push @hh,"Connection: $connection" if $connection;
  push @hh,'';

  $SIG{PIPE} = \&sigpipehandler;
#    foreach $sig (keys %SIG) {
#      eval '$SIG{$sig} = sub { print "\n!!! SIGNAL '.$sig.' !!!\n"; exit; }';
#    }

  if ($file) {
    pop @hb;
    pop @hb unless $flink;
    nvtsend(@hh,@hb) or do {
      warn "$prg: server has closed the connection, reconnecting...\n";
      sleep 3;
      undef $SH;
      goto FORMDATAPOST; # necessary: new $sid ==> new @hh
    };

    if ($opt_v and not $opt_d) {
      if ($flink) { warn "--> $flink\n" }
      else        { warn "--> (file content)\n" }
    }

    unless ($opt_d or $flink) {

      $t0 = $t2 = int(time);
      $tt = $t0-1;
      $t1 = 0;
      $tc = 0;

      if ($opt_s) {
        if ($opt_g) {
          open $file,"gpg -e -r $to|" or die "$prg: cannot run gpg - $!\n";
        } else {
          open $file,'>&=STDIN' or die "$prg: cannot open STDIN - $!\n";
        }
      } elsif ($tar) {
        unless ($readahead) {
          if ($opt_g) {
            warn "\$ $tar|gpg -e -r $to|\n" if $opt_v;
            open $file,"$tar|gpg -e -r $to|" or die "$prg: cannot run tar&gpg - $!\n";
          } else {
            warn "\$ $tar|\n" if $opt_v;
            open $file,"$tar|" or die "$prg: cannot run tar - $!\n";
          }
          if ($seek) {
            print "Fast forward to byte $seek (resuming)\n";
            readahead($file,$seek);
            $readahead = 1;
            # reconnect because of possible server timeout
            shutdown($SH,2);
            undef $SH;
            sleep 1;
            goto FORMDATAPOST; # necessary: new $sid ==> new @hh
          }
        }
      } elsif ($ditto) {
        unless ($readahead) {
          $ditto =~ s/ditto/ditto -V/;
          open $file,"cd $dittodir;$ditto -|" or die "$prg: cannot run ditto - $!\n";
          if ($seek and not $readahead) {
            print "Fast forward to byte $seek (resuming)\n";
            readahead($file,$seek);
            $readahead = 1;
            # reconnect because of possible server timeout
            shutdown($SH,2);
            undef $SH;
            sleep 1;
            goto FORMDATAPOST; # necessary: new $sid ==> new @hh
          }
        }
      } elsif ($nettest) {
        #
      } else {
        if ($opt_g and not $tar) {
          # my $fileq = shellquote($file);
          # open $file,"gpg -e -r $to <$fileq|" or die "$prg: cannot run gpg - $!\n";
          open $file,$file or die "$prg: cannot read \"$file\" - $!\n";
          seek $file,$seek,0;
        } else {
          open $file,$file or die "$prg: cannot read \"$file\" - $!\n";
          seek $file,$seek,0;
        }
        binmode $file;
      }

      $readahead = 0;
      $bytes = 0;
      $tbytes = $seek;

      autoflush $SH 0;

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

      $buf = '#' x $bs if $nettest;

      $SIG{ALRM} = sub { retry("timed out") };

      while ($bytes < $fpsize or $opt_s) {
        if ($nettest) {
          $b = $bs;
        } else {
          $b = read($file,$buf,$bs)||0;
          last if $b == 0;
        }
        alarm($timeout*2);
        if ($https) {
          print {$SH} $buf or &sigpipehandler;
        } else {
          syswrite $SH,$buf or &sigpipehandler;
        }
        alarm(0);
        $bytes += $b;
        $tbytes += $b;
        if (not $nettest and $filesize > 0 and $tbytes > $filesize) {
          die "$prg: \"$file\" filesize has grown while uploading\n";
        }
        $bt += $b;
        $t2 = time;
        if (${'opt_+'} and int($t2*10)>$tc) {
          print $rcamel[$tc%2+1];
          $tc = int($t2*10);
        }
        if (int($t2)>$t1) {
          &sigpipehandler unless $SH->connected;

          show_tarindex($list,$pct);

          if (not $opt_q and -t STDOUT) {
            # smaller block size is better on slow links
            $bs = 4096 if $t1 and $bs>4096 and $bytes/($t2-$t0)<65536;
            if ($filesize > 0) {
              $pct = sprintf "(%d%%)",int($tbytes/$filesize*100);
            }
            if ($tbytes>2*MB and $bs>4096) {
              printf STDERR "%s: %d MB of %d MB %s %d kB/s        \r",
                     $opt_s||$opt_a||$file,
                     int($tbytes/MB),
                     int($filesize/MB),
                     $pct,
                     int($bt/kB/($t2-$tt));
            } else {
              printf STDERR "%s: %d kB of %d MB %s %d kB/s        \r",
                     $opt_s||$opt_a||$file,
                     int($tbytes/kB),
                     int($filesize/MB),
                     $pct,
                     int($bt/kB/($t2-$tt));
            }
          }

          $t1 = $t2;
          # time window for transfer rate calculation
          if ($t2-$tt>10) {
            $bt = 0;
            $tt = $t2;
          }
        }
        last if $filesize > 0 and $bytes >= $fpsize;
        sleep 1 while ($opt_m and $bytes/kB/(time-$t0||1) > $opt_m);
      }

      show_tarindex($list,$pct);

      warn "\n--> --$boundary--\n" if $opt_v;

      $tt = ($t2-$t0)||1;

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

      if ($useragent !~ /fexsync/ and not $opt_s and $fileid =~ /[a-z]/) {
        if ($opt_a) {
          my @files = @ARGV;
          @files = @ifiles if @ifiles;
          if ($fileid ne md5_hex(fmd(@files))) {
            print "\n" unless $opt_q;
            die "$prg: files have been modified while uploading\n";
          }
        } else {
          if ($fileid ne fileid($file)) {
            print "\n" unless $opt_q;
            die "$prg: file has been modified while uploading\n";
          }
        }
      }

      if (not $chunksize and $tbytes < $filesize and $useragent !~ /fexsync/) {
        die "$prg: \"$file\" filesize has shrunk while uploading\n";
      }

      unless ($opt_q) {
        if ($seek or $chunksize and $chunksize < $filesize) {
          if ($fpsize>2*MB) {
            printf STDERR "%s: %d MB in %d s = %d kB/s",
                           $opt_s||$opt_a||$file,
                           int($bytes/MB),
                           int($tt)||1,
                           int($bytes/kB/$tt)||1;
            if ($tbytes == $filesize) {
              printf STDERR ", total %d MB\n",int($filesize/MB);
            } else {
              printf STDERR ", chunk #%d : %d MB\n",
                            $chunk,int($tbytes/MB);
            }
          } else {
            printf STDERR "%s: %d kB in %d s = %d kB/s",
                          $opt_s||$opt_a||$file,
                          int($bytes/kB)||1,
                          int($tt)||1,
                          int($bytes/kB/$tt)||1;
            if ($tbytes == $filesize) {
              printf STDERR ", total %d kB\n",int($filesize/kB)||1;
            } else {
              printf STDERR ", chunk #%d : %d kB\n",
                            $chunk,int($tbytes/kB)||1;
            }
          }
        } else {
          if ($tbytes>2*MB) {
            printf STDERR "%s: %d MB in %d s = %d kB/s          \n",
                          $opt_s||$opt_a||$file,
                          int($bytes/MB),
                          int($tt)||1,
                          int($bytes/kB/$tt)||1;
          } else {
            printf STDERR "%s: %d kB in %d s = %d kB/s          \n",
                          $opt_s||$opt_a||$file,
                          int($bytes/kB)||1,
                          int($tt)||1,
                          int($bytes/kB/$tt)||1;
          }
        }
      }
    }

    autoflush $SH 1;
    print {$SH} "\r\n--$boundary--\r\n";
    # return if $nettest;

    # special handling of streaming file because of stunnel tcp shutdown bug
    if ($opt_s or 0 and $opt_g) {
      print "waiting for server response" if -t STDOUT and not $opt_q;
      for (1..3) {
        shutdown($SH,2);
        close $SH;
        sleep 2;
        print "." if -t STDOUT and not $opt_q;
        serverconnect($server,$port);
        query_sid($server,$port) unless $anonymous;
        ($seek,$location) =
          query_file($server,$port,$P{to},$P{from},$sid,$filename,$fileid);
        if ($seek == $bytes) {
          print "\r                              \r" if -t STDOUT and not $opt_q;
          return "Location: $location\n";
        }
      }
      if ($location) {
        die "$prg: streamed $bytes bytes but server received $seek bytes\n";
      }
      print "\r                              \r" if -t STDOUT and not $opt_q;
      return '';
    }

    if ($flink) {
      $bytes = -s $flink;
      if ($bytes>2*MB) {
        printf STDERR "%s: %d MB\n",$flink,int($bytes/MB);
      } else {
        printf STDERR "%s: %d kB\n",$flink,int($bytes/kB);
      }
    }
  } else {
    autoflush $SH 1;
    nvtsend(@hh,@hb) or die "$prg: server has closed the connection\n";
  }

  # SuSe: Can't locate object method "BINMODE" via package "IO::Socket::SSL::SSL_HANDLE"
  # binmode $SH,':utf8';

#  if (not $opt_q and $file and -t STDOUT) {
#    print STDERR "\r                         \r";
#  }


  my $cl = '';
  if (-t STDOUT and not ($opt_s or $nettest) or $useragent =~ /fexsync/) {
    unless ($opt_q) {
      print STDERR "waiting for server ok...";
      $cl =      "\r                         \r";
    }
  }
  while (<$SH>) {
    s/[\r\n]+//g;
    print STDERR $cl; $cl = '';
    warn "<-- $_\n" if $opt_v;
    if (@r) {
      last if $r[0] =~ / (204|222) / and /^$/ or /<\/html>/i;
      last if /^$/ and grep /^Connection: close/,@r and grep /^X-Location/,@r;
    }
    push @r,decode_utf8($_);
  }
  print STDERR $cl; $cl = '';

  if ($file) {
    close $SH;
    undef $SH;
    if ($chunksize and $tbytes < $filesize) {
      if ($sleepwait) {
        my $wait = $sleepwait;
        while ($wait) {
          print STDERR "next connect in $wait s  \r" if -t STDOUT;
          sleep 1;
          $wait--;
        }
      }
      $readahead = 1;
      goto FORMDATAPOST;
    }
    close $file if fileno $file; # unless $nettest or $opt_d or $flink;

  }

  return @r;
}


sub show_tarindex {
  my $list = shift;
  my $pct = shift;
  my $nl = '';
  local $_;

  if ($list) {
    unless (fileno $list) {
      open $list,$list and unlink $list;
    }
    if (fileno $list) {
      $nl = "\n" if $pct;
      while (<$list>) {
        print $nl,$_;
        $nl = '';
      }
    }
  }
}


sub randstring {
    my $n = shift;
    my @rc = ('A'..'Z','a'..'z',0..9 );
    my $rn = @rc;
    my $rs;

    for (1..$n) { $rs .= $rc[int(rand($rn))] };
    return $rs;
}


sub zip {
  no strict 'refs';
  my $zip = shift;
  my $du = 0;
  my ($cmd);
  my @q;
  local $_;

  warn "\$ find -type f @_\n" if $opt_v;
  if (not $opt_q and open my $F,'-|','find',@_,qw'-type f') {
    my $xp = '';
    foreach my $x (split('#',$xlist)) {
      if ($x eq '.') {
        $xp .= '|.*/\.';
      } else {
        $x = quotemeta $x;
        $x =~ s/\\\?/./g;
        $x =~ s/\\\*/.*/g;
        $xp .= "|$x|.*/$x";
      }
    }
    $xp =~ s/.//;
    while (<$F>) {
      chomp;
      unless ($xp and /^$xp$/) {
        $du += -s;
      }
    }
    close $F;
    $du = int($du/1024/1024);
    print "$du MB\n";
    if ($du >= 2048) {
      print "zip cannot handle more than 2 GB correctly, better use 7z\n";
      print "continue anyway? ";
      $_ = <STDIN>||'';
      exit 1 if /^n/i;
    }
  }

  unlink $zip;
  # if ($opt_c) { $cmd = "zip -@ $zip" }
  # else        { $cmd = "zip -0 -@ $zip" }
  $cmd = "zip -r -y -@ $zip -x";
  $cmd =~ s/ / -0 / if $opt_0 or not compressable(@_);
  foreach my $x (split('#',$xlist)) {
    if ($x eq '.') {
      $cmd .= " '*/.*' '*/.*/*'";
    } else {
      $x =~ s/\'/'"\'"'/g;
      $cmd .= " '$x' '*/$x' '*/$x/*'";
    }
  }
  warn "\$ $cmd\n" if $opt_v;
  open $cmd,"|$cmd" or die "$prg: cannot create $zip - $!\n";
  foreach (@_) {
    print {$cmd} $_."\n";
    warn "  $_\n" if $opt_v;
  }
  close $cmd or warn "$prg: zip failed - $!\n";

  return $zip;
}


sub getline {
  my $file = shift;
  local $_;

  while (<$file>) {
    chomp;
    s/^#.*//;
    s/\s+#.*//;
    s/^\s+//;
    s/\s+$//;
    return $_ if length($_);
  }
  return '';
}


sub query_file {
  my ($server,$port,$to,$from,$qid,$filename,$fileid) = @_;
  my ($head,$response,$fexsrv,$cc);
  my $seek = 0;
  my $qfileid = '';
  my $location = '';
  local $_;

  $to =~ s/[,:].*//;
  $to = $AB{$to} if $AB{$to};
  $to = $from if $to eq '.';
  $filename = urlencode($filename);
  if ($skey) {
    $head = "HEAD $proxy_prefix/fop/$to/$from/$filename??SKEY=$qid HTTP/1.1";
  } elsif ($gkey) {
    $head = "HEAD $proxy_prefix/fop/$to/$from/$filename??GKEY=$qid HTTP/1.1";
  } elsif ($okey) {
    $head = "HEAD $proxy_prefix/fop/$to/$from/$filename??OKEY=$qid HTTP/1.1";
  } elsif ($share) {
    my $qid = $pkey || $id;
    $head = sprintf "HEAD $proxy_prefix/fop/$to/$share/$from/%s/%s HTTP/1.1",
                    md5_hex("$filename:$qid"),$filename;
    # die "$filename:$qid\n$head";
  } else {
    $head = "HEAD $proxy_prefix/fop/$to/$from/$filename??ID=$qid HTTP/1.1";
  }
  sendheader("$server:$port",$head);
  $_ = <$SH>;
  unless (defined $_ and /\w/) {
    die "$prg: no response from server\n";
  }
  s/\r//;
  warn "<-- $_" if $opt_v;
  unless (/^HTTP.* 200/) {
    s:HTTP/[\d\. ]+::;
    $response = $_;
    while (<$SH>) {
      s/\r//;
      warn "<-- $_" if $opt_v;
      $fexsrv = $_ if /^(Server: fexsrv|X-Features:)/;
      last if /^\s*$/;
    }
    die "$prg: no fexserver at $server:$port\n" unless $fexsrv;
    chomp $response;
    if ($share) {
      die "$prg: no share support on $server:$port ($response)\n";
    } else {
      die "$prg: response from $server:$port : $response\n";
    }
  }
  while (<$SH>) {
    s/\r//;
    warn "<-- $_" if $opt_v;
    last if /^$/;
    if (/^Content-Length:\s+(\d+)/)	{ $seek = $1 }
    if (/^X-File-ID:\s+(.+)/)		{ $qfileid = $1 }
    if (/^X-Features:\s+(.+)/)		{ $features = $1 }
    if (/^X-Location:\s+(.+)/)		{ $location = $1 }
    if (/^Connection: close/)           { $cc = $_ }
  }

  # return true seek only if file is identified
  $seek = 0 if $qfileid and $qfileid ne $fileid;

  if ($cc) {
    serverconnect($server,$port);
    $sid = $id;
  }

  return ($seek,$location);
}


sub edit_address_book {
  my ($user) = @_;
  my $alias;
  my $ab = "$fexhome/ADDRESS_BOOK";
  my (%AB,@r);
  local $_;

  die "$prg: address book not available for subusers\n"      if $skey;
  die "$prg: address book not available for onetime users\n" if $okey;
  die "$prg: address book not available for group members\n" if $gkey;
  die "$prg: address book not available for share users\n"   if $pkey;

  unless (-t STDOUT) {
    &show_address_book;
    exit;
  }

  female_mode("edit your address book?") if $opt_F;

  %AB = query_address_book($server,$port,$user);
  if ($AB{ADDRESS_BOOK} !~ /\w/) {
    $AB{ADDRESS_BOOK} =
      "# Format: alias email-address # Comment\n".
      "# Example:\n".
      "framstag framstag\@rus.uni-stuttgart.de\n";
  }
  open $ab,">$ab" or die "$prg: cannot write to $ab - $!\n";
  print {$ab} $AB{ADDRESS_BOOK};
  close $ab;

  system "$editor $ab";
  exit unless -s $ab;

  $opt_o = $opt_A;

  serverconnect($server,$port);
  query_sid($server,$port);

  @r = formdatapost(
 	from		=> $user,
        to		=> $user,
        id		=> $sid,
        file		=> $ab,
  );

  unlink $ab,$ab.'~';
}


sub query_address_book {
  my ($server,$port,$user) = @_;
  my ($req,$alias,$address,$options,$comment,$cl,$ab,$b);
  my %AB;
  local $_;

  unless ($SH) {
    serverconnect($server,$port);
    query_sid($server,$port);
  }

  $req = "GET $proxy_prefix/fop/$user/$user/ADDRESS_BOOK?ID=$sid HTTP/1.1";
  sendheader("$server:$port",$req);
  $_ = <$SH>;
  unless (defined $_ and /\w/) {
    die "$prg: no response from server\n";
  }
  s/\r//;
  warn "<-- $_" if $opt_v;
  unless (/^HTTP.* 200/) {
    if (/^HTTP.* 404/) {
      while (<$SH>) { last if /^\r?\n/ }
      return;
    } else {
      # s:HTTP/[\d\. ]+::;
      # die "$prg: server response: $_";
      close $SH;
      undef $SH;
      return ();
    }
  }
  while (<$SH>) {
    s/\r//;
    warn "<-- $_" if $opt_v;
    last if /^$/;
    $cl = $1 if /^Content-Length: (\d+)/;
  }

  if ($cl) {
    while (<$SH>) {
      $b += length;
      $ab .= $_;
      s/[\r\n]//g;
      s/^\s+//;
      s/\s+$//;
      warn "<-- $_\n" if $opt_v;
      s/\s*#\s*(.*)//;
      if ($_) {
        $comment = $1||'';
        ($alias,$address,$options) = split;
        if ($address) {
          if ($options) { $options =~ s/[()]//g }
          else          { $options = '' }
          $AB{$alias} = $address;
          $AB{$alias}->{options} = $options||'';
          $AB{$alias}->{comment} = $comment||'';
          if ($options and $options =~ /keep=(\d+)/i) {
            $AB{$alias}->{keep} = $1;
          }
          if ($options and $options =~ /autodelete=(\w+)/i) {
            $AB{$alias}->{autodelete} = $1;
          }
        }
      }
      last if $b >= $cl;
    }
  }

  $AB{ADDRESS_BOOK} = $ab;

  return %AB;
}


# sets global $sid $features $timeout # ugly hack! :-}
sub query_sid {
  my ($server,$port) = @_;
  my ($req,$fexsrv,$cc);
  local $_;

  $sid = $id;

  if ($port eq 443 or $proxy) {
    return if $opt_d;
    return if $features;    # early return if we know enough
    $req = "OPTIONS /FEX HTTP/1.1"; # does not work with (some) proxies
    $req = "GET /SID HTTP/1.1";     # needed as FEATURES query
  } else {
    $req = "GET /SID HTTP/1.1";
  }

  sendheader("$server:$port",$req,"X-User: $from");
  $_ = <$SH>;
  unless (defined $_ and /\w/) {
    warn "\n" if $opt_v;
    die "$prg: no response from server\n";
  }
  s/\r//;
  warn "<-- $_" if $opt_v;

  if (/^HTTP.* [25]0[01] /) {
    if ($port ne 443 and not $okey and $FEXOPT !~ /\bNOSID\b/i) {
      if (/^HTTP.* 201 (.+)/ and not $proxy) {
        $sid = 'MD5H:'.md5_hex($id.$1);
      } else {
        warn "$prg: no SID available, sending auth-ID unencrypted\n";
      }
    }
    while (<$SH>) {
      s/\r//;
      warn "<-- $_" if $opt_v;
      $features = $1 if /^X-Features: (.+)/;
      $timeout = $1  if /^X-Timeout: (\d+)/;
      $cc = $_       if /^Connection: close/;
      last           if /^\n/;
    }
    if ($cc) {
      serverconnect($server,$port);
      $sid = $id;
    }
  } elsif (/^HTTP.* 301 /) {
    while (<$SH>) { last if /Location/ }
    die "$prg: cannot use $server:$port because server has a redirection to\n".$_;
  } else {
    # no SID support - perhaps transparent web proxy?
    while (<$SH>) {
      s/\r//;
      warn "<-- $_" if $opt_v;
      $fexsrv = $_ if /^(Server: fexsrv|X-Features:)/;
      last if /^\s*$/;
    }
    die "$prg: no fexserver at $server:$port\n" unless $fexsrv;
    serverconnect($server,$port);
    $sid = $id;
  }

  # warn "proxy: $proxy\n";
  if ($proxy) {
    serverconnect($server,$port);
    $sid = $id;
  }

}


sub xxget {
  my ($from,$id,$save) = @_;
  my $bs = 4096;
  my $xx = $save;
  my ($url,$B,$b,$t0,$t1,$cl);
  my ($ts,$tso);
  local $_;

  $xx =~ s:.*/::;
  $url = "$proxy_prefix/fop/$from/$from/$xx?ID=$id";

  sendheader("$server:$port","GET $url HTTP/1.0");
  http_response();
  while (<$SH>) {
    s/\r//;
    warn "<-- $_" if $opt_v;
    $cl = $1 if /^Content-Length:\s(\d+)/;
    # $ft = $1 if /^X-File-Type:\s(.+)/;
    last if /^$/;
  }

  die "$prg: no Content-Length in server-reply\n" unless $cl;

  open $save,">$save" or die "$prg: cannot write to $save - $!\n";
  binmode $save;

  $t0 = $t1 = int(time);
  $tso = '';

  while ($b = read($SH,$_,$bs)) {
    $B += $b;
    print {$save} $_;
    if (int(time) > $t1) {
      $t1 = int(time);
      $ts = ts($B,$cl);
      if ($ts ne $tso) {
        print STDERR $ts,"\r";
        $tso = $ts;
      }
    }
    sleep 1 while ($opt_m and $B/kB/(time-$t0||1) > $opt_m);
  }

  print STDERR ts($B,$cl),"\n";
  close $save;
}


# transfer status
sub ts {
  my ($b,$tb) = @_;
  return sprintf("transferred: %d MB (%d%%)",int($b/MB),int($b/$tb*100));
}


sub sigpipehandler {
  retry("died");
}

sub retry {
  my $reason = shift;
  local $SIG{ALRM} = sub { };

  if (fileno $SH) {
    alarm(1);
    my @r = <$SH>;
    alarm(0);
    if (@r and $opt_v) {
      die "\n$prg: ($$) server error: @r\n";
    }
    if (@r and $r[0] =~ /^HTTP.* \d+ (.*)/) {
      die "\n$prg: server error: $1\n";
    }
  }
  $timeout *= 2;
  warn "\n$prg: connection to $server $reason\n";
  if ($opt_s) { exit 3 }
  warn "retrying after $timeout seconds...\n";
  sleep $timeout;
  if ($windoof) { exec $^X,$prg,@_ARGV }
  else          { exec $_0,@_ARGV }
  die $!;
}


sub checkrecipient {
  my ($from,$to) = @_;
  my @r;
  local $_;

  @r = formdatapost(
    from	=> $from,
    to		=> $to,
    id		=> $sid,
    autodelete	=> $opt_D,
    keep	=> $opt_k,
    command	=> 'CHECKRECIPIENT',
  );

  $_ = shift @r or die "$prg: no reply from server\n";

  if (/ 2\d\d /) {
    return if $to eq 'nettest';
    foreach (@r) {
      last if /^$/;
      if (s/X-(Recipient: .+)/$1\n/) {
        s/autodelete=\w+/autodelete=$opt_D/ if $opt_D;
        s/keep=\d+/keep=$opt_k/             if $opt_k;
        print unless $opt_q;
        $frecipient ||= (split)[1];
      }
    }
  } else {
    http_response($_,@r);
  }
}


# get ID data from ID file
sub get_id {
  my $idf = shift;

  $fexcgi = getline($idf) || die "$prg: no FEX-URL in $idf\n";
  $from   = getline($idf) || die "$prg: no FROM in $idf\n";
  $id     = getline($idf) || die "$prg: no ID in $idf\n";
  if ($fexcgi =~ s/!([\w.-]+:\d+)(:(\d+))?//) {
    $proxy = $1;
    $chunksize = $3 || 0;
  }
  unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) {
    die "$prg: illegal FEX-URL \"$fexcgi\" in $idf\n";
  }
  unless ($from =~ /^[_:=\w\-\.\/\@\%\+]+$/) {
    die "$prg: illegal FROM \"$from\" in $idf\n";
  }
  $fexcgi =~ s:/+$::;
}


# for windows
sub inquire {
  my ($file,$to);
  unless (@ARGV) {
    for (;;) {
      $file = inputline("file or directory to send: ");
      exit unless length $file;
      $file =~ s/^'(.+)'$/$1/;
      last if -e $file;
      warn "$file does not exist\n";
    }
    if (-d $file) {
      my $dir = dirname($file);
      $file = basename($file);
      chdir $dir or die "$prg: $dir - $!\n";
      $opt_a ||= "$file.zip";
    }
    @ARGV = ($file);
  }
  $to = inputline("recipient (email address): ");
  unless (length $to) {
    $opt_n = $to = '.';
  }
  $to =~ s/\s+/,/g;
  $to =~ s/,,+/,/g;
  $to =~ s/^,//;
  $to =~ s/,$//;
  push @ARGV,$to;
  unless ($opt_n or $opt_C) {
    $opt_C = inputline("comment: ");
  }
}


sub shelldo {
  warn "\$ @_\n" if $opt_v;
  if (system(@_) < 0) { die "failed: @_\n" }
}


# emulate seek on a pipe
sub readahead {
  my $fh = shift; # filehandle
  my $ba = shift; # bytes ahead
  my $bs = 2**16;
  my $s = 0;
  my $n;
  local $_;

  while ($s < $ba) {
    $n = $ba-$s;
    $n = $bs if $n > $bs;
    $s += read $fh,$_,$n;
  }
}


sub fileid {
  my $file = shift;
  my $dirmode = shift;
  my @s = $dirmode ? lstat($file) : stat($file);

  if (@s) {
    return md5_hex($file.$s[0].$s[1].$s[7].$s[9]);
  } else {
    warn "$prg: $file - $!\n";
    return int(time);
  }
}


sub get_mutt_alias {
  my $to = shift;
  my $ma = $HOME.'/.mutt/aliases';
  my ($alias,$options);
  local $_;

  $to =~ s/(:.+)// and $options = $1;
  open $ma,$ma or return $to;
  while (<$ma>) {
    if (/^alias \Q$to\E\s/i) {
      chomp;
      s/\s*#.*//;
      s/\(.*?\)//;
      s/\s+$//;
      s/.*\s+//;
      s/[<>]//g;
      if (/,/) {
        warn "$prg: ignoring mutt multi-alias $to = $_\n";
        last;
      }
      if (/@/) {
        $alias = $_;
        warn "$prg: found mutt alias $to = $alias\n";
        $alias .= $options if $options;
        last;
      }
    }
  }
  close $ma;
  $to = "$to:$options" if $options;
  return ($alias||$to);
}


# collect (hashed) file meta data
sub fmd {
  my @files = @_;
  my ($file,$dir);
  my $fmd = '';

  foreach $file (@files) {
    if (not -l $file and -d $file) {
      $dir = $file;
      next if $dir =~ m:/\.fex/tmp$:;
      if (opendir $dir,$dir) {
        while (defined($file = readdir($dir))) {
          next if $file eq '..';
          next if $xp and $file =~ /^($xp)$/;
          if ($file eq '.') {
            $fmd .= fileid($dir);
          } elsif (-l "$dir/$file") {
            # hack for dangling symlinks: do not raise an error
            $fmd .= fileid("$dir/$file",'dirmode');
          } else {
            $fmd .= fmd("$dir/$file");
          }
        }
        closedir $dir;
      }
    } else {
      $fmd .= fileid($file,'dirmode');
    }
  }

  return $fmd;
}


sub female_mode {
  local $_;
  if (open my $tty,'/dev/tty') {
    print "@_\n";
    print "  [y] yes\n",
          "  [n] no\n",
          "  [p] perhaps - don't know\n",
          "your choice: ";
    $_ = <$tty> || '';
    close $tty;
    if (/^y/i) { return }
    if (/^n/i) { exit }
    if (/^p/i) { int(rand(2)) ? return : exit }
    female_mode(@_);
  }
}


sub http_response {
  local $_ = shift || <$SH>;
  my @r = @_;
  my $error;

  $_ = <$SH> unless $_;
  unless (defined $_ and /\w/) {
    die "$prg: no response from server\n";
  }
  s/\r?\n//;
#  warn "<-- $_\n" if $opt_v;
  # CGI fatalsToBrowser
  if (/^HTTP.* 500/) {
    @r = <$SH> unless @r;
    @r = ()    unless @r;
    die "$prg: server error: $_\n@r\n";
  }
  unless (/^HTTP.* 200/) {
    $error = $_;
    $error =~ s/HTTP.[\s\d.]+//;
    if (defined($SH)) {
      @r = <$SH> unless @r;
      @r = ()    unless @r;
    }
    foreach (@r) {
      chomp;
      $error .= "\n".$_ if /^Location/;
      warn "<-- $_\n" if $opt_v;
    }
    die "$prg: server error: $error\n";
  }

  if ("@r" =~ /INTERNAL ERROR.*<pre>(.+)<\/pre>/s) {
    die "$prg: server error: $1\n";
  }

  return $_;
}


# check (heuristcally) if files should be compressed
sub compressable {
  my $uf = 1;
  my $cf = 1;
  my $cfx = 'gif|jpg|png|avi|mp\d|flv|m4v|ogg|tar|t?gz|zip|7z|bz2|rar|iso';

  local $_;

  if ("@_" =~ /^\[(.+)\]$/) {
    my $flist = $1;
    if (open $flist,$flist) {
      while (<$flist>) {
        chomp;
        if (-f) {
          if (/\.($cfx)$/i) {
            $cf += -s;
          } else {
            $uf += -s;
          }
        }
      }
      close $flist;
    }
  } else {
    warn "\$ find @_ -type f|\n" if $opt_v;
    my @find = ('find',@_,qw'-type f');
    foreach my $x (split('#',$xlist)) {
      $x = '.*' if $x eq '.';
      $_ = "( ! -path */$x -prune )";
      push @find,split;
    }
    if (open my $find,'-|',@find) {
      while (<$find>) {
        chomp;
        if (/\.($cfx)$/i) {
          $cf += -s;
        } else {
          $uf += -s;
        }
      }
      close $find;
    }
  }

  if ($uf+$cf < 2**31 and $uf/$cf > 0.2) {
    return 1;
  } else {
    return 0;
  }
}


sub ws {
  local $_ = shift;
  return split;
}


sub update {
  my $cfb = '### common functions ###';
  my $cfc;

  local $/;

  open $prg,$prg or die "cannot read $prg - $!\n";
  $cfc = <$prg>;
  close $prg;
  $cfc =~ s/.*\n$cfb\n//s;

  my @p = qw(fexget sexsend);
  foreach my $p (@p) {
    if (open $p,$p) {
      $_ = <$p>;
      close $p;
      s/\n$cfb.*/\n$cfb\n$cfc/s;
      system "vv -s $p";
      open $p,'>',$p or die "cannot write $p - $!\n";
      print {$p} $_;
      close $p;
    } else {
      warn "cannot read $p - $!\n";
    }
  }

  exec "l fexsend @p";
  exit;
}


# newest modification time
sub nmtime {
  my ($file,$dir);
  my @files;
  my @s;
  local $_;

  if (scalar(@_) == 1 and not -d $_[0]) {
    if (@s = stat $_[0]) {
      $nmtime = $s[9] if $s[9] > $nmtime;
    }
  } else {
    foreach $file (@_) {
      @files = ();
      if (-d $file and opendir $dir,$file) {
        while (defined($_ = readdir $dir)) {
          next if /^\.\.?$/;
          next if $xp and /^($xp)$/;
          push @files, "$file/$_";
        }
        closedir $dir;
        nmtime(@files);
      } else {
        if (@s = lstat $file) {
          $nmtime = $s[9] if $s[9] > $nmtime;
        }
      }
    }
  }
}


sub xxx {
  my (%fp,%list);
  my $clear = `clear`;
  my $first = 1;

  $ENV{FUA} = 'xxx';

  my @fexget = ($fexget);
  push @fexget,'-o'        if $opt_o;
  push @fexget,'-m',$opt_m if $opt_m;

  unless ($FEXID = $ENV{FEXXX}||$ENV{FEXID}) {
    if (open $idf,$idf) {
      get_id($idf);
      while (<$idf>) {
        if (/^\[xx\]/) {
          get_id($idf);
          last;
        }
      }
      close $idf;
      $FEXID = encode_b64("$fexcgi $from $id");
    }
    # $FEXID = $1 if `xx -I</dev/null` =~ /FEXXX=(.+)/;
  }

  if ($opt_I) {
    if ($FEXID) {
      print "export FEXXX='$FEXID';history -d \$((HISTCMD-1))\n";
    } else {
      die "$prg: no FEXID\n";
    }
    exit;
  }

  if ($FEXID) {
    if (($ENV{FEXID}||'') ne $FEXID) {
      warn "\$ export FEXID='$FEXID'\n" if $opt_v;
      $ENV{FEXID} = $FEXID;
    }
  } else {
    die "$prg: no FEXID\n";
  }

  if ($opt_x) {
    my $xi;
    # "USER=\$(id|sed 's/).*//;s/.*(//')",
    $xi .= "$_\n" foreach (
      'FEXBIN=/tmp/$USER/.fex/tmp;',
      'mkdir -p $FEXBIN && cd $FEXBIN &&',
      'wget -qO - fex.belwue.de/download/xxx.tgz | tar xzf -;',
      'test "$UID" = 0 && chown -h root:root $FEXBIN/*;',
      'PATH="$FEXBIN:$PATH";',
      "export FEXID='$FEXID';",
      'ls -l'
    );
    my $fx = "| $fexsend -k 1 -s xxx.bash .";
    warn "$fx\n" if $opt_v;
    if ($opt_X and open $fx,$fx) {
      warn $xi if $opt_v;
      print {$fx} $xi;
      close $fx;
    } else {
      print "# copy these bash commands to your other account to temporary\n";
      print "# install the F*EX clients (including xxx) with your F*EX ID\n";
      $xi =~ s/;\n/\n/g;
      $xi =~ s/(FEXID=.*)/$1;history -d \$((HISTCMD-1))/;
      print $xi;
    }
    exit;
  }

  if ($opt_u) {
    $_ = vsystem("$fexsend -~ GENUKEY|");
    if ($? == 0 and /FUP=(http.+)/) {
      my $fup = $1;
      print "# to get (one day valid) upload function, copy&paste:\n";
      print "eval \$(curl -s $fup)\n";
      print if $opt_v and /\n/;
    }
    exit $?;
  }

  if ($opt_l or $opt_L) {
    my @xxx = qw'
      which xxx || xxx() {
        case $1 in
          *.tgz) wget -qO - $1|tar xvzf -;;
          *.tar) wget -qO - $1|tar xvf -;;
          *.gz)  wget -qO - $1|gunzip;;
          *.txt) wget -qO - $1;;
        esac;
      }
    ';
    warn "\$ $fexsend -L .|\n" if $opt_v;
    open my $p,"$fexsend -L .|" or exit 1;
    while (<$p>) {
      if (my ($size,$keep,$url,$n,$container,$comment) =
          m:(\d+ MB) \(\s*(\d+ d)\) (http.*/xxx_($xn)\.(\S+)) "(.+)":)
      {
        if (not $opt_w and @xxx) {
          print "@xxx\n";
          @xxx = ();
        }
        print "\n$comment ($size, $keep)\n";
        if ($opt_w) {
          # print "xxx $n\n";
          print "xxx=$url\n";
          if ($container eq 'txt') {
            print "wget -qO- \$xxx\n";
          } elsif ($container eq 'gz') {
            print "wget -qO- \$xxx | gunzip\n";
          } elsif ($container eq 'tar') {
            print "wget -qO- \$xxx | tar xvf -\n";
          } elsif ($container eq 'tgz' or $container eq 'tar.gz') {
            print "wget -qO- \$xxx | tar xvzf -\n";
          } elsif ($container eq 'zip') {
            my $zip = "xxx_$n.zip";
            print "wget -c \$xxx && unzip $zip && rm $zip\n";
          } else {
            print "wget -c \$xxx\n";
          }
        } else {
          print "xxx $url\n";
        }
      }
    }
    exit;
  }

  if ($opt_k and "@ARGV" =~ /($xn)/) {
    my $x = $1;
    my $n = 0;
    warn "\$ $fexsend -l|\n" if $opt_v;
    open my $p,"$fexsend -l|" or exit 1;
    while (<$p>) {
      if (/#(\d+).* xxx_($x)/) {
        $n = $1;
      }
    }
    close $p;
    if ($n) {
      vexec($fexsend,'-x',$n,'-k',$opt_k);
      exit $?;
    } else {
      die "$prg: archive not found\n";
    }
  }

  # get or delete named archive
  if ("@ARGV" =~ /^($xn|-)$|^(http.*xxx_$xn\S+)/) {
    my $n = $1||'';
    my $url = $2;
    my $fpl;
    unless ($url) {
      warn "\$ $fexsend -L .|\n" if $opt_v;
      open my $p,"$fexsend -L .|" or exit 1;
      while (<$p>) {
        $url = $1 if m:(http\S+/xxx_$n\.\S+):;
        $fpl = $_ if m:(http\S+/xxx_$xn\.\S+):;
      }
      close $p;

      if ($n eq '-' and $fpl =~ m:(\d+ MB).*?(http\S+/xxx_$xn\.\S+) (".+"):) {
        $url = $2;
      }
    }

    if ($url) {
      if ($opt_d) {
        vexec($fexget[0],'-d',$url);
      } else {
        if ($url =~ /xxx_$xn\.txt$/) {
          vexec("@fexget -s- $url");
        } elsif ($url =~ /xxx_$xn\.gz$/) {
          vexec("@fexget -s- $url | gunzip");
        } else {
          if (-t STDOUT) {
            push @fexget,'-o' if $n eq '-';
          } else {
            push @fexget,'-s-';
          }
          vexec(@fexget,$url);
        }
      }
      exit $?;
    } else {
      die "$prg: no such archive\n";
    }
  }

  # delete archive with regexp
  if ($opt_d and "@ARGV" =~ /(.+)/) {
    my $x = $1;
    my (%url,%comment);
    warn "\$ $fexsend -L .|\n" if $opt_v;
    open my $p,"$fexsend -L .|" or exit 1;
    while (<$p>) {
      if (/(http\S+\/xxx_($xn)\.\w+) "(.*$x.*)"/) {
        $url{$2} = $1;
        $comment{$2} = $3;
      }
    }
    close $p;
    if (%url) {
      foreach (sort keys %url) {
        if (/(\d\d\d\d)(\d\d)(\d\d)_(\d\d)(\d\d)(\d\d)/) {
          print "$1-$2-$3 $4:$5:$6 $comment{$_}\n";
        }
      }
      print "delete? ";
      for (;;) {
        my $k = ReadKey(0);
        if ($k eq 'n') {
          print "no\n";
          exit;
        }
        if ($k eq 'y') {
          print "yes\n";
          last;
        }
      }
      foreach my $url (sort keys %url) {
        print "\n";
        vsystem($fexget[0],'-d',$url{$url});
        sleep 1;
      }
    }
    exit;
  }

  if ($opt_g or $opt_d) {
    die $usage if @ARGV or not -t STDIN;
    my $long = 0;
    my $showurl = 0;
    my $dl = "\r".(" "x60)."\r";

    for (;;) {
      my $n = 0;
      my $i = 0;
      my $k = '';
      my $last = '';
      my $input = '';
      my %fp = ();
      my %dkey = ();
      my %list = ();
      my @xxx = ();

      warn "\$ $fexsend -L .|\n" if $opt_v;
      open my $p,"$fexsend -L .|" or exit 1;
      while (<$p>) {
        chomp;
        if (m:http\S+/xxx_$xn:) {
          s/  //;
          s/\(//;
          s/\)//;
          s/\"//g;
          push @xxx,$_;
        }
      }
      close $p;

      $i = $n = scalar(@xxx) or die "$prg: no stored archives found\n";

      print "\n";
      foreach (@xxx) {
        if (s:((http\S+)/fop/(\w+)/xxx_(\d\d\d\d)(\d\d)(\d\d)_(\d\d)(\d\d)(\d\d)\.(\w+)) ::) {
          $fp{$i} = $1;
          $dkey{$i} = $3;
          $list{$i} = $_ = sprintf "%3s $4-$5-$6 $7:$8:$8 %s\n","#$i",$_;
          s/\d\d\d\d-.*?\[/\[/ unless $long;
          print;
          printf "    %s\n",$fp{$i} if $showurl;
          $i--;
        }
      }

      for (;;) {
        print $dl;
        print "get"    if $opt_g;
        print "delete" if $opt_d;
        print "list"   if $opt_l;
        print "keep"   if $opt_k;
        if ($input) {
          print " #$input";
        } else {
          print " # (or enter h for help): ";
        }
        last if $last;
        $k = ReadKey(0);
        if ($k eq "\n") {
          $input ||= 'q' if $first;
          last if $input;
          redo;
        }
        $first = 0;
        unless ($input) {
          # first input character
          if ($k eq ' ') {
            $input = $k;
            last;
          }
          if ($k eq 'q') {
            print "q\n";
            exit;
          }
          if ($k eq "h" or $k eq "?") {
            print $dl;
            if ($opt_g) {
              print "#-        get archive # and overwrite existing files\n";
              print "[v]       toggle view format\n";
              print "[u]       toggle show URL\n";
              print "[d]       delete\n";
              print "[k]       keep\n";
              print "[l]       list content\n";
            }
            if ($opt_d) {
              print "#-#       delete archives from # to #\n";
              print "[v]       toggle view format\n";
              print "[u]       toggle show URL\n";
              print "[g]       get\n";
              print "[k]       keep\n";
              print "[l]       list content\n";
            }
            if ($opt_k) {
              print "#         set new keep time for #\n";
              print "[v]       toggle view format\n";
              print "[u]       toggle show URL\n";
              print "[g]       get\n";
              print "[d]       delete\n";
              print "[l]       list content\n";
            }
            if ($opt_l) {
              print "[v]       toggle view format\n";
              print "[u]       toggle show URL\n";
              print "[g]       get\n";
              print "[d]       delete\n";
              print "[k]       keep\n";
            }
            print "[q]       quit\n";
            print "[SPACE]   reload overview\n";
            redo;
          }
          if ($opt_g and $k eq "-") {
            $last = $input = 1;
            push @fexget,'-o';
            redo;
          }
          if ($k eq "v" or $k eq "u") {
            # print "\r",' 'x40,"\n";
            print $clear;
            $long    = not $long    if $k eq "v";
            $showurl = not $showurl if $k eq "u";
            for (my $i=$n;$i;$i--) {
              $_ = $list{$i};
              s/\d\d\d\d-.*?\[/\[/ unless $long;
              print;
              printf "    %s\n",$fp{$i} if $showurl;
            }
            redo;
          }
          if ($k eq "d") {
            $opt_d = 1;
            $opt_g = 0;
            $opt_l = 0;
            $opt_k = 0;
            redo;
          }
          if ($k eq "g") {
            $opt_g = 1;
            $opt_d = 0;
            $opt_l = 0;
            $opt_k = 0;
            redo;
          }
          if ($k eq "l") {
            $opt_l = 1;
            $opt_d = 0;
            $opt_g = 0;
            $opt_k = 0;
            redo;
          }
          if ($k eq "k") {
            $opt_k = 1;
            $opt_d = 0;
            $opt_g = 0;
            $opt_l = 0;
            $long = 1;
            $input = ' ';
            last;
          }
        }
        if ($opt_g and $k eq "-") {
          push @fexget,'-o';
          $input ||= 1;
          $last = $input;
          redo;
        }
        if (ord($k) == 4 or ord($k) == 127) {
          $input =~ s/.$//;
        } elsif ($k =~ /\d/) {
          $input .= $k;
        } elsif ($opt_d and $input =~ /^\d+$/) {
          $input .= $k if $k eq ' ';
          $input .= $k if $k eq '-';
        }
      }
      if ($input eq ' ') {
        print $clear;
        redo;
      }
      if ($input eq '') {
        print "\r",' 'x72,"\r";
        exit;
      }

      print "\n";
      exit if $input !~ /\d/;

      $input =~ s/-$//;
      if ($input =~ s/^(\d+)-(\d+)$//) {
        for ($1..$2) {
          $input .= $_.' ';
        }
      }

      foreach my $i (split(' ',$input)) {
        print "\n";
        if ($i =~ /^\d+$/) {
          if (my $durl = $fp{$i}) {
            $_ = $list{$i};
            s/ *#\d+ //;
            s/ +( \d+ MB)/$1/;
            print;
            if ($opt_g) {
              my $pp;
              if ($durl =~ /\d+\.gz$/) {
                my $pipe = inputline("pipe data to: ");
                $pipe = '| '.$pipe if $pipe and $pipe !~ /^>/;
                vexec("@fexget -s- $durl | gunzip $pipe");
              } elsif ($durl =~ /\d+\.txt$/) {
                vexec("@fexget -s- $durl");
              } else {
                close STDIN;
                if (($windoof or $cygwin) and getcwd() =~ /Downloads$/) {
                  system(@fexget,$durl);
                  system qw'explorer .';
                  exit;
                } else {
                  vexec(@fexget,$durl);
                }
              }
              exit 1;
            }
            if ($opt_d) {
              vsystem($fexsend,'-d',basename($durl),'.');
              sleep 1;
            }
            if ($opt_k) {
              my $keep = inputline("keep days: ");
              # update fexlist
              vsystem("$fexsend -l >/dev/null");
              vsystem($fexsend,'-x',$dkey{$i},'-k',$keep);
              sleep 1;
            }
            if ($opt_l) {
              if ($durl =~ /\.(gz|txt)$/) {
                print "\nis not an archive, but pipe data\n";
              } else {
                vsystem($fexget[0],'-t',$durl);
                sleep 1;
              }
            }
          } else {
            print "#$i does not exist\n" if $i;
          }
        }
      }
      print "\nhit [SPACE] to continue, [q] to quit";
      $k = ReadKey(0);
      if ($k eq "q") {
        print "\r",' 'x72,"\r";
        exit;
      }
      print $clear;
    }
  }

  # upload
  my @d = localtime time;
  my $fp = sprintf('xxx_%d%02d%02d_%02d%02d%02d',
                   $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
  my $comment = sprintf('[%s@%s]',scalar(getpwuid($<)),hostname());

  $opt_k ||= 1;
  $fexsend .= " -q" if $opt_q;

  unless (-t STDIN) {
    $fexsend .= " -k $opt_k";
    $comment .= ' -';
    if (@ARGV) {
      $comment .= " # @ARGV";
    } elsif (0 and my $pipe = readlink '/proc/self/fd/0') {
      # search for pipe STDIN process
      # does not work reliable, because STDIN process may has already terminated
      foreach my $fd1 (glob '/proc/*/fd/1') {
        if ((readlink($fd1)||'') eq $pipe and $fd1 =~ m:(/proc/\d+):) {
          my $cmdline = "$1/cmdline";
          if (open $cmdline,$cmdline) {
            local $/;
            $_ = <$cmdline>;
            close $cmdline;
            s/\000$//;
            s/\000/ /g;
            $comment .= " # $_";
          }
        }
      }
    }
    $comment = shellquote($comment);
    if ($opt_t) {
      vsystem("cat|$fexsend -M -C $comment -s $fp.txt .");
    } else {
      vsystem("gzip|$fexsend -C $comment -s $fp.gz .");
    }
    $fp =~ s/_/ /;
    # print "$fp\n" if $? == 0;
    exit $?;
  }

  my @fexsend = ($fexsend);
  push @fexsend,'-0' if $opt_0;
  push @fexsend,('-k',$opt_k) if $opt_k;
  push @fexsend,('-m',$opt_m) if $opt_m;

  my $ao = '-a';
  grep { /^\..|\/\./ and $ao = '-A' } @ARGV;

  map { s:/+$:/: } @ARGV;
  my @files = @ARGV;

  if ("@ARGV" eq '.') {
    die "$prg: . is empty\n" unless glob '*';
    $comment .= ' '.abs_path("@ARGV").'/';
  } else {
    foreach (@ARGV) {
      $comment .= " $_";
      $comment =~ s:/*$:/: if -d and not -l;
    }
    if (scalar(@ARGV) == 1 and not $opt_p) {
      my $a = $ARGV[0];
      die "$prg: cannot read $a\n" unless -r $a;
      if ($a !~ /\/$/) {
        $a = abs_path($a);
        die "$prg: cannot send /\n" if $a eq '/';
        if ($a =~ m:(.+)/(.+):) {
          chdir $1 or die "$prg: cannot cd $1 - $!\n";
          warn "\$ cd $1\n" if $opt_v;
          @files = ($2);
        } else {
          chdir '/';
          warn "\$ cd /\n" if $opt_v;
          @files = ($a);
        }
        $comment =~ s/ .*/ @files/;
      }
    }
  }

  my $container = 'taz';
  if ($opt_Z or ($windoof or $cygwin) and not $opt_T) {
    $container = 'zip';
  } elsif ($opt_z) {
    $container = 'tgz';
  } elsif ($opt_0) {
    $container = 'tar';
  }
  vsystem(@fexsend,'-C',$comment,$ao,"$fp.$container",@files,'.');
  if ($ENV{RUNCMD}) {
    exec 'xxx';
  }
  exit $?;

}

### 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',
    );
  }

  die "$prg: $@\n" if $@;

  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 $FEXOPT =~ /\bDEBUG\b/i;
}


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')) {
      Encode::from_to($string,'UTF8',$CTYPE,Encode::FB_WARN);
#      return encode($CTYPE,decode('UTF8',$string,Encode::FB_WARN),Encode::FB_WARN);
    } else {
      Encode::from_to($string,'UTF8','ISO-8859-1',Encode::FB_WARN);
#      return encode('ISO-8859-1',decode('UTF8',$string));
    }
    return $string;
 }

  return $string;
}


sub enable_ssl {
  local $_;
  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;
  }
}