#!/usr/bin/perl -w

# client for directory syncing of the FEX service
#
# Author: Ulli Horlacher <framstag@belwue.de>
#
# Perl Artistic Licence

# fexsync sends or receives new files of a specified directory via fexserver.
#
# Sending and receiving works synchronously.
# For sending you need a FEXID, receiving is "free".
#
# ---------------------------------------------------------------------------
#
# Send usage:
#
#   fexsync [-v] [-i ID] [-m MAX] [-X 'EXCLUDE'] [-z] [-c] [-C TKEY] [-w SECONDS] DIRECTORY
#
# Option -v is for verbose mode.
#
# Option -i selects account ID from $HOME/.fex/id
#
# Option -m limits the throuput to MAX kB/s.
#
# Option -X excludes files.
#
# Option -z forces compression.
#
# Option -c is for continuous syncing (needs sexsend).
#
# Option -C is like -c but you can name the transfer key.
#
# Option -w waits SECONDS before next syncing.
#
# After initiating the transfer fexsync shows you
# TNAME TKEY FEXSERVER FEXUSER
# which you need as arguments for receiving.
#
# TNAME is the transfer name of the directory you want to sync.
# TKEY is a unique secret number (or a string when using option -c).
# FEXSERVER and FEXUSER are optional, if the receiving account has your FEXID.
# EXCLUDE is a Perl regexp matching full file name (no path allowed).
# TKEY is the secret transfer key for continuous syncing.
#
# Limitations:
# fexsync always excludes directories named .del .snapshot .snapshots
# fexsync breaks hard links when updating.
#
#
# ---------------------------------------------------------------------------
#
# Receive usage:
#
#   fexsync [-v] [-m MAX] [-d] TNAME TKEY [FEXSERVER FEXUSER]
#
# Option -v is for verbose mode.
#
# Option -m limits the throuput to MAX kB/s.
#
# Option -d deletes extraneous files.
#
# TNAME is the transfer name of the directory you want to sync.
# TKEY is the secret transfer key.
#
# ---------------------------------------------------------------------------
#
# Easy send&receive usage:
#
#   fexsync . # send directory
#   fexsync : # receive directory
#
# On both sides you need the same FEXID and you have to be in a directory with
# the same name (pwd).
#
# ---------------------------------------------------------------------------
#
# You can send&install fexsync to the recieving account with:
#
# fexsend $(which fexsync) .
# wget <Location>
# chmod 755 fexsync
# alias fexsync="$(pwd)/fexsync"
#
# To synchronize a directory bidirectionally (A <-> B), simply call
# "fexsync DIRECTORY" first on host A, then on host B.
# Hint: you may use "." for DIRECTORY.
#
# If you have no FEXID on host B, then call "fexsend -I" on host A and copy
# the export line to host B.
#
# If you have the del utility installed (comes with the fextools), then
# existing files will be moved to a .del/ subdiretory before they will be
# overwritten or removed.
#
# See also:
#   xxx -h
#   http://fex.rus.uni-stuttgart.de/usecases/xx.html#xxx
#   http://fex.rus.uni-stuttgart.de/usecases/fexsync.html

# ---------------------------------------------------------------------------

# fexdox sends or receives new or modified files of a specified directory
# to or from an associated folder on the fexserver.
# This means, files will be synchronized.
#
# For sending you need a FEXID from the fexmaster.
# For receiving you need a FEXID or user/password from the folder owner.
# If a folder is open for anonymous read access, then you can use "anonymous"
# as user name.
#
# A folder on the fexserver has the same name as the local directory, but
# problematic characters will be substituted with "_".
# File names are transfered "as is" (binary), no character set translation
# will be made.
#
# You can exclude files from sending when you write their filename pattern into
# a local file named .fexdox/exclude
# The filename patterns are the same as in a POSIX shell with an additional
# pattern /**/ which stands for any (sub)directory.
# If you want to exclude a certain directory/file, prefix it with a /
# otherwise all matching files in any directory will be excluded.
# Examples:
#
# blubb.tmp        # will exclude all files with that name in any directory
# *.tmp            # will exclude all tmp-files in any directory
# /test/blubb.tmp  # will exclude only this single file
#
# This exclude list is also respected by the -d delete option when you
# download (receive) a folder. This means: matching files will not be deleted.
#
# When you download a folder from the fexserver it may contain the DOX user
# upload directory FOLDER/.upload
# This directory is excluded by default for (re)uploading.
#
# Automatic compression transfer mode is default, see fexsend -H
#
# Send usage:
#   fexdox -s [-v] [-n] [-m MAX] [-z] [-i ID] [-d] [-f FOLDER] DIRECTORY
#   fexdox -s [-v] [-n] [-m MAX] [-z] [-i ID]      [-f FOLDER] . FILES_OR_DIRECTORIES
#   fexdox -s [-v] [-n] [-m MAX] [-z] DOXURL DIRECTORY <<<USER:PASSWORD
#
# Receive usage:
#   fexdox -r [-v] [-m MAX] [-z] [-i ID] [-d] FOLDER
#   fexdox -r [-v] [-m MAX] [-z]         [-d] DOXURL [<<<USER:PASSWORD]
#
# Other usage:
#   fexdox    [-v] [-i ID] [-l [FOLDER]] [-D FOLDER] [-a FOLDER]
#
# options: -v  verbose mode
#          -n  no file transfer (dry-run)
#          -i  use account ID from $HOME/.fex/id
#          -s  send DIRECTORY (upload)
#          -f  save to FOLDER
#          -r  receive FOLDER (download)
#          -m  limit throuput to MAX kB/s
#          -z  force compression
#          -d  delete extraneous files
#          -l  list dox folders or FOLDER content
#          -D  delete FOLDER
#          -a  assign FOLDER name to current directory
#
# see also: http://fex.belwue.de/DOX/
#
# For limitations see: fexsync -H

use Socket;
use Config;
use Getopt::Std;
use IO::Handle;
use IO::Socket::INET;
use File::Basename;
use Sys::Hostname;
use Cwd		qw(abs_path getcwd);
use Digest::MD5	qw(md5_hex);

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

our $version = 20200429;
our $DEBUG = $ENV{DEBUG};

$ENV{LC_ALL} = 'C';

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

my $sigpipe;
my $transfer = '';

unless ($version) {
  my @d = localtime((stat $0)[9]);
  $version = sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3])
}

$useragent = $ENV{FUA} = "fexsync-$version";

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

$| = 1;
$prg = $0;
$prg =~ s:(.*)/::;
$fexsync = "$1/fexsync";
$del     = "$1/del";
$sexget  = "$1/sexget";
$sexsend = "$1/sexsend";
@fexsend = ("$1/fexsend");
@fexget  = ("$1/fexget");
@fexsync = ($fexsync);

$exclude = '\.del|\.snapshots?';
$afnc = 'a-zA-Z_\d\@~^.,+-';
$vp = '\d{8}_\d{6}';
$fexhome = $ENV{HOME}.'/.fex';

$wget = 'wget';
if ($Config{osname} =~ /^(mswin|cygwin)/i) {
  $wget .= ' --no-check-certificate';
}

if ($prg =~ /dox/) {

  $dox = $prg;
  @CMD = ($0,@ARGV);
  $useragent = $ENV{FUA} = "$prg-$version";

  $usage = ljoin(
    "$prg: send or receive new documents to or from fexserver folder",
    "send usage:    $prg -s [-d] [-f FOLDER] DIRECTORY",
    "send usage:    $prg -s      [-f FOLDER] . FILES_OR_DIRECTORIES",
    "send usage:    $prg -s      DOXURL DIRECTORY <<<USER:PASSWORD",
    "receive usage: $prg -r [-d] FOLDER",
    "receive usage: $prg -r [-d] DOXURL [<<<USER:PASSWORD]",
    "other usage:   $prg [-H] [-l [FOLDER]] [-D FOLDER] [-a FOLDER]",
    "options: -s  send DIRECTORY (upload)",
    "         -r  receive FOLDER (download)",
    "         -d  delete extraneous files",
    "         -f  upload to FOLDER",
    "         -l  list folders (uploaded directories) or FOLDER content",
    "         -D  delete FOLDER",
    "         -a  assign FOLDER name to current directory",
    "         -H  more options and help",
  );

  $opt_h = $opt_H = $opt_d = $opt_D = $opt_z = $opt_s = $opt_r = $opt_l = 0;
  $opt_n = $opt_q = 0;
  $opt_m = $opt_i = $opt_X = $opt_a = $opt_f = '';

  $_ = "$fexhome/config.pl"; require if -f;

  getopts('hHvnqdDlzrsi:m:X:a:f:') or die $usage;
  if ($opt_a) {
    die $usage if $opt_s+$opt_r+$opt_l+$opt_D;
  } else {
    die $usage if $opt_s+$opt_r+$opt_l+$opt_D+$opt_h+$opt_H != 1;
  }

} else {

  $usage = ljoin(
    "$prg: send or receive new files",
    "send usage:    $prg [-c] DIRECTORY",
    "receive usage: $prg [-d] TNAME TKEY [FEXSERVER FEXUSER]",
    "options: -c  continuous syncing",
    "         -d  delete extraneous files",
    "send example:    $prg videos",
    "receive example: $prg videos 419027 fex.belwue.de:443 framstag",
    "help: $prg -H",
  );

  $opt_h = $opt_H = $opt_v = $opt_d = $opt_z = $opt_c = $opt_q = 0;
  $opt_w = 66;
  $opt_m = $opt_i = $opt_C = $opt_X = '';

  $_ = "$fexhome/config.pl"; require if -f;

  getopts('hHvzcqdi:C:w:m:X:') or die $usage;

  $opt_c ||= $opt_C;
}

if ($opt_m =~ /^\d+$/) {
  push @fexsend,'-m',$opt_m;
  push @fexget, '-m',$opt_m;
  push @fexsync,'-m',$opt_m;
} elsif ($opt_m) {
  die $usage;
}

push @fexsend,'-q' if $opt_q;

if ($opt_X) {
  $exclude .= '|'.$opt_X;
}

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

if ($opt_H) {
  open $fexsync,$fexsync or die "$fexsync: $!\n";
  while (<$fexsync>) {
    last if /$prg/;
  }
  s/^# ?//;
  $help = $_;
  while (<$fexsync>) {
    if (s/^# ?//) {
      $help .= $_;
    } else {
      last;
    }
  }
  print $help;
  exit;
}

if ($dox) {
  if ($prg =~ /doxx/) {
    $ENV{FEXID} = $ENV{FEXXX}||'' or $opt_i = 'xx';
  }
  &getfid;
  unless ($id) {
    die "$prg: no FEXID\n";
  }
  $ENV{FEXID} = "$fexcgi $user $id"; # for fexsend
}

if ($dox and $opt_l) {
  if (@ARGV) {
    my $folder = shift;
    push @fexsend,'-~',"DOXLIST:$folder";
    warn "\$ @fexsend|\n" if $opt_v;
    open my $fexsend,'-|',@fexsend or exit $?;
    while (<$fexsend>) {
      if (/^(\d+) (.+)/) {
        my @d = localtime($1);
        printf "%d-%02d-%02d %02d:%02d:%02d %s\n",
                $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0],hexdecode($2);
      } else {
        print;
      }
    }
    exit;
  } else {
    vexec(@fexsend,qw'-~ DOXLIST');
  }
}

if ($dox and $opt_D) {
  if (scalar(@ARGV) != 1) {
    die "usage: $prg -d DIRECTORY\n";
  }
  $_ = "@ARGV";
  s:/+$::;
  s:.*/+::;
  vexec(@fexsend,'-~',"DOXDEL:$_");
}

if ($dox and length($opt_a)) {
  unless (-d '.fexdox') {
    mkdir '.fexdox' or die "$prg: cannot mkdir .fexdox - $!\n";
  }
  my $ff = '.fexdox/folder';
  unlink $ff;
  $opt_a =~ s/[^$afnc]/_/g;
  $opt_a =~ s/^\./_/;
  warn "\$ ln -s $opt_a $ff\n" if $opt_v;
  symlink $opt_a,$ff
    or die "$prg: cannot symlink $ff - $!\n";
  system qw"ls -l",$ff;
  exit;
}

if (@ARGV) {
  $_ = "@ARGV";
} else {
  die $usage;
}

# fexdox upload
if ($dox and $opt_s) {

  $mode = 'send';

  unless (scalar(@ARGV) == 1 or scalar(@ARGV) > 1 and $ARGV[0] eq '.') {
    die $usage;
  }

  # doxurl argument?
  if (m!^(https?)://!) {

    # as DOX user
    my $doxurl = shift;

    if (scalar(@ARGV) != 1) {
      die "usage: $prg -s DOXURL DIRECTORY <<<USER:PASSWORD\n";
    }

    my $ldir = shift;
    chdir $ldir or die "$prg: $ldir - $!\n";

    &get_xp;

    my $tdir;
    if ($ldir eq '.') {
      $tdir = $ldir;
    } else {
      $tdir = basename(getcwd('.'));
      chdir '..';
    }


    if ($doxurl =~
        m!^(https?)://([\w.-]+)(:(\d+))?(/dox\w*/([^\s/]+\@[^\s/]+)/(\S+))!)
    {
      $proto = $1;
      $server = $2;
      $port = $4||80;
      my $uri = $5;
      my $owner = $6;
      my $dir = $7;
      $port = 443 if $proto eq 'https';
      # $doxurl = $_;

      $uri =~ s:/*$:?ACTION=userlist:;

      my $folder = $dir;
      $folder =~ s:/.*::;

      my $user = my $password = '';
      my $okey;

      if (-t STDIN) {
        print "user: ";
        $user = <STDIN>||'';
        chomp $user;
        exit unless length($user);
        if ($user =~ /(\S+):(\S+)/) {
          $user = $1;
          $password = $2;
        } else {
          print "password: ";
          $password = <STDIN>||'';
          chomp $password;
          exit unless length($password);
        }
      } else {
        $auth = <STDIN>||'';
        chomp $auth;
        if ($auth =~ /(\S+):(\S+)/) {
          $user = $1;
          $password = $2;
        } else {
          die "usage: $prg -s DOXURL DIRECTORY <<<USER:PASSWORD\n";
        }
      }

      $auth = encode_b64("$user:$password");

      &serverconnect;
      sendrequest("GET $uri","Authorization: Basic $auth");
      &checkreply;

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

      my %sfiles = ();

      while (<$SH>) {
        s/\r?\n//;
        warn "<-- $_\n" if $opt_v;
        if (/^(\d+) (\S+)/) {
          $sfiles{hexdecode($2)} = $1;
        }
      }

      close $SH;

      $uri =~ s/=userlist$/=okey/;

      &serverconnect;
      sendrequest("GET $uri","Authorization: Basic $auth");
      &checkreply;

      while (<$SH>) {
        s/\r?\n//;
        warn "<-- $_\n" if $opt_v;
        $okey = $1 if /^okey=(\S+)/;
      }
      unless ($okey) {
        die "$prg: no okey reply from $server\n";
      }

      my $transfer = sprintf 'fexdox_%s_%d',$folder,time;
      my @files = ();
      $t0 = time;
      %files = ();
      collect($tdir);
      &unweed;
      &exclude;
      foreach (asort(keys %files)) {
        if (-l or -f) {
          next if m:(^|/)[.#]|~$:;
          next if $files{$_} >= $t0;
          next if $sfiles{$_} and $sfiles{$_} >= $files{$_};
          push @files,$_;
        }
      }

      my $flist = sprintf '%s/.fex/tmp/%s',$ENV{HOME},$transfer;
      mkdirp(dirname($flist));
      open $flist,'>',$flist or die "$prg: cannot write $flist - $!\n";
      foreach (@files) {
        print {$flist} $_,"\n";
      }
      close $flist;

      my $fup = $doxurl;
      $fup =~ s:/dox.*:/fup?to=$owner?okey=$okey:;
      push @fexsend,'-k','1';
      push @fexsend,'-C',"DOX:UPLOAD=$user";
      push @fexsend,'-A',"$transfer.taz";
      push @fexsend,"[$flist]",$fup;
      my $status = 0;
      if ($opt_n) {
        warn "\$ @fexsend\n" if $opt_v;
        if (open $flist,$flist) {
          print while <$flist>;
          close $flist;
        }
      } else {
        vsystem(@fexsend);
        $status = $?;
      }
      unlink $flist;
      exit $status;

    } else {
      die "$prg: $_ is not a DOX URL\n";
    }

  } else {

    # as DOX owner

    $dir = shift;
    $dir =~ s:/+$::;

    if (scalar(@ARGV) > 1 ) {
      if ($dir eq '.') {
        if ($opt_d) {
          die "usage: $prg -s [-m MAX] [-z] [-f FOLDER] . FILES...\n";
        }
      } else {
        die "usage: $prg -s [-m MAX] [-z] [-f FOLDER] [-d] DIRECTORY\n".
          "usage: $prg -s [-m MAX] [-z] [-f FOLDER] . FILES...\n";
      }
    }
    unless (-d $dir) {
      if ($dir eq basename(getcwd)) {
        $dir = '.';
      } else {
        die "$prg: no such directory $dir\n";
      }
    }
    chdir $dir or die "$prg: cannot cd $dir - $!\n";

    &get_xp;

    # do not upload DOX user upload directory back again
    $_ = '/.upload';
    $xp{$_} = shp2prx($_);

    &getfid;
    unless ($id) {
      die "$prg: no FEXID found, use \"$fexsend -I\"\n";
    }

    if (length($opt_f)) {
      $transfer = $opt_f;
    } else {
      $transfer = readlink('.fexdox/folder')||'';
    }

    unless (length($transfer)) {
      $transfer = basename(getcwd);
      $transfer =~ s/_$vp$//;
    }
    $transfer =~ s/[^$afnc]/_/g;
    $transfer =~ s/^\./_/;

  }

}

# fexdox download
elsif ($dox and $opt_r) {

  if (m!^(https?)://!) {

    if (m!^(https?)://([\w.-]+)(:(\d+))?(/dox\w*/[^\s/]+\@[^\s/]+/(\S+))!) {
      $proto = $1;
      $server = $2;
      $port = $4||80;
      $uri = $5;
      $dir = $6;
      $port = 443 if $proto eq 'https';
      # $doxurl = $_;
      $uri =~ s:/*$:?ACTION=syncit:;

      if (-t STDIN) {
        my $user = my $password = '';
        print "user: ";
        $user = <STDIN>;
        exit unless defined $user;
        chomp $user;
        $user = 'anonymous' if $user eq '';
        if ($user =~ s/:(\S+)//) {
          $password = $1;
        } elsif ($user ne 'anonymous') {
          print "password: ";
          $password = <STDIN>||'';
          chomp $password;
        }
      } else {
        $auth = <STDIN>||'';
        chomp $auth;
        if ($auth =~ /^anonymous(:.*)?$/) {
          $user = 'anonymous';
        } elsif ($auth =~ /(\S+):(\S+)/) {
          $user = $1;
          $password = $2;
        } else {
          die "usage: $prg -r DOXURL<<<USER:PASSWORD\n";
        }
      }

      $auth = encode_b64("$user:$password") if length($password);
      push @fexsync,'-v'        if $opt_v;
      push @fexsync,'-z'        if $opt_z;
      push @fexsync,'-d'        if $opt_d;
      push @fexsync,'-m',$opt_m if $opt_m;

      &serverconnect;
      if ($auth) {
        sendrequest("GET $uri","Authorization: Basic $auth");
      } else {
        sendrequest("GET $uri");
      }
      &checkreply;

      while (<$SH>) {
        s/\r?\n//;
        warn "<-- $_\n" if $opt_v;
        if (/^\s*fexsync (\S+) (\d+) (\S+) (\S+)/) {
          if ($opt_n) {
            warn "\$ @fexsync $1 $2 $3 $4\n" if $opt_v;
            exit;
          } else {
            vexec(@fexsync,$1,$2,$3,$4);
            exit $?;
          }
        }
      }
      die "$prg: no fexsync reply from $server\n";
    } else {
      die "$prg: $_ is not a DOX URL\n";
    }

  } else {

    $_ = basename(getcwd) if $_ eq '.';
    s/[^$afnc]/_/g;
    s/^\./_/;
    $folder = $_;
    $folder = $_;
    $user = $id = '';
    &getfid;
    unless ($id) {
      die "$prg: no FEXID found, use \"$fexsend -I\"\n";
    }

    push @fexsync,'-v' if $opt_v;
    push @fexsync,'-d' if $opt_d;

    push @fexsend,'-~',"DOXSYNC:$user:$folder".($opt_z ? ':COMPRESS' : '');
    warn "\$ @fexsend\n" if $opt_v;
    exit if $opt_n;

    open my $fexsend,'-|',@fexsend or exit $?;
    while (<$fexsend>) {
      if (/^fexsync (\S+) (\d+) (\S+) (\S+)/) {
        vexec(@fexsync,$1,$2,$3,$4);
      }
    }
    die "$prg: failed: @fexsend\n";
  }

  exit;

}

# fexsync : # receive directory
elsif (/^:$/) {

  $mode = 'receive:';

  $sdir = $dir = abs_path('.');
  die "$prg: $dir is not writable\n" unless -w $dir;

  &getfid;
  unless ($id) {
    die "$prg: no FEXID found, use \"$fexsend -I\"\n";
  }

  $transfer = basename($dir);
  $tkey = '000000';

} elsif (/ \d+\b/) {

  # single receiving

  $mode = 'receive';

  ($transfer,$tkey,$fexcgi,$user) = split;

  if ($transfer eq '.') {
    $transfer = basename(getcwd);
  }

  &getfid unless $user;

  $sdir = abs_path('.');

  $_ = basename(getcwd);
  s/\./\000/g;
  s/[^\000$afnc]/./g;
  s/\000/\\./g;
  s/\+/\\+/g;
  if ($transfer !~ /^$_$/) {
    unless (-e $transfer) {
      mkdir $transfer or die "$prg: cannot mkdir $transfer - $!\n";
    }
    chdir $transfer or die "$prg: cannot chdir $transfer - $!\n";
  }

  $dir = abs_path('.');
  die "$prg: $dir is not writable\n" unless -w $dir;

} elsif (/ (\w+)/ and $1 =~ /[a-z]/i) {

  # continuous receiving

  $dir = abs_path('.');
  die "$prg: $dir is not writable\n" unless -w $dir;

  ($transfer,$stream,$fexcgi,$user) = split;
  &getfid unless $user;
  die "$prg: unknown fexuser\n" unless $user;
  $fexcgi =~ s:/fup.*::;
  my $sex = "$sexget -q $fexcgi/$user:public $stream|";
  push @fexsync,'-d' if $opt_d;

  for (my $n = 1; $n<99; $n++) {
    warn "\$ $sex\n" if $opt_v;
    $spid = open $sex,$sex or die "$prg: cannot start $sexget - $!\n";
    my $t = <$sex>;
    if (defined $t) {
      chomp $t;
      if ($t ne $transfer) {
        die "$prg: wrong transfer $t offered in stream $stream\n";
      }
      $n = 0;

      my $dir = basename(getcwd);
      $dir =~ s/[^$afnc]/_/g;
      if ($dir ne $transfer) {
        unless (chdir $transfer) {
          mkdir $transfer or die "$prg: cannot mkdir $transfer - $!\n";
          chdir $transfer or die "$prg: cannot chdir $transfer - $!\n";
        }
      }
      $dir = getcwd;
      unless (-w $dir) {
        die "$: no write permission in $dir\n";
      }
      print "syncing to $dir/\n";

      while (<$sex>) {
        chomp;
        if (/^-$/) {
          printf "\n[%s]\n",isodate(time);
          print "end of stream\n";
          exit;
        }
        printf "\n[%s]\n",isodate(time);
        vsystem(@fexsync,$transfer,$_,$fexcgi,$user);
      }
    }
    close $sex;
    my $wait = int($opt_w*1.1);
    warn "$prg: $fexcgi has closed the connection\n";
    warn "$prg: retrying after $wait seconds\n";
    sleepwait($wait);
  }
  die "$prg: giving up\n";

} else {

  $mode = 'send';

  # hidden feature for testing: DIRECTORY#TKEY
  s/#(\d+)$// and $tkey = $1;

  $dir = $_;

  unless (-d $dir) {
    if ($dir eq basename(getcwd)) {
      $dir = '.';
    } else {
      die "$prg: no such directory $dir\n";
    }
  }

  chdir $dir or die "$prg: $dir - $!\n";

  $user = $id = '';
  &getfid;
  unless ($id) {
    die "$prg: no FEXID found, use \"$fexsend -I\"\n";
  }

  $transfer = basename(getcwd);
  $transfer =~ s/_$vp$//;
  $transfer =~ s/[^$afnc]/_/g;

  if ($opt_c) {
    $stream = $opt_C||randstring(8);
    &preparevars;
    $dir = basename(getcwd) if $dir eq '.';

    my $sex = "|$sexsend -q public $stream";

    {
      my @fexsync = @fexsync;
      $fexsync[0] =~ s:.*/::;
      push @fexsync,'-d';
      push @fexsync,'-v' if $opt_v;
      print "to start sync receiving use:\n";
      print "  @fexsync $transfer $stream $server:$port $user\n\n";
    }

    for (my $n = 1; $n<99; $n++) {
      warn "$sex\n" if $opt_v;

      local $SIG{INT} = 'IGNORE';
      $spid = open $sex,$sex or die "$prg: cannot start $sexsend - $!\n";
      autoflush $sex 1;
      warn $transfer,"\n" if $opt_v;
      print {$sex} $transfer,"\n";

      local $SIG{INT} = sub {
        $^W = 0;
        print {$sex} "-\n";
        close $sex;
        print "\n";
        exit;
      };

      push @fexsync,'-z' if $opt_z;

      my %ofiles = ();
      while ($sex) {
        my $change = 0;
        $t0 = time;
        %files = ();
        print "searching new files...      " unless $opt_q;
        collect('.');
        print "\r                        \r" unless $opt_q;
        # new or modified files?
        foreach my $file (keys %files) {
          next if $files{$file} >= $t0;
          if ($files{$file} != ($ofiles{$file}||0)) {
            $change = 1;
            last;
          }
        }
        # deleted files?
        foreach my $file (keys %ofiles) {
          unless ($files{$file}) {
            $change = 1;
            last;
          }
        }
        if ($change) {
          %ofiles = %files;
          printf "[%s]\n",isodate(time);
          warn "\$ @fexsync $dir\n" if $opt_v;
          if (open $fexsync,"@fexsync $dir|") {
            local $SIG{ALRM} = sub {
              close $sex;
              undef $sex;
              warn "$prg: SEX timeout\n";
            };
            while (<$fexsync>) {
              warn $_ if $opt_v;
              if (/fexsync $transfer (\d+)/) {
                alarm(3);
                if (print {$sex} $1,"\n") {
                  $n = 0;
                } else {
                  close $sex;
                  undef $sex;
                }
                alarm(0);
              }
            }
            close $fexsync;
            print "\n";
          } else {
            exit $?;
          }
        }
        if ($sex) {
          sleepwait($opt_w,'waiting for new files... ');
        }
      }
      warn "$prg: $fexcgi has closed the connection\n";
      warn "$prg: retrying after $opt_w seconds\n";
      sleepwait($opt_w);
    }

    die "$prg: giving up\n";
  }
}

$t0 = time;
%files = ();
print "scanning files...\n" unless $opt_q;

if ($dox and $opt_s and @ARGV) {
  collect(@ARGV);
} else {
  collect('.');
}

if ($dox and $opt_s) {
  &unweed;
  &exclude;
}

if ($DEBUG) {
  print "local files:\n";
  foreach $file (asort(keys %files)) {
    printf "%s %s\n",isodate($files{$file}),$file;
  }
}

&preparevars;


#   fexsync : # receive directory
if ($mode =~ /^receive(:?)/) {
  my $qr = $1;

  &get_xp;
  &exclude;

  print "connecting server...\n" unless $opt_q;
  &serverconnect;

  if ($qr) {
    $sid = &query_sid;
    sendrequest("POST /ccc?user=$user&tkey=$tkey&transfer=$transfer&ID=$sid");
  } else {
    sendrequest("POST /ccc?user=$user&tkey=$tkey&transfer=$transfer");
  }

#  warn "--> (local files list)\n" if $opt_v and %files;
  foreach $file (asort(keys %files)) {
    printf {$SH} "%s %s\n",$files{$file},$file;
    warn sprintf("--> %s %s\n",$files{$file},$file) if $opt_v;
  }
  printf {$SH} "\n";

  print "waiting for download...\n";
  &checkreply;
  while (<$SH>) {
    s/\r?\n//;
    warn "<-- $_\n" if $opt_v;
    last unless length;
    $durl = $1 if /^Location: (http.+)/;
  }
  %sfiles = ();
  while (<$SH>) {
    if (/^(\d+) (.+)/) {
      warn "<-- $_" if $opt_v;
#      warn "<-- (remote files list)\n" if $opt_v and not %sfiles;
      $sfiles{$2} = $1;
    } else {
      last;
    }
  }
  if ($durl) {
    if (-x $fexget[0]) {
      vsystem("@fexget -oX $durl");
    } else {
      if ($opt_m) {
        vsystem("$wget -c --limit-rate=${opt_m}k $durl");
      } else {
        vsystem("$wget -c $durl");
      }
    }
    my $a = basename($durl);
    if (-s $a) {
      my $tar = 'tar';
      $tar .= ' -z' if $a =~ /\.tgz$/;
      if (-x $del) {
        open $tar,"($tar -Oxvf $a 3>&2 2>&1 1>&3) 2>/dev/null |";
        while (<$tar>) {
          chomp;
          vsystem($del,$_) if lstat;
        }
        close $tar;
      }
      if ($dir eq $sdir) {
        print "extracting:\n";
      } else {
        print "extracting in $dir :\n";
      }
      vsystem("$tar -xvf $a && rm $a");
    }
    if ($opt_d and %sfiles) {
      my $xd = abs_path('.');
      foreach $file (asort(keys %files)) {
        unless ($sfiles{$file}) {
          unless ($deleted) {
            if ($dir eq $sdir) {
              print "removing extraneous files:\n"
            } else {
              print "removing extraneous files in $xd :\n"
            }
          }
          $deleted++;
          $file = hexdecode($file);
          if (-x $del) {
            print "$file\n" unless $opt_v;
            vsystem($del,$file);
          } else {
            print "$file\n";
            unlink $file;
          }
        }
      }
      rmdirr('.');
    }
  } else {
    die "$prg: no download URL in server reply\n";
  }
  exit;
}

if ($mode eq 'send') {

  # $SIG{PIPE} = \&sigpipehandler;

  die "$prg: no files in $dir\n" unless %files;

  if ($dox) {

    # fexdox first stage with SEX
    print "server/user: $fexcgi/$user\n" unless $opt_q;

    # my @x = asort(keys(%files)); die "@x";

    my $fexsend = "@fexsend -~ DOXLIST:$transfer";
    warn "\$ $fexsend|\n" if $opt_v;
    exit if $opt_n;
    if (open $fexsend,"$fexsend 2>/dev/null|") {
      while (<$fexsend>) {
        if (/^(\d+) (.+)/) {
          warn "<-- $_" if $opt_v;
          if ($files{$2} and $1 >= $files{$2}) {
            delete $files{$2};
          }
        }
      }
    }

    if (my @files = keys %files) {
      my $tar;
      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';
      foreach (@files) {
        $_ = hexdecode($_);
        if (my $s = -s) {
          if (/\.($cfx)$/i) {
            $cf += $s;
          } else {
            $uf += $s;
          }
        }
      }
      if ($uf+$cf < 2**31 and $uf/$cf > 0.2) {
        $tar = 'tar -cvzf -';
      } else {
        $tar = 'tar -cvf -';
      }
      my $flist = sprintf '%s/.fex/tmp/%s',$ENV{HOME},$transfer;
      mkdirp(dirname($flist));
      open $flist,'>',$flist or die "$prg: cannot write $flist - $!\n";
      foreach (asort(@files)) {
        print {$flist} "$_\n";
      }
      close $flist;
      print "streaming files:\n" unless $opt_q;
      my $opts = '';
      $opts = '-g' if not $opt_q and -t STDOUT;
      $opts .= " -m $opt_m" if $opt_m;
      my $sync = "$tar -T '$flist' | $sexsend $opts DOX $transfer";
      if (open my $sync,"($sync)2>&1|") {
        while (<$sync>) {
          if (/^\S+: /) {
            warn $_;
          } else {
            if ($opt_q) {
            } else {
              if (/^\d.* kB\/s\s/) {
                s/\n/\r/;
              } else {
                s/$/                    / if length($_) <20;
              }
              print;
            }
          }
        }
        close $sync;
      }
    }

    $t0 = time;
    %files = ();
    if (@ARGV) {
      collect(@ARGV);
    } else {
      collect('.');
    }
    &unweed;
    &exclude;

  }

  print "connecting server...\n" unless $opt_q;
  &serverconnect;

  $sid = &query_sid;
  $request = "POST /ccc?user=$user&ID=$sid";
  if ($dox) {
    $request .= "&dox=$transfer";
  } else {
    $request .= "&transfer=$transfer";
    $request .= "&tkey=$tkey" if $tkey; # hidden feature for testing
  }
  sendrequest($request);
#  warn "--> (local files list)\n" if $opt_v;
  foreach $file (asort(keys %files)) {
    printf {$SH} "%s %s\n",$files{$file},$file;
    warn sprintf("--> %s %s\n",$files{$file},$file) if $opt_v;
 }
  printf {$SH} "\n";

  &checkreply;

  while (<$SH>) {
    s/\r?\n//;
    warn "<-- $_\n" if $opt_v;
    last unless length;
    if (/^Location: (.+)#(\d+)$/) {
      $transfer = $1;
      $tkey = $2;
    }
  }

  if ($tkey) {
    unless ($opt_q or $dox) {
      my $dir = basename(getcwd);
      print "to start sync receiving with FEXID use:\n";
      print "  cd $dir\n";
      print "  $prg :\n";
      print "to start sync receiving without FEXID use:\n";
      print "  $prg $transfer $tkey $server:$port $user\n";
    }
  } else {
    die "$prg: no tkey in server response\n";
  }

  &serverconnect;
  $sid = &query_sid;
  $request = "GET /ccc?user=$user&ID=$sid&transfer=$transfer&tkey=$tkey";
  $request =~ s/&transfer=/&dox=/ if $dox;
  sendrequest($request);
  &checkreply;

  while (<$SH>) {
    s/\r?\n//;
    warn "<-- $_\n" if $opt_v;
    last unless length;
  }

  # warn "<-- (remote files list)\n" if $opt_v;
  while (<$SH>) {
    if (/^(\d+) (.+)/) {
      warn "<-- $_" if $opt_v;
      $time = $1;
      $file = $2;
      if ($files{$file} and $time >= $files{$file}) {
        delete $files{$file};
      }
    } else {
      last;
    }
  }
  close $SH;

  $tmpdir = $fexhome.'/tmp';
  mkdir $fexhome;
  mkdir $tmpdir;
  if ($dox) {
    $flist  = sprintf '%s/fexdox_%s.list',$tmpdir,$transfer;
    my $cmd = sprintf '%s/fexdox_%s.sh',  $tmpdir,$transfer;
    if (-f $flist and -x $cmd) {
      warn "$prg: found ancient $cmd\n";
      exit 1 if $opt_n;
      if (-t STDIN) {
        print "resume? ";
        $_ = <STDIN>||'';
        exit if /^n/i;
      }
      vsystem($cmd);
      exit $? if -f $cmd;
      warn "$prg: resyncing...\n";
      vexec(@CMD);
    }
  } else {
    my @s = stat('.') or die "$prg: $dir - $!\n";
    $flist = sprintf '%s/fexsync_%s_%d%d.list',$tmpdir,$transfer,$s[0],$s[1];
  }

  open $flist,'>',$flist or die "$prg: cannot create $flist - $!\n";
#  print "new/modified files:\n" if %files;
  foreach $file (asort(keys %files)) {
    next if $files{$file} >= $t0;
    print {$flist} hexdecode($file),"\n";
  }
  close $flist;

  # must send empty flist archive, too,
  # because fexsync receive client waits for it!
  my $x = 'locale=english&autodelete=yes&keep=1';
  my $a = sprintf "fexsync_%s_%s.%s",$transfer,$tkey,$opt_z ? 'tgz' : 'taz';
  if ($dox and $flist =~ /(.+)\.list$/) {
    my $job = $1;
    my $cmd = "$1.sh";
    my $c = 'DOX';
    $c .= ':ADD'    if $dox and $opt_s and @ARGV;
    $c .= ':DELETE' if $opt_d;
    $fexsend = qq'@fexsend -X "$x" -A $a -C $c "[\$job.list]" .';
    $dir = getcwd;
    open $cmd,'>',$cmd or die "$prg: cannot write $cmd - $!\n";
    print {$cmd} "#!/bin/bash -e\n";
    print {$cmd} "job=$job\n";
    print {$cmd} "cd $dir\n";
    print {$cmd} "$fexsend\n";
    print {$cmd} "rm \$job.list \$job.sh\n";
    close $cmd;
    chmod 0700,$cmd;
    $fexsend =~ s/\$job/$job/;
    if ($opt_n) {
      if (open $flist,$flist) {
        warn "transfer files:\n";
        print while <$flist>;
        close $flist;
      }
      open $flist,'>',$flist;
      close $flist;
    }
    vsystem($fexsend);
    if ($? == 0) {
      unlink $flist,$cmd;
    } else {
      die "\n".
        "$prg: fexsend failed, you can restart it with:\n".
        "$cmd\n";
    }
  } else {
    vsystem(@fexsend,'-X',$x,'-A',$a,"[$flist]",'+');
  }
}

exit;


sub getfid {
  my $idf = "$fexhome/id";
  $fexcgi = $user = $id = '';

  # if (not $opt_i and $FEXID = $ENV{FEXID}||$ENV{FEXXX}) {
  if (not $opt_i and $FEXID = $ENV{FEXID}) {
    $FEXID = decode_b64($FEXID) if $FEXID !~ /\s/;
    $ENV{FEXID} = $FEXID; # for fexsend
    ($fexcgi,$user,$id) = split(/\s+/,$FEXID);
  } else {
    if (open $idf,$idf) {
      if ($opt_i) {
        while (<$idf>) {
          if (/^\[$opt_i\]/) {
            chomp($fexcgi = <$idf>) or die "$prg: no FEX-URL in [$opt_i] $idf\n";
            chomp($user = <$idf>)   or die "$prg: no FROM in [$opt_i] $idf\n";
            chomp($id = <$idf>)     or die "$prg: no ID in [$opt_i] $idf\n";
            push @fexsend,'-i',$opt_i;
          }
        }
        unless ($fexcgi) {
          die "$prg: id [$opt_i] not found in $idf\n";
        }
      } else {
        chomp($fexcgi = <$idf>) or die "$prg: no FEX-URL in $idf\n";
        chomp($user = <$idf>)   or die "$prg: no FROM in $idf\n";
        chomp($id = <$idf>)     or die "$prg: no ID in $idf\n";
      }
      close $idf;
      despace($fexcgi,$user,$id);
      if ($fexcgi !~ /^[\w\/.:-]+$/) {
        die "$prg: illegal FEX-URL \"$fexcgi\" in $idf\n";
      }
      if ($user !~ /^[\w\/\@.:%=+-]+$/) {
        die "$prg: illegal FROM \"$user\" in $idf\n";
      }
    }
    $fexcgi =~ s:/fup.*::;
  }
  if ($ENV{FEXSERVER} and not $ENV{GATEWAY_INTERFACE} and not $opt_i) {
    $fexcgi = $ENV{FEXSERVER};
  }
}


sub serverconnect {
  close $SH if $SH;

  if ($port == 443) {
    if ($DEBUG and %SSL) {
      foreach my $v (keys %SSL) {
        printf "%s => %s\n",$v,$SSL{$v};
      }
    }

    &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 "cannot connect $server:$port - $!\n" unless $SH;
  warn "TCPCONNECT to $server:$port\n" if $opt_v;
}


sub despace {
  foreach (@_) {
    s/^\s+//;
    s/\s+$//;
  }
}


sub query_sid {
  my $req;
  local $_;
  my $sid = $id;

  if ($port ne 443) {
    sendrequest("GET /SID");
    &checkreply;
    if (/^HTTP.* 201 (.+)/) {
      $sid = 'MD5H:'.md5_hex($id.$1);
      while (<$SH>) {
        s/\r//;
        warn "<-- $_" if $opt_v;
        last if /^\n/;
      }
    } else {
      die "$prg: $server does not support session ID\n";
    }
  }

  return $sid;
}


sub sigpipehandler {
  local $_ = '';
  $SIG{ALRM} = sub { };
  alarm(1);
  $_ = <$SH>||'';
  if (/^HTTP.* \d+ (.*)/) {
    if ($opt_v) {
      die "\n$prg: server error: @_\n";
    } else {
      die "\n$prg: server error: $1\n";
    }
  } else {
    die "\n$prg: got SIGPIPE (server closed connection)\n";
  }
}


# collect all regular files and symlinks with mtime
sub collect {
  my $DIR;
  my ($dir,$file);
  local $_;

#  warn "collect @_";
  foreach $dir (@_) {
    if (-l $dir or -f $dir) {
      $file = $dir;
      if (-l $file or -r $file) {
        if (my @s = lstat $file) {
          # using ctime is a stupid idea because it is also inode creation time
          # $files{$file} = $s[10] > $s[9] ? $s[10] : $s[9];
          $files{hexencode($file)} = $s[9];
        }
      } else {
        warn "$prg: cannot read $::dir/$file\n";
        $error++;
      }
    } elsif (opendir $DIR,$dir) {
      my @files = ();
      while (defined(my $file = readdir $DIR)) {
        next if $file =~ /^\.\.?$/;
        next if $file =~ /^($exclude)$/;
        $file = "$dir/$file";
        $file =~ s:^\./::;
        next if $file =~ /^($exclude)$/;
        if ($file =~ s/\n/?/g) {
          warn "$prg: ignoring file with newline character in filename: $file\n";
          next;
        }
        push @files,$file;
      }
      closedir $DIR;
      collect(@files);
    } else {
      warn "$prg: cannot open $::dir/$dir/ - $!\n";
      $error++;
    }
  }
}


sub isodate {
  my @d = localtime shift;
  return sprintf('%d-%02d-%02d %02d:%02d:%02d',
                 $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
}


sub sendrequest {
  my $request = shift;
  my @head;

  push @head,"$request HTTP/1.1";
  push @head,"Host: $server:$port";
  push @head,"User-Agent: $useragent";
  push @head,@_ if @_;

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


sub checkreply {
  $_ = <$SH>;
  die "$prg: no server reply\n" unless $_;
  s/\r?\n//;
  warn "<-- $_\n" if $opt_v;
  unless (/^HTTP.... 2\d\d /) {
    s/^HTTP.... \d\d\d //;
    die "$prg: server error: $_\n"
  }
  s/\r//;
  return $_;
}


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 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 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 encode_b64 {
  local $_ = '';

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

  return $_;
}


sub hexencode {
  local $_ = shift;
  s/%/%25/g;
  s/([^!-~])/sprintf "%%%X",ord($1)/ige;
  return $_;
}


sub hexdecode {
  local $_ = shift;
  s/%([a-f0-9]{2})/chr(hex($1))/ige;
  return $_;
}


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;
  }
}


sub preparevars {
  $transfer =~ s/[^$afnc]/_/g;
  $transfer =~ s/^\./_/;

  $fexcgi =~ s(^http://)()i;
  $server = $fexcgi;

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

  $server =~ s([:/].*)();
}


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 shellquote {
  local $_ = shift;
  s/([^\w\@\/!^%:_.,=+-])/\\$1/g;
  return $_;
}


sub get_xp {
  my $ux = '.fexdox/exclude';
  local $_;

  $xp{$ux} = shp2prx($ux);

  if (open $ux,$ux) {
    while (<$ux>) {
      chomp;
      $xp{$_} = shp2prx($_);
    }
    close $ux;
    $_ = '.fexdox/.versions/exclude~*~';
    $xp{$_} = shp2prx($_);
  }

  if (0) {
    while (my($p,$x) = each %xp) {
      printf "%s : %s\n",$p,$x;
    }
    die;
  }
}


# remove non-regular files (for dox)
sub unweed {
  local $_;
  foreach my $file (keys %files) {
    $_ = hexdecode($file);
    if (-l or not -f) {
      warn "excluded: $_\n" if $opt_v;
      delete $files{$file};
    }
  }
}


# dox exclude
sub exclude {
  foreach my $file (asort(keys %files)) {
    foreach my $p (asort(keys %xp)) {
      my $pp = $xp{$p};
      $pp = '.*/'.$pp if $pp !~ m:^/:;
      my $dfile = hexdecode($file);
      if ("/$dfile" =~ m:^$pp(/.*)?$:) {
        warn "excluded: $dfile ($p)\n" if $opt_v;
        delete $files{$file};
        last;
      }
    }
  }
}


# shell pattern to Perl regular expression
sub shp2prx {
  local $_ = shift;
  s:([^\w\[\]^/*?-]):\\$1:g;
  s:([^*])\*([^*]):$1\[^/\]*$2:g;
  s:([^*])\*$:$1\[^/\]*:;
  s:^\*([^*]):[^/]*$1:;
  s:\*\*:.*:g;
  s:\?:.:g;
  return $_;
}


# remove empty directories recursive
sub rmdirr {
  my $dir = shift;
  local $_;

  if (opendir $dir,$dir) {
    while (defined($_ = readdir($dir))) {
      next if /^\.\.?$/;
      $_ = "$dir/$_";
      rmdirr($_) if -d and not -l;
    }
    closedir $dir;
    rmdir $dir;
  }
}


sub sleepwait {
  my $wait = shift;
  my $comment = shift || '';

  for (my $i = $wait; $i; $i--) {
    printf "%s%3d\r",$comment,$i;
    sleep 1;
  }
  print "$comment   \r";
}


sub ljoin {
  return join("\n",@_)."\n";
}


sub mtime {
  my @s = stat shift;
  return @s ? $s[9] : 0;
}


sub mkdirp {
  my $dir = shift;
  my $pdir;

  return if -d $dir;
  $dir =~ s://+:/:g;
  $dir =~ s:/$::;
  die "$prg: cannot mkdir /\n" unless length($dir);
  $pdir = $dir;
  if ($pdir =~ s:(.+)/.+:$1:) {
    mkdirp($pdir) unless -d $pdir;
  }
  mkdir $dir or die "$prg: mkdir $dir - $!\n";
}


sub asort {
  return sort { lc $a cmp lc $b } @_;
}


END { kill 9,$spid if $spid }
