#!/usr/bin/perl -w

$help = <<'';
# F*EX push&pull archive sharing client with versioning.
#
# Needs fexsend, fexget, tar, zip, unzip and optional vv.
#
# Author: Ulli Horlacher <framstag@belwue.de>
#
# Source: http://fex.belwue.de/download/fex.pl
#
# Perl Artistic Licence
#
# fexpush puts files and directories into tar or zip archives and saves them
# on a F*EX server share. Pipe data (STDIN/STDOUT) can also stored.
#
# A share is a storage object on a F*EX server and comprises owner and user(s)
# and contains archives.
# You can obtain a share-URL from a share owner. For more information see
# http://fex.rus.uni-stuttgart.de/sharing.html
#
# A version date string is appended to the archive name.
# The version date is determinded by the newest file in the archive.
# The version date is always in UTC (gmtime) to allow international
# collaboration.
#
# With fexpull you can list your shares and archives and download them.
# The newest archive version will be autoselected when you omit the
# version string. When you name it, then exactly this archive version will
# be downloaded and a directory with this version name will be created.
# So you can have several versions in your local directory at the same time
# without interference.
#
# The archive will be written to STDOUT when you add argument "-"
#
# If you have owner or manage access right, you also can delete archives.
#
# fexpush ignores files or directories with a leading . unless you use option -.
# fexpush always ignores files or directories named .del and .snapshot*
#
# fexpull does not overwrite files which are newer.
#
# STDIN/STDOUT archives (pipe data) are prefixed with "_IO_"
#
# fexpush calls fexsend and fexpull calls fexget.
# You need to have them installed, too. Use the installer
# http://fex.belwue.de/download/fex.pl
#
# To use the special personal share "_" you need a F*EX account.
# Initialize it with "fexsend -I", for the very first time.
# This share is used as the default for push&pull.
#
# You can call fexpush as fexstore (via symbolic link) to use the special archive
# "_:_" as your extended internet clipboard.
#
# If you are a registered F*EX user, then use http://YOURFEXSERVER/fas
# to create or manage your share users and archives.
#
# Additional options:
#
#   -v       # verbose output
#   -n       # no real delete action, just show what would happen
#   -i ID    # use F*EX ID
#
# fexpush and fexpull respect the environment variable FEXID (see: fexsend -I)
# fexstore respects the environment variable FEXXX (see: xx -I)
#
# See also:
# http://fex.rus.uni-stuttgart.de/sharing.html
# http://fex.rus.uni-stuttgart.de/usecases/fexpush.html

# perl -MDebug::Trace=sharedata,queryshare,listshares ./fexpush -l blubb

use 5.010;
use Config;
use Cwd qw(abs_path getcwd);
use Digest::MD5 qw(md5_hex);
use Getopt::Std;
use File::Basename;
use Term::ReadLine;
use Sys::Hostname;

$| = 1;
$prg = $0;
$prg =~ s:(.*)/::;
$ENV{PATH} = $1.':'.$ENV{PATH};

$version = 20200429;

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

$ENV{FUA} = "fexpush-$version";

# chomp($hostname = `hostname -f`);
$host = $hostname = hostname();
$host =~ s/\..*//;
@pwu = getpwuid($<) or die "$prg: user unknown - $!\n";
$hostuser = $pwu[0];
$HOME = $pwu[7];
$sharedir = "$HOME/.fex/share";
$fid = "$HOME/.fex/id";
$MB = 2**20;
$fexid = $ENV{FEXID} || -s $fid;

if ($prg =~ /push/) {
  if ($fexid) {
    $usage = strip("
$prg ($version): push files or named STDOUT to F*EX share archive
help: $prg -H
see also: fexpull, fexsend

usage: $prg [-l] [-L] [SHARE]
usage: $prg [options] [SHARE:][ARCHIVE] FILE_OR_DIRECTORY...
usage: $prg SHARE-URL
usage: $prg -U SHARE:USER:ACCESS
usage: ... | $prg [options] [[SHARE:]NAME]

options:
  -l            list known shares or archives in SHARE
  -L            list known shares in long format
  -C 'COMMENT'  add COMMENT (with %u=user %h=host %H=host.domain)
  -# 'EXLIST'   exclude file pattern list (use # as list separator)
  -x            exclude directories on different file systems (tar archive only)
  -.            include .files
  -m MAX        limit upload to MAX kB/s
#  -F            use newest file date as archive version (default)
  -T            use current time instead of file date as archive version
  -s            keep symbolic links (default: dereference), arguments only
  -o            overwrite (delete all old versions)
  -U            add USER to SHARE with ACCESS right

arguments:
  SHARE         use SHARE on server (default is share _)
  ARCHIVE       name of ARCHIVE (may end with .tgz .tar .zip)
  VERSION       select VERSION of ARCHIVE
  SHARE-URL     save share configuration
  NAME          NAME of special STDOUT archive
  ACCESS        user ACCESS right read, write, add or manage

examples:
  $prg /usr/local/bin/usbmount
  $prg tux:images.tar *.jpg
  lshw | $prg -C 'for host %h' hardware-list
");
  } else {
    $usage = strip("
$prg ($version): push files or named STDOUT to F*EX share archive
help: $prg -H
see also: fexpull, fexsend

usage: $prg [-l] [-L] [SHARE]
usage: $prg [options] SHARE:ARCHIVE FILE_OR_DIRECTORY...
usage: $prg SHARE-URL
usage: ... | $prg [options] SHARE:NAME

options:
  -l            list known shares or archives in SHARE
  -L            list known shares in long format
  -C 'COMMENT'  add COMMENT (with %u=user %h=host %H=host.domain)
  -# 'EXLIST'   exclude file pattern list (use # as list separator)
  -.            include .files
  -m MAX        limit upload to MAX kB/s
#  -F            use newest file date as archive version (default)
  -T            use current time instead of file date as archive version
  -s            keep symbolic links (default: dereference), arguments only

arguments:
  SHARE         use SHARE on server
  ARCHIVE       name of ARCHIVE (may end with .tgz .tar .zip)
  SHARE-URL     save share configuration
  NAME          NAME of special STDOUT archive

examples:
  $prg -l
  $prg -l tux
  $prg tux:images.tar *.jpg
  lshw | $prg -C 'for host %h' lab:hardware-list
");
  }
  $opt_h = $opt_H = $opt_o = $opt_v = $opt_l = $opt_L = $opt_s = $opt_u = 0;
  $opt_T = $opt_F = $opt_U = $opt_c = $opt_n = $opt_x = 0;
  ${'opt_.'} = 0;
  $opt_i = $opt_m = $opt_C = '';
  ${'opt_#'} = '';
  getopts('hHlLovsucnxTFU.i:k:C:m:#:') or die $usage;
  $opt_l ||= $opt_L;

  if ($opt_T and $opt_F) {
    die "$prg: you cannot mix options -T and -F\n";
  }
  if (-t STDIN and not
      ($opt_l||$opt_L||$opt_h||$opt_H||$opt_U||$opt_u||$opt_o or @ARGV)) {
    die $usage;
  }

  if ($opt_x) {
    $ENV{TAR_OPTIONS} = '--one-file-system';
  }
} elsif ($prg =~ /pull/) {
  if ($fexid) {
    $usage = strip("
$prg ($version): pull files or named STDIN from F*EX share archive
help: $prg -H
see also: fexpush, fexget

usage: $prg [-u] [-l]
usage: $prg -l SHARE[:ARCHIVE[:VERSION]]
usage: $prg -L [SHARE]
usage: $prg -U SHARE
usage: $prg [-m MAX] [SHARE:]NUMBER [FILE...]
usage: $prg [-m MAX] [SHARE:][DIRECTORY/]ARCHIVE[:VERSION] [FILE...]
usage: $prg [-m MAX] [SHARE:]ARCHIVE[:VERSION] - | ...
usage: $prg [-m MAX] [[SHARE:]_IO_NAME] [-] [| ...]
usage: $prg [-d] NUMBER
usage: $prg -d [SHARE:]ARCHIVE[:VERSION]
usage: $prg -o SHARE:ARCHIVE
usage: $prg -c NUMBER [SHARE:]ARCHIVE
usage: $prg SHARE-URL

options:
  -l  list available shares, archives or archive content
  -L  list available shares or archives in long format
  -u  list URLs from share _
  -U  list SHARE users URLs
  -m  limit download to MAX kB/s
  -d  delete ARCHIVE (NUMBER)
  -o  delete all versions but one (keep latest)
  -c  copy archive version to other ARCHIVE in SHARE

arguments:
  SHARE       select SHARE on server (default is share _)
  ARCHIVE     select ARCHIVE from server
  VERSION     select VERSION of ARCHIVE
  NUMBER      select archive version by NUMBER
  DIRECTORY   extract ARCHIVE in DIRECTORY (default is ./)
  FILE        extract only FILE from ARCHIVE
  -           uncompress ARCHIVE and write to STDOUT/pipe
  _IO_NAME    name of special STDOUT archive
  SHARE-URL   save share configuration

examples:
  $prg             # list archives in share _
  $prg -l          # list known shares
  $prg -l lab      # list archives in share lab
  $prg -l 3        # show content of archive number 3
  $prg bunnies     # pull latest bunnies archive from share _
  $prg lab:data    # pull latest data archive from share lab
  $prg 3           # pull archive number 3
  $prg | less      # show STDOUT _IO_ from share _
");
  } else {
    $usage = strip("
$prg ($version): pull files from F*EX share archive
help: $prg -H
see also: fexpush, fexget

usage: $prg -l [SHARE[:ARCHIVE[:VERSION]]]
usage: $prg -L [SHARE]
usage: $prg [-m MAX] [SHARE:]NUMBER [FILE...]
usage: $prg [-m MAX] SHARE:ARCHIVE[:VERSION] [FILE...]
usage: $prg [-m MAX] SHARE:ARCHIVE[:VERSION] - | ...
usage: $prg [-m MAX] SHARE:_IO_NAME [-] [| ...]
usage: $prg SHARE-URL

options:
  -l          list available shares, archives or archive content
  -L          list available shares or archives in long format
  -m MAX      limit download to MAX kB/s

arguments:
  SHARE       select SHARE on server
  ARCHIVE     select ARCHIVE from server
  VERSION     select VERSION of ARCHIVE
  NUMBER      select archive version by NUMBER
  FILE        extract only FILE from ARCHIVE
  -           write ARCHIVE to pipe
  _IO_NAME    name of special STDOUT archive
  SHARE-URL   save share configuration

examples:
  $prg -l                    # list known shares
  $prg -l lab                # list share lab
  $prg -l 3                  # show content of archive number 3
  $prg lab:data              # pull latest data archive from share lab
  $prg 3                     # pull archive number 3
  $prg lab:_IO_blubb | less  # show STDOUT _IO_blubb from share lab
");
  }

  $opt_h = $opt_H = $opt_l = $opt_L = $opt_d = $opt_o = $opt_v = $opt_u = 0;
  $opt_c = $opt_n = 0;
  $opt_i = $opt_m = $opt_U = '';
  getopts('hHlLudovcni:m:U:') or die $usage;
  # $opt_l = -1 unless $opt_l||$opt_L||$opt_H||$opt_S or @ARGV or not -t STDOUT;
  $opt_l ||= $opt_L;

  die $usage if $opt_d and ($opt_l||$opt_u||$opt_U);
  die $usage if not (@ARGV or $fexid or $opt_U||$opt_o||$opt_l);
} elsif ($prg eq 'fexstore') {
  $fexstore = $prg;
  $usage = strip("
$prg ($version): store/retrieve data to/from your F*EX default share archive
see also: fexpush, fexpull, xxx

usage: $prg [-l] [-u] [-o]
usage: $prg FILE(s)
usage: $prg NUMBER
usage: $prg -d NUMBER(s)
usage: $prg -d 'REGEXP'
usage: $prg -D [DAYS]
usage: ... | $prg [-C 'COMMENT']
usage: $prg [NUMBER] | ...
options:
  -l  list available archives
  -u  show download URLs
  -d  delete archive(s)
  -D  delete all archives older than DAYS
  -o  delete all archives but one (keep latest)
  -C  add COMMENT
arguments:
  NUMBER      select archive by NUMBER
  REGEXP      select archive with REGular EXPression uploader or arguments
  FILE        store FILE(s) (and also directories)
examples:
  $prg *png    # store *png files
  lshw | $prg  # store hardware list
  $prg -l      # list archives
  $prg 3       # retrieve archive number 3
  $prg -       # retrieve last archive
  $prg -d test # delete all \"test\" archives
  $prg -D 2    # delete all archives older than 2 days
");
  $opt_h = $opt_H = $opt_v = $opt_l = $opt_u = $opt_o = $opt_D = $opt_d = 0;
  $opt_c = $opt_n = 0;
  $opt_m = $opt_C = '';
  getopts('hHvluoDdcnm:C:') or die $usage;
} else {
  die "$prg must be named fexpush or fexpull\n";
}

$opt_v ||= $opt_n;

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

if ($opt_H) {
  $help =~ s/^# ?//mg;
  print $help;
  exit;
}

$m_opt = $opt_m ? "-m $opt_m" : '';
$i_opt = $opt_i ? "-i $opt_i" : '';

$vp = '\d{8}_\d{6}'; # version pattern
$ap = '[\w_.+-]+';   # archive pattern

$fexid = $ENV{FEXID} || $opt_i || -s $fid;

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

mkdirp($sharedir) if -s $fid;

if ($opt_c) {
  if ($fexid) {
    getfid();
  } else {
    die "$prg: option -c only possible with FEXID, run: fexsend -I\n";
  }
  my $share = readlink "$sharedir/.list" or die "usage: fexpull -l SHARE\n";
  $share =~ s/.list$//;
  my ($number,$nshare,$narchive);
  if ("@ARGV" =~ /^(\d+) (\S+):(\S+)$/) {
    $number = $1;
    $nshare = $2;
    $narchive = $3;
  } elsif ("@ARGV" =~ /^(\d+) (\S+)$/) {
    $number = $1;
    $nshare = '_';
    $narchive = $2;
  } else {
    die "usage: $prg NUMBER [SHARE:]ARCHIVE\n";
  }
  my $list = "$sharedir/$share.list";
  open $list,$list or die "$prg: cannot open $list - $!\n";
  my $n = 0;
  while (<$list>) {
    if (/^(\S+) ($vp\.\w+)/) {
      my $archive = $1;
      my $avt = $2;
      $n++;
      if ($number == $n) {
        $ENV{FEXID} = "$url $owner $id";
        vsystem("fexsend -~ ".
                "COPYARCHIVE:$share:$archive:$avt:$nshare:$narchive $owner");
        exit $?;
      }
    }
  }
  die "$prg: $number not found in $list\n";
}

if ("@ARGV" =~ /^https?:\/\//) {
  if (scalar(@ARGV) > 1 ) {
    die "usage: $prg SHARE-URL\n";
  }
  saveconfig(@ARGV);
  exit;
}

# @ARGV = map { s:/+$::;$_ } @ARGV;

if ($opt_l and not @ARGV) {
  getfid() if $fexid;
  &listshares;
  unless ($opt_L) {
    $prg =~ s/push/pull/;
    warn "\nusage: $prg -l SHARE\n";
  }
  exit;
}

if ($opt_u and not $opt_L) {
  die "$prg: no \$FEXID\n" unless $fexid;
  my $a = "@ARGV";
  if ($a =~ /^\d*$/) {
    queryshare('_') unless $a;
  } else {
    die "usage: $prg -u\n";
  }
  my $list = "$sharedir/_.list";
  open $list,$list or die "$prg: cannot open $list - $!\n";
  my $n = 0;
  while (<$list>) {
    s/(\.gz)$/$1 /;
    if (/"(.*)" (http.+)$/) {
      $n++;
      if ($a and $a == $n) {
        print "$2\n";
      } elsif (not $a) {
        if (length($1)) { print qq'$2 "$1"\n' }
        else            { print qq'$2\n' }
      }
    }
  }
  exit;
}

if ($opt_o and scalar(@ARGV) == 0) {
  die "$prg -o SHARE:ARCHIVE\n"
}

# push or pull ?

if ($prg =~ /push/) {
  my $status = 0;
  my $sa = '';

  if ($opt_d) {
    die "$prg: not implemented";
  }

  if ($opt_l) {
    die "usage: $prg $i_opt -l SHARE\n" if scalar(@ARGV) != 1;
    die "usage: fexpull $i_opt -l @ARGV\n" if "@ARGV" =~ /:/;
    my $share = shift;
    ($access,@list) = queryshare($share,'archives');
    if ($access =~ /none|read/ or $access eq 'write' and not @list) {
      die "$prg: no writable archives in share $share\n";
    }
    print "writable archives in share $share:\n";
    print @list;
    print "(any)\n" if $access =~ /manage|owner/;
    exit;
  }

  if ($opt_U) {
    if ("@ARGV" =~ /^([\w-]+):(\S+\@[\w.-]+):([a-z]+)$/) {
      $share = $1;
      $suser = $2;
      $access = $3;
    } else {
      die "usage: $prg -U SHARE:USER:ACCESS\n";
    }
    ($sshare,$server,$owner,$user,$pkey) = sharedata($share);
    if ($owner eq $user and not $pkey) {
      getfid();
    } else {
      $ENV{FEXID} = "$server $user PKEY:$pkey";
    }
    vsystem("fexsend -~ SHAREUSER:$suser:$access $owner:share=$sshare");
    exit $?;
  }

  unless (@ARGV) {
    if ($fexid) {
      @ARGV = ('_:_');
    } else {
      die $usage;
    }
  }
  my $a = $ARGV[0];
  if (-t STDIN or not -t STDOUT and -e $ARGV[-1]) {
    if ($a =~ /:$/) {
      if (scalar(@ARGV) == 2) {
        $a .= $ARGV[1];
      } else {
        die "usage: $prg SHARE:ARCHIVE FILE_OR_DIRECTORY...\n";
      }
    }
    if ($a eq "@ARGV") {
      die $usage unless $fexid;
      if (-e $a) {
        $share = '_';
        $archive = basename($a);
      } elsif ($a =~ /(.+):(.+)/) {
        $share = $1;
        my $file = $2;
        $archive = basename($file);
        @ARGV = ($file);
        unless (-e $file) {
          die "$prg: $file - no such file or directory\n";
        }
      } else {
        die "$prg: $a - no such file or directory\n";
      }
      if ($archive =~ /\.(tar|tgz|zip|7z)$/i) {
        $container = $1;
      } elsif ($archive =~ /\.(gz|bz2?|rar|avi|mp\d|m4v)$/i) {
        $container = 'tar';
      } else {
        $container = 'tgz';
      }
    } else {
      if ($a =~ /(.+):(.+)/) {
        $share = $1;
        $archive = $2;
        shift @ARGV;
      } else {
        $share = '_';
        if (-e $a) {
          $archive = inputline("archive name: ") or exit;
          $archive =~ s/[^\w.+-]/_/g;
        } else {
          $archive = $a;
          shift @ARGV;
        }
      }
      if ($archive =~ s/\.(tar|tgz|zip|7z)$//) {
        $container = $1;
      } else {
        $container = 'tgz';
      }
    }
    if ($archive =~ /^_IO_/) {
      die "$prg: archive name is reserved for STDIN/STDOUT\n";
    }
  } else {
    # from pipe
    if (scalar(@ARGV) > 1) {
      if ($fexid) {
        die "usage: ... | $prg [SHARE:][NAME]\n";
      } else {
        die "usage: ... | $prg SHARE:NAME\n";
      }
    }
    if ($a =~ /(.+):(.+)/) {
      $share = $1;
      $archive = $2;
    } elsif ($a =~ /(.+):$/) {
      $share = $1;
      $archive = '_';
    } else {
      $share = '_';
      $archive = $a || '_';
    }
    $container = 'gz';
  }

  $archive =~ s:.*/::;
  $archive =~ s/[^\w_.+-]/_/g;
  $archive =~ s/^\./_/;

  if ($share eq '_') {
    getfid();
    die "$prg: no owner-user defined\n" unless $owner;
  } else {
    die "$prg: no share?!\n" unless $share;
    ($sshare,$server,$owner,$user,$pkey) = sharedata($share);
    if ($owner eq $user and not $pkey) {
      getfid();
    } else {
      $ENV{FEXID} = "$server $user PKEY:$pkey";
    }
  }
  $to = "$owner:share=$share";

  if ($opt_C) {
    $opt_C =~ s/\%u/$hostuser/g;
    $opt_C =~ s/\%h/$host/g;
    $opt_C =~ s/\%H/$hostname/g;
  }

  if (-t STDIN or not -t STDOUT and -e $ARGV[-1]) {

    map { -e or die "$prg: $_ does not exist\n" } @ARGV;

    if (${'opt_.'}) {
      $xsp = ${'opt_#'}.'#.fex/tmp#.del#.snapshot*';
    } else {
      $xsp = ${'opt_#'}.'#.*';
    }

    $xsp =~ s/^#//;
    # exclude list wildcard --> regular expression
    $xrx = $xsp;
    $xrx =~ s/\./\\./g;
    $xrx =~ s/(?<!\\)\?/./g;
    $xrx =~ s/(?<!\\)\*/.*/g;
    $xrx =~ s/([()+{}\|])/\\$1/g;
    $xrx =~ s/#/|/g;

    if ($opt_s) {
      @__ = @ARGV;
    } else {
      map { warn "$prg: dereferencing symlink $_\n" if -l } @ARGV;
      @__ = uniq(map { abs_path($_) } @ARGV);
      my $cwd = abs_path(getcwd);
      map { s:^\Q$cwd/:: } @__;
    }

    if ($opt_T) {
      $mtime = time();
    } else {
      $mtime = 0;
      nmtime(@__);
    }

    $dir = '.';
    if (scalar(@__) > 1) {
      $dir = dirname($__[0]);
      foreach (@__) {
        if (dirname(abs_path($_)) ne $dir) {
          $dir = '.';
          last;
        }
      }
    }

    if ($dir ne '.') {
      chdir $dir or die "$prg: cannot chdir $dir - $!\n";
      @__ = map { basename($_) } @__;
    }

    my $version = versiondate($mtime);
    my @qargv = map { shellquote($_) } @__;
    $opt_C = '-C '.shellquote($opt_C) if $opt_C;


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

    my $xo = '';
    $xo = '-# '.shellquote(${'opt_#'}) if ${'opt_#'}; # and grep { -d } @__;

    if (($ENV{CALLER}||'') =~ /fexstore/) {
      my $avc = sprintf "%s_%s.taz",$archive,$version;
      $cmd = "fexsend $m_opt $opt_C $xo $ao $avc @qargv $to";
    } elsif (scalar(@ARGV) == 1 and "@ARGV" =~ /^(\S+)\.(tar|tgz|zip|7z)$/) {
      $archive ||= $1;
      $container = $2;
      $archive =~ s/[^\w.+-]/_/g;
      my $avc = sprintf "%s_%s.%s",$archive,$version,$container;
      $cmd = "fexsend $m_opt $opt_C -= $avc @qargv $to";
    } else {
      my $avc = sprintf "%s_%s.%s",$archive,$version,$container;
      $cmd = "fexsend $m_opt $opt_C $xo $ao $avc @qargv $to";
    }
    $sa = "$share:$archive";
    warn "$prg: $share:$archive:$version\n";
    $cmd =~ s/  +/ /g;
    vsystem($cmd);
    $status = $?;

  } else {

    # pipe data
    my $stream = '_IO_'.$archive;
    $stream =~ s/^(_IO_)_$/$1/;
    my @d = gmtime(time());
    my $version .= sprintf("%d%02d%02d_%02d%02d%02d",
                           $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
    my $sv = sprintf "%s_%s.gz",$stream,$version;
    $opt_C = "-C '$opt_C'" if length($opt_C);
    $cmd = "gzip | fexsend $m_opt $opt_C -s $sv $to";
    $cmd =~ s/  +/ /g;
    $sa = "$share:$stream";
    warn "$prg: $sa:$version\n";
    vsystem($cmd);
    $status = $?;
  }

  if ($opt_o) {
    local $ENV{FEXID} = '' if $sa =~ /:/ and $sa !~ /^_:/;
    vsystem("fexpull -o $sa");
  }
  exit $status;
}

if ($prg =~ /pull/) {

  &getfid if $ENV{FEXID} or $opt_i;

  if ($opt_U) {
    if (scalar(@ARGV)) {
      die "usage: $prg -U SHARE\n";
    }
    ($access,@list) = queryshare($opt_U,'users');
    if ($access eq 'owner' or $access eq 'manage') {
      print @list;
      exit;
    } else {
      die "$prg: no manage access right for share $opt_U\n";
    }
  }

  if ($opt_o) {
    my $a = "@ARGV";
    my ($share,$archive);
    if ($a =~ /^(\S+):(\S+)$/) {
      $share = $1;
      $archive = $2;
    } elsif ($a =~ /^(\S+)$/) {
      $share = '_';
      $archive = $1;
    } else {
      die "usage: $prg -o SHARE:ARCHIVE\n";
    }
    my ($sshare,$server,$owner,$user,$key) = sharedata($share);
    $key ||= $id if $owner eq $user;

    unless ($key) {
      warn "$prg: unknown share $share\n" if $share ne '_';
      die "usage: $prg -l\n".
          "usage: $prg -l SHARE[:ARCHIVE[:VERSION]]\n";
    }
    ($access,@list) = queryshare($share);
    if ($access ne 'owner' and $access ne 'manage') {
      die "$prg: no manage access right for share $share\n";
    }
    @list = grep { s/^(\Q$archive\E \S+) .*/$1/ } @list;
    unless (@list) {
      die "$prg: no archive $archive found in share $share\n";
    }
    exit if scalar(@list) == 1;
    pop @list;
    foreach (@list) {
      if (/\Q$archive\E ($vp)\.(tar|tgz|zip|7z|gz)/) {
        my $file = sprintf "%s_%s.%s",$archive,$1,$2;
        my $url = sprintf "%s/fop/%s/%s/%s/%s/%s",
          $server,$owner,$sshare,$user,md5_hex("$file:$key"),$file;
        local $no_action = $opt_n;
        vsystem(qw'fexget -d',$url);
        sleep 1;
      }
    }
    exit;
  }

  if ($fexid and not @ARGV) {
    $share = '_';
    if (-t STDOUT) {
      $opt_l = 1;
    } else {
      @ARGV = ('_IO_');
    }
  }

  if ($opt_l) {
    my $a = "@ARGV";
    my $version;
    if ($fexid) {
      $usage = "usage: $prg -l [SHARE][:ARCHIVE[:VERSION]]\n".
               "usage: $prg -l [SHARE:]NUMBER\n";
    } else {
      $usage = "usage: $prg -l SHARE[:ARCHIVE[:VERSION]]\n".
               "usage: $prg -l [SHARE:]NUMBER\n";
    }
    if ($a =~ / /) {
      die $usage;
    }
    if ($a =~ /^\d+$/) {
      $share = readlink "$sharedir/.list" or die "usage: $prg -l SHARE\n";
      $share =~ s/.list$//;
      $number = $a;
    } elsif ($a =~ /^(.+):(\d+)$/) {
      $share = $1;
      $number = $2;
    } elsif ($a =~ /^(.+):(.+):($vp)$/) {
      $share = $1;
      $archive = $2;
      $version = $3;
    } elsif ($a =~ /^:?(.+):($vp)$/) {
      $share = '_';
      $archive = $1;
      $version = $2;
    } elsif ($a =~ /(.+):(.+)/) {
      $share = $1;
      $archive = $2;
    } elsif ($a =~ /(.+)/) {
      $share = $1;
    } elsif ($fexid) {
      $share = '_';
    } else {
      die $usage;
    }
    $share =~ s/:$//;

    unless ($share eq '_' or $ENV{FEXID} or $opt_i or -f "$sharedir/$share.cf") {
      die "$prg: unknown share $share\n".
          "usage: $prg -l\n".
          "usage: $prg -l SHARE[:ARCHIVE[:VERSION]]\n";
    }

    if ($number or $archive) {
      my ($file,$sav);
      my $list = "$sharedir/$share.list";
      open $list,$list or die "$prg: cannot open $list - $!\n";
      my $n = 0;
      while (<$list>) {
        if (/^(\S+) ($vp)\.(tar|tgz|zip|7z|gz) (\d+) (\d+) (\S+) (".*") (.*)/) {
          $n++;
          @A = ($1,$2,$3,$4,$5,$6,$7,$8);
          if ($number and $number == $n) {
            $file = sprintf "%s_%s.%s",@A[0..2];
            $sav = sprintf "%s:%s:%s",$share,@A[0..1];
            last;
          } elsif ($archive) {
            if ($A[0] eq $archive) {
              if ($version and $version eq $A[1] or not $version) {
                $file = sprintf "%s_%s.%s",@A[0..2];
                $sav = sprintf "%s:%s:%s",$share,@A[0..1];
              }
            }
          }
        }
      }
      close $list;
      if ($file) {
        warn "$prg: $sav\n";
        if ($file =~ /\.gz$/) {
          die "$prg: cannot list $file\n";
        }
        my ($sshare,$server,$owner,$user,$key) = sharedata($share);
        $key ||= $id if $owner eq $user;
        $url =
          sprintf "%s/fop/%s/%s/%s/%s/%s",
          $server,$owner,$sshare,$user,md5_hex("$file:$key"),$file;
        vsystem(qw'fexget -t',$url);
        exit $?;
      } else {
        die "$prg: not found\n";
      }
    }

    my $n = 0;
    my $header = "\n";
    if ($opt_L) {
      $header .=
        "number   upload time            size share:archive:version:container uploader comment\n".
        "-------------------------------------------------------------------------------------\n";
      if ($share eq '_') {
        $header =~ s/ uploader//;
        $header =~ s/---------//;
        if ($opt_u) {
          $header =~ s/\n-/ URL\n-/;
          $header =~ s/\n$/----\n/;
        }
      }
    } else {
      $header .=
        "number      size share:archive:version\n".
        "--------------------------------------\n";
    }

    ($access,@list) = queryshare($share);
    unless (grep /$vp/,@list) {
      die "$prg: share $share is empty\n";
    }
    print "access=$access\n" if $opt_L;
    my $list = "$sharedir/$share.list";
#    if ($share eq '_' and $foreign and $owner) {
#      $list = "/tmp/$hostuser/.fex/share/$owner/_.list";
#    }
    print "$server/$owner\n";
    open $list,$list or die "$prg: cannot open $list - $!\n";
    while (<$list>) {
      if (/(\S+) ($vp)\.(tar|tgz|zip|7z|gz) (\d+) (\d+) (\S+) "(.*)"( http.*)?/) {
        my $archive = $1;
        my $version = $2;
        my $container = $3;
        my $utime = $4;
        my $size = $5;
        my $uploader = $6;
        my $comment = $7;
        my $url = $8||'';
        $url = '' unless $opt_u;
        $n++;
        print $header;
        $header = '';
        if ($opt_L) {
          $comment = ' "'.$comment.'"' if $comment;
          $comment ||= ' ""';
          $comment = " $uploader$comment" if $share ne '_';
          my @d = localtime $utime;
          printf "%3d) %d-%02d-%02d %02d:%02d:%02d %8d MB %s:%s:%s:%s%s%s\n",
                 $n,$d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0],int($size/$MB),
                 $share,$archive,$version,$container,$comment,$url;
        } else {
          printf "%3d) %8d MB %s:%s:%s\n",
                 $n,int($size/$MB),$share,$archive,$version;
        }
      }
    }
    close $list;
    unlink "$sharedir/.list";
    symlink basename($list),"$sharedir/.list";
    exit;
  }

  @files = ();

  unless ($opt_d) {
    if (scalar(@ARGV) > 1) {
      @files = @ARGV;
      (@ARGV) = shift @files;
    } elsif (@ARGV) {
    } else {
      if ($fexid) {
        die "usage: $prg [-l]\n".
            "usage: $prg [SHARE:]ARCHIVE[:VERSION]\n".
            "usage: $prg [SHARE:]NUMBER\n";
      } else {
        die "usage: $prg -l\n".
            "usage: $prg SHARE:ARCHIVE[:VERSION]\n".
            "usage: $prg [SHARE:]NUMBER\n";
      }
    }
  }

  getfid() if not $owner and $ENV{FEXID} or $opt_i;

  foreach (@ARGV) {
    $arg = $_;
    my $a = $_;

    $number = 0;
    my $share = '';
    my $list = "$sharedir/.list";

    $a =~ s![^:]+/!!; # remove extraction directory
    if ($a =~ /^(\d+)$/) {
      $_ = readlink $list     or die "$prg: $list is not a symlink\n";
      m:(.+)\.list$:          or die "$prg: $list is unknown\n";
      $share = $1;
      $number = $a;
    } elsif ($a =~ /^(.+):(\d+)$/) {
      $share = $1;
      $number = $2;
    } elsif ($a =~ /(.+):(.+):($vp)$/) {
      $share = $1;
      $archive = "$2:$3";
    } elsif ($a =~ /(.+):($vp)$/) {
      $share = '_';
      $archive = "$1:$2";
    } elsif ($a =~ /(.+):(.+)/) {
      $share = $1;
      $archive = $2;
    } else {
      $share = '_';
      $archive = $a;
    }

    queryshare($share) unless $number;

    $list = "$sharedir/$share.list";
#    if ($share eq '_' and $foreign and $owner) {
#      $list = "/tmp/$hostuser/.fex/share/$owner/_.list";
#    }
    open $list,$list or die "$prg: cannot open $list - $!\n";
    my $access = 'none';
    my $n = 0;
    my @af;
    my %af;
    $af[0] = '';

    while (<$list>) {
      $access = $1 if /^access:(\w+)$/;
      if (/(\S+) ($vp)\.(tar|tgz|zip|7z|gz) (\d+) (\d+) (\S+) (".*")/) {
        $n++;
        if ($opt_d) {
          $af[$n] = $af{"$1:$2"} = "$1_$2.$3";
          $af{$1} .= "$1_$2.$3 ";
        } else {
          $af[$n] = $af{$1} = $af{"$1:$2"} = "$1_$2.$3";
          my $sav = "$share:$1:$2";
          $sav .= " $7" if length($7) > 2;
          $sav[$n] = $sav{$1} = $sav{"$1:$2"} = $sav;
        }
      }
    }
    close $list;

    if ($number) {
      $af = $af[$number]  or die "$prg: no such archive $number\n";
      $sav = $sav[$number];
    } elsif ($archive) {
      $af = $af{$archive} or die "$prg: no such archive $archive\n";
      $sav = $sav{$archive};
    } else {
      die "$prg: no such archive\n";
    }

    ($sshare,$server,$owner,$user,$key) = sharedata($share);
    $key ||= $id if $owner eq $user;

    foreach my $afe (split(' ',$af)) {
      $url = sprintf "%s/fop/%s/%s/%s/%s/%s",
        $server,$owner,$sshare,$user,md5_hex("$afe:$key"),$afe;
      if ($opt_d) {
        local $no_action = $opt_n;
        vsystem(qw'fexget -d',$url);
        # if ($access eq 'owner' or $access eq 'manage') {
        #  vsystem(qw'fexget -d',$url);
        # } else {
        #  die "$prg: no manage access right for share $share\n";
        # }
        sleep 1;
      }
    }

  }
  exit if $opt_d;

  warn "$prg: $sav\n";

  my $xdir = '';

  # extra extraction directory
  if ($arg =~ s!([^:]+)/!!) {
    $xdir = $1;
    chdir $xdir or die "$prg: cannot chdir $1 - $!\n";
  }

  $cwd = getcwd();
  -w $cwd or die "$prg: $cwd is not writable\n";

  # STDOUT archive
  if ($url =~ /\.gz$/) {
    if (-t STDOUT and "@files" ne '-') {
      close STDIN;
      vsystem("fexget $m_opt $url");
    } else {
      vsystem("fexget -q $m_opt -s- $url | gunzip");
    }
    exit $?;
  }

  if ("@files" eq '-') {
    if ($url =~ /\.tgz$/) {
      vsystem("fexget $m_opt -s- $url | gunzip");
    } else {
      vsystem("fexget $m_opt -s- $url");
    }
    exit $?;
  }

  if (-t STDIN and -t STDOUT) {
    unless ($xdir) {
      print "get it? [Yn] ";
      $_ = <STDIN>;
      exit if /n/i;
    }
  }

  if ($number and $url =~ /.*\/(.+)_($vp)/ or
      not $xdir and ($arg =~ /([^:]+):($vp)/ or $arg =~ /([^:]+)()$/))
  {
    $xdir = sprintf "%s_%s",$1,$2;
    if ($xdir =~ s/_$//) {
      if (lstat $xdir and not -d $xdir) {
        die "$prg: $xdir does already exist and is not a directory\n";
      }
      unless (-d $xdir) {
        mkdir $xdir or die "$prg: cannot mkdir $xdir - $!\n";
      }
      $xdir = '.';
    } else {
      $vdir = $xdir; # version directory
      mkdir $xdir or die "$prg: cannot mkdir $xdir - $!\n";
      chdir $xdir or die "$prg: cannot cd $xdir - $!\n";
    }
  } elsif ($url =~ /.*\/(.+)_($vp)/) {
    my $file = $1;
    my $dt = $2;
    unless (-l $file) {
      if ($xdir and -d $file and not searchpath('del')) {
        die "$prg: local file $file is a directory, cannot overwrite\n";
      }
      # check time stamp of local regular file
      # (does not work with non-base64 filename)
      my @s = stat $file;
      if (-d $file) {
        my $qfile = quotemeta $file;
        my @files = sort `find $qfile -printf '%T@ %p\n'`;
        @s = stat $1 if $files[-1] =~ / (.+)/;
      }
      if (@s) {
        my @d = gmtime($s[9]);
        my $ldt = sprintf("%d%02d%02d_%02d%02d%02d",
          $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
        if ($dt le $ldt) {
          die "$prg: local '$file' is newer or same age ($ldt)\n"
        }
      }
      if (-f $file and searchpath('vv')) {
        # backup of single file
        vsystem(qw'vv -s',$file);
      }
      if (-d $file and searchpath('del')) {
        # save delete of directory
        vsystem(qw'del -f',$file);
      }
    }
  }

  close STDIN if $url !~ /7z$/;
  vsystem("fexget $m_opt -oX $url");
  exit $? if $?;
  $archive = $url;
  $archive =~ s:.*/::;
  if ($zip = $archive =~ /\.zip$/) {
    # vsystem(qw'unzip -l',$archive,@files);
  } elsif ($z7 = $archive =~ /\.7z$/) {
    # vsystem(qw'7z l',$archive,@files);
  } elsif ($tar = $archive =~ /\.tar$/) {
    # vsystem(qw'tar -tvf',$archive,@files);
  } else {
    # vsystem(qw'tar -tvzf',$archive,@files);
  }
  my @qfiles = map { shellquote($_) } @files;
  if ($zip) {
    $cmd = "unzip -o -u $archive @qfiles";
    $cmd = "unzip $archive @qfiles";
  } elsif ($z7) {
    $cmd = "7z x $archive @qfiles";
  } elsif ($tar) {
    $cmd = "tar --keep-newer-files -xvf $archive @qfiles";
  } else {
    $cmd = "tar --keep-newer-files -xvzf $archive @qfiles";
  }
  warn "\$ $cmd\n" if $opt_v;
  if ($zip or $z7) {
    if (abs_path($xdir) eq abs_path('.')) {
      $xdir = '';
    } else {
      print "extracting in ./$xdir/ :\n";
    }
    system "$cmd </dev/tty";
    if ($xdir and `du` =~ /(\d+)/) {
      printf "./%s: %d MB\n",$xdir,$1/1024;
    }
  } else {
    open $cmd,'-|',$cmd or die "$prg: $!\n";
    print "extracting:\n";
    while (<$cmd>) {
      next if /^Archive: .*\.zip$/;
      s/^\s+[a-z]+: //;
      s:^\Q$1/:: if $vdir and $vdir =~ /(.+)_$vp/;
      print "$xdir/$_";
    }
  }
  close $cmd;
  unlink $archive if $? == 0;

  # version directory with just one subdirectory?
  if ($vdir and opendir $vdir,'.') {
    my @files = ();
    while (defined(my $f = readdir($vdir))) {
      next if $f eq '.';
      next if $f eq '..';
      push @files,$f;
    }
    closedir $vdir;
    if (scalar(@files) == 1 and -d $files[0] ) {
      my $dir = $files[0];
      if ($xdir =~ /^\Q$dir\E_$vp$/ and
          rename $dir,$vdir and opendir $vdir,$vdir) {
        while (defined(my $f = readdir($vdir))) {
          next if $f eq '.';
          next if $f eq '..';
          rename "$vdir/$f",$f;
        }
        closedir $vdir;
        rmdir $vdir;
      }
    }
  }

  exit;
}

die "$prg: unknown program name\n";


sub fexstore {
  my $a = "@ARGV";
  my @list = ();

  $ENV{FEXID} = $ENV{FEXXX} if $ENV{FEXXX};
  getfid();
  unless ($id) {
    die qq'$prg: no \$FEXID, run "fexsend -I" or set FEXXX\n';
  }
  if ($foreign) {
    # die "$prg: support for foreign FEXID not yet implemented\n";
  }
  $ENV{FEXID} = "$url $owner $id";
  unless (-t STDIN) {
    die "usage: ... | $prg\n" if length($a);
    my $version = versiondate(time);
    my $comment = "[$hostuser\@$host] <STDINOUT>";
    $comment .= " ($opt_C)" if $opt_C;
    $comment =~ s/\'//g;
    my $cmd = "gzip | fexsend $m_opt -C '$comment' -s __$version.gz .:share=_";
    warn "| $cmd\n" if $opt_v;
    exec $cmd;
  }

  unless (@ARGV or $opt_l or $opt_u or $opt_o or $opt_d or $opt_D) {
    die $usage;
  }

  if ($opt_u) {
    if ($opt_l) {
      @list = grep {
        s/_:_:$vp:\w+ \"// and
        s/\" (http)/\n     $1/;
      } vsystem("fexpull -Lu _|");
      if (@list) {
        print qq'number   upload time            size [uploader] arguments\n';
        print qq'---------------------------------------------------------\n';
        print @list;
      }
    } else {
      @list = vsystem("fexpull -u $a |");
      print grep /\/__$vp/,@list;
    }
    die "$prg: share _ is empty\n" unless @list;
    exit;
  }

  if ($opt_l and $a =~ /^\d+$/) {
    vsystem(qw'fexpull -l',$a);
    exit $?;
  }

  if ($opt_l or $opt_o or $opt_D or $a eq '-' or not $a) {
    @list = vsystem("fexpull -L _ 2>/dev/null|");
    unless (grep /_:/,@list) {
      die "$prg: share _ is empty\n";
    }
    @list = grep { s/_:_:(.+?):\w+/$1/ } @list
      or die "$prg: no archives found\n";
  }

  if ($opt_l) {
    print
      "number   upload time            size [uploader] arguments\n",
      "---------------------------------------------------------\n";
    map { s/\"//;s/\"$//;s/$vp //;$_ } @list;
    print @list;
    exit;
  }

  if ($opt_d) {
    unless ($a) {
      die "usage: $prg -d NUMBER(s)\n".
          "usage: $prg -d REGEX\n";
    }
    if ($a =~ /^[\d ]+$/) {
      my $list = "$sharedir/_.list";
      open $list,$list or die "usage: $prg -l\n";
      @list = ('');
      while (<$list>) {
        if (/^(\S+) ($vp)/) {
          if (/^_ ($vp)\.\w+ (\d+) \d+ \S+ (".*")/) {
            my @d = localtime $2;
            push @list,sprintf "%d-%02d-%02d %02d:%02d:%02d %s",
                 $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0],$3;
          }
        }
      }
      foreach my $n (@ARGV) {
        if (my $x = $list[$n]) {
          warn "$prg: $x\n";
          local $no_action = $opt_n;
          vsystem(qw'fexpull -d',$n);
        } else {
          warn "$prg: $n not found\n";
        }
      }
    } else {
      my ($access,@list) = queryshare('_');
      my $n = 0;
      foreach (@list) {
        if (/^(\S+) ($vp)/) {
          $n++;
          if (/^_ ($vp)\.\w+ \d+ \d+ \S+ (".*$a.*")/) {
            warn "$prg: $1 $2\n";
            local $no_action = $opt_n;
            vsystem(qw'fexpull -d',$n);
          }
        }
      }
    }
    exit;
  }

  if ($opt_D) {
    my $d = "@ARGV"||0;
    if ($d !~ /^\d+$/) {
      die "usage: $prg -D [DAYS]\n";
    }
    my $t = time()-$d*24*60*60;
    my @d = gmtime($t);
    my $dt = sprintf("%d%02d%02d_%02d%02d%02d",
                     $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);

    foreach (@list) {
      if (/^\s*(\d+).* ($vp) /) {
        my $n = $1;
        my $v = $2;
        if ($v lt $dt) {
          local $no_action = $opt_n;
          vsystem("fexpull -d $n");
        }
      }
    }
    exit;
  }

  if ($opt_o or $opt_d) {
    pop @list if $opt_o;
    my $n = $opt_d || '\d+';
    foreach (@list) {
      if (/^ *($n)\)/) {
        local $no_action = $opt_n;
        vsystem("fexpull -d $1");
      }
    }
    exit;
  }

  if ($a and $a !~ /^(\d+|-)$/) {
    foreach my $file (@ARGV) {
      die "$prg: $file does not exist\n"  unless -e $file;
      die "$prg: $file is not readable\n" unless -r $file;
    }
    $_ = "fexpush $m_opt -s -T -C";
    vsystem(split,"[%u\@%h] @ARGV",'_:_',@ARGV);
    exit $?;
  }

  if ($a =~ /^(\d+|-)$/) {
    my @list = ();
    my $list = "$sharedir/_.list";
    open $list,$list or die "usage: $prg -l\n";
    my $n = 0;
    while (<$list>) {
      if (/^(\S+) ($vp)/) {
        $n++;
        if (/^_ ($vp)\.\w+ \d+ (\d+) \S+ (".*")/) {
          push @list,sprintf "%3d) %8d MB _:_:%s %s\n",$n,int($2/$MB),$1,$3;
        }
      }
    }
    $a = scalar(@list) if $a eq '-';
    foreach (@list) {
      if (/$a\).*? (\d+ MB).*($vp) (".*")/) {
        my $size = $1;
        my $version = $2;
        my $comment = $3;
        print "$version $size $comment\n";
        if (-t STDIN and -t STDOUT) {
          print "pull? [Yn] ";
          $_ = <STDIN>;
          exit if /n/i;
        }
        if ($comment =~ / <STDINOUT>/) {
          # close STDIN;
          vsystem("fexpull $m_opt _:$a -");
        } else {
          vsystem("fexpull $m_opt _:$a - | tar -xvf -");
        }
        exit $?;
      }
    }
    die "$prg: archive _:$a not found\n";
  } elsif ($a eq '-') {
    $_ = $list[-1];
    if (/(\d+)\).*? (\d+ MB).*($vp) (".*")/) {
      my $n = $1;
      my $size = $2;
      my $version = $3;
      my $comment = $4;
      if ($comment =~ / <STDINOUT>\"$/) {
        close STDIN;
        vsystem("fexpull _:$n -");
        exit $?;
      } else {
        print "$version $size $comment\n";
        print "pull? [Yn] ";
        $_ = <STDIN>;
        exit if /n/i;
        vsystem("fexpull $m_opt _:$n - | tar -xvf -");
        exit $?;
      }
    } else {
      die "$prg: $_";
    }
  } else {
    die $usage;
  }
  exit;
}


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

  $nfiles += scalar(@_);
  print "Scanning: $nfiles files\r" if -t STDOUT and $nfiles > 1;
  if (scalar(@_) == 1 and not -d $_[0]) {
    if (@s = stat $_[0]) {
      $mtime = $s[9] if $s[9] > $mtime;
    }
  } else {
    foreach $file (@_) {
      @files = ();
      if (-d $file and not -l $file and opendir $dir,$file) {
        print "Scanning $file/\n" if $opt_v;
        if (@s = stat $dir) {
          $mtime = $s[9] if $s[9] > $mtime;
        }
        while (defined($_ = readdir $dir)) {
          next if /^\.\.?$/;
          next if /^($xrx)$/;
          push @files, "$file/$_";
        }
        closedir $dir;
        nmtime(@files);
      } else {
        if (@s = lstat $file) {
          $mtime = $s[9] if $s[9] > $mtime;
        }
      }
    }
  }
}


sub saveconfig {
  local $_ = shift;

  if (m:(^http.*?)/fas/(.+?)/(.+?)/(.+?)/(\w+):) {
    my $surl  = $1;
    my $owner = $2;
    my $share = $3;
    my $user  = $4;
    my $pkey  = $5;
    print "share:\t$share\n";
    print "server:\t$surl\n";
    print "owner:\t$owner\n";
    print "user:\t$user\n";
    mkdir dirname($sharedir);
    unless (-d $sharedir) {
      mkdir $sharedir or die "$prg: cannot mkdir $sharedir - $!\n";
    }
    $scf = "$sharedir/$share.cf";
    while (-e $scf) {
      print "\nConfig file $scf does already exist!\n";
      $_ = inputline("Enter an alternate share name or \"!\" to overwrite: ");
      last if /^!/;
      s/^\.//g;
      s/^\s+//g;
      s/\s+$//g;
      s:[^\w.,=+-]:_:g;
      exit unless $_;
      $scf = "$sharedir/$_.cf";
    }
    open $scf,'>',$scf or die "$prg: cannot write $scf - $!\n";
    print {$scf} "share=$share\n";
    print {$scf} "server=$surl\n";
    print {$scf} "owner=$owner\n";
    print {$scf} "user=$user\n";
    print {$scf} "pkey=$pkey\n";
    close $scf;
    print "$prg: $scf written\n";
    $prg =~ s/push/pull/;
    print "usage: $prg -l $share # show available archives\n";
  } else {
    die "$prg: not a share URL\n";
  }
  exit;
}


sub delarchives {
  my $share = shift;
  my $archive = shift;
  my ($file,$url);
  my ($sshare,$server,$owner,$user,$key) = sharedata($share);

  $key ||= $id if $owner eq $user;
  return unless $key;

  my ($access,@list) = queryshare($share);
  unless ($access eq 'owner' or $access eq 'manage') {
    warn "$prg: cannot delete archives, because you only have $access right\n";
    return;
  }
  foreach (@list) {
    if (/^\Q$archive\E ($vp)\.(tar|tgz|zip|7z|gz)/) {
      $file = sprintf "%s_%s.%s",$archive,$1,$2;
      $url = sprintf "%s/fop/%s/%s/%s/%s/%s",
             $server,$owner,$sshare,$user,md5_hex("$file:$key"),$file;
      local $no_action = $opt_n;
      vsystem(qw'fexget -d',$url);
      sleep 1;
    }
  }
}


sub getfid {
  local $_;
  $url = $owner = $id = '';

  if (not $opt_i and $_ = $ENV{FEXID}) {
    $_ = decode_b64($_) unless / /;
    ($url,$owner,$id) = split;
    unless ($id) {
      die "$prg: illegal \$FEXID\n";
    }
  } elsif (-s $fid and open $fid,$fid) {
    if ($opt_i) {
      while (<$fid>) {
        if (/^\[$opt_i\]/) {
          $url = <$fid>;
          $owner = <$fid>;
          $id = <$fid>;
          last;
        }
      }
    } else {
      $url = <$fid>;
      $owner = <$fid>;
      $id = <$fid>;
      if ($prg eq 'fexstore') {
        while (<$fid>) {
          if (/^\[xx\]/) {
            $url = <$fid>;
            $owner = <$fid>;
            $id = <$fid>;
            last;
          }
        }
      }
    }
    close $fid;
    if ($url and $owner and $id) {
      $url   =~ s/\s//g;
      $owner =~ s/\s//g;
      $id    =~ s/\s//g;
    } else {
      if ($opt_i) {
        die "$prg: no F*EX URL for [$opt_i] in $fid\n";
      } else {
        die "$prg: no F*EX URL in $fid\n";
      }
    }
  }
  $url = "http://$url" if $url !~ /^http/;
  $url =~ s:/+$::;

  $foreign = 1;
  if (open $fid,$fid) {
    $_ = <$fid>||'';
    $_ = <$fid>||'';
    s/\s//g;
    $foreign = 0 if lc $_ eq $owner;
    close $fid;
  }

  if ($opt_i) {
    die "$prg: no [$opt_i] found in $fid\n" unless $id;
    $foreign = 0;
    $sharedir = "$HOME/.fex/share/$opt_i";
    mkdirp($sharedir);
  } elsif ($foreign) {
    $sharedir = "/tmp/$hostuser/.fex/share/$owner";
    $ENV{FEXTMP} = "/tmp/$hostuser/.fex/tmp";
    mkdirp($sharedir);
    mkdirp($ENV{FEXTMP});
    chmod 0700,"/tmp/$hostuser/.fex";
  }

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

  $ENV{FEXID} = "$url $owner $id";
}


sub sharedata {
  my $share = shift;
  $share =~ s/\.cf$//;
  my $scf = "$sharedir/$share.cf";

  mkdir dirname($sharedir);
  unless (-d $sharedir) {
    mkdir $sharedir or die "$prg: cannot mkdir $sharedir - $!\n";
  }

  if ($share eq '_' and $fexid) {
    &getfid;
    return ($share,$url,$owner,$owner);
  } else {
    unless (-f $scf) {
      if ($fexid) {
        if ($share !~ /^[\w_-]+$/) {
          die "$prg: illegal share name $share\n";
        }
        &getfid;
        if ($prg =~ /push/ and $url and $owner) {
          warn "$prg: share $share is locally unknown\n";
          if (-t STDIN) {
            print "create it [yN]? ";
            $_ = <STDIN>;
            if (/y/i) {
              warn "$prg: creating new share $share\n";
              &getfid;
              open $scf,'>',$scf or die "$prg: cannot write $scf - $!\n";
              print {$scf} "share=$share\n";
              print {$scf} "server=$url\n";
              print {$scf} "owner=$owner\n";
              print {$scf} "user=$owner\n";
              close $scf;
              return ($share,$url,$owner,$owner);
            } else {
              die "$prg: aborting\n";
            }
          } else {
            die "$prg: unknown share $share\n";
          }
        }
      } else {
        die "$prg: unknown share $share\n";
      }
    }

    my $sshare = $share;
    my $server = $::server;
    my $owner = $::owner;
    my $user = $::user;
    my $pkey = $::pkey;
    my $id;

    if (-f $scf) {
      open $scf,$scf or die "$prg: cannot open $scf - $!\n";
      while (<$scf>) {
        $sshare = $1 if /^share=(\S+)/;
        $owner  = $1 if /^owner=(\S+)/;
        $user   = $1 if /^user=(\S+)/;
        $server = $1 if /^server=(\S+)/;
        $pkey   = $1 if /^pkey=(\S+)/;
        $id     = $1 if /^id=(\S+)/;
      }
      close $scf;
    }
    unless ($pkey) {
      if (not ($owner and $user and $server) or $owner eq $user) {
        local $opt_i = $id;
        &getfid;
        $server = $::url;
        $user = $owner = $::owner;
      } else {
        die "$prg: no pkey in $scf\n";
      }
    }
    $server = "http://$server" if $server !~ /^http/;
    $server =~ s:^(http.+//.+)[/!]:$1:;
    return ($sshare,$server,$owner,$user,$pkey);
  }

}


sub listshares {
  my @sp = qw'share server owner user pkey';
  my $sp = join('|',@sp);
  my @shares = ();
  my @sshares = ();
  local $_;

  die "$prg: no $sharedir\n" unless -d $sharedir;

  if ($fexid) {
    &getfid;
    {
      # local $ENV{FEXID} = "$url $owner $id";
      foreach (vsystem('fexsend -~ LISTSHARES |')) {
        if (m:^server/user:) {
          warn $_;
        } else {
          chomp;
          push @sshares,$_;
        }
      }
    }
    # store share config only if not foreign FEXID
    unless ($foreign) {
      foreach my $sshare (@sshares) {
        my $scf = "$sharedir/$sshare.cf";
        if (not -f $scf and open $scf,'>',$scf) {
          print {$scf} "share=$sshare\n";
          print {$scf} "server=$url\n";
          print {$scf} "owner=$owner\n";
          print {$scf} "user=$owner\n";
          close $scf;
        }
      }
    }
  }

  @shares = @sshares;

  unless ($foreign) {
    # delete local share config if share does not exist any more on server
    @shares = grep { s:.*/(.+)\.cf:$1: } glob("$sharedir/*.cf");
    foreach my $share (@shares) {
      next if $share eq '_';
      my $owner = '';
      my $user  = '';
      my $pkey  = '';
      open $share,"$sharedir/$share.cf" or next;
      while (<$share>) {
        $owner = $1 if /^owner=(\S+)/;
        $user  = $1 if /^user=(\S+)/;
        $pkey  = $1 if /^pkey=(\S+)/;
      }
      close $share;
      if ($owner eq $user and not $pkey) {
        unless (grep { $share eq $_ } @sshares) {
          unlink "$sharedir/$share.cf";
          unlink "$sharedir/$share.list";
        }
      }
    }
  }

  if ($opt_L) {
    foreach my $share (@shares) {
      my %sinfo = (
        owner => '',
        user => '',
      );
      if (open $share,"$sharedir/$share.cf") {
        while (<$share>) {
          $sinfo{$1} = $2 if /^($sp)=(.+)/;
        }
        close $share;
        $sinfo{'pkey'} ||= 'id' if $sinfo{'owner'} eq $sinfo{'user'};
        my $sinfo = 1;
        foreach my $i (@sp) {
          $sinfo &&= $sinfo{$i};
        }
        if ($sinfo) {
          print "\n";
          print "\$HOME/.fex/share/$share.cf:\n";
          foreach my $i (@sp) {
            printf "%s=%s\n",$i,$sinfo{$i} if $i ne 'pkey';
          }
          if ($sinfo{'owner'} eq $sinfo{'user'}) {
            print "access=owner\n";
            printf "URL=%s/fas?show=share:%s:archives\n",
                   $sinfo{'server'},$sinfo{'share'};

          } else {
            my ($access) = queryshare($share);
            printf "access=%s\n",$access;
            printf "URL=%s/fas/%s/%s/%s/%s\n",
                   $sinfo{'server'},
                   $sinfo{'owner'},
                   $sinfo{'share'},
                   $sinfo{'user'},
                   $sinfo{'pkey'};
          }
        }
      }
    }
  } else {
    my $fmt = "%-32s %s\n";
    my @list = ();

    if (@shares) {
      print "\n";
      printf($fmt,'share(alias)','owner');
      printf($fmt,'------------','-----');
      foreach my $sshare (@sshares) {
        unless (grep /^\Q$sshare\E$/,@shares) {
          push @list,sprintf($fmt,$sshare,$owner);
        }
      }
      if ($foreign) {
        # foreign FEXID => list only own shares
        foreach my $share (@shares) {
          push @list,sprintf($fmt,$share,$owner);
        }
      } else {
        foreach my $share (@shares) {
          my %sinfo = (
            owner => '',
            user => '',
          );
          if (open $share,"$sharedir/$share.cf") {
            while (<$share>) {
              $sinfo{$1} = $2 if /^($sp)=(.+)/;
            }
            close $share;
            $sinfo{'pkey'} ||= 'id' if $sinfo{'owner'} eq $sinfo{'user'};
            my $sinfo = 1;
            foreach my $i (@sp) {
              $sinfo &&= $sinfo{$i};
            }
            if ($sinfo) {
              push @list,sprintf($fmt,$share,$sinfo{'owner'});
            }
          }
        }
      }
      print asort(@list);
      # print "\nusage: $prg -l SHARE:\n" if $prg =~ /pull/;
    }
  }
}


sub queryshare {
  my $share = shift;
  my $mode = shift||'';
  my $sshare = '';
  my $access = 'none';
  my $cmd;
  my $list;
  my @list;
  my $FEXID;
  local $_;

  if ($share eq '_') {
    $sshare = $share;
  } elsif (not -f "$sharedir/$share.cf" and $ENV{FEXXX} or $opt_i) {
    # foreign FEXID ==> own shares
    $sshare = $share;
    &getfid;
    $user = $owner;
  } else {
    ($sshare,$server,$owner,$user,$pkey) = sharedata($share);
    if ($server and $sshare and $owner and $owner eq $user) {
      # own share
    } elsif ($server and $sshare and $owner and $user and $pkey) {
      # share user
    } else {
      warn "$prg: corrupt data in $sharedir/$share\n";
      return $access;
    }
  }

  if ($share eq '_' or $opt_i or $owner and $owner eq $user and not $pkey) {
    &getfid;
    $FEXID = "$url $owner $id";
    $server = $url;
    $user = $owner;
  } else {
    $FEXID = "$server $user PKEY:$pkey";
  }
  $list = "$sharedir/$share.list";
  unlink $list;
  $ENV{FEXID} = $FEXID;
  $cmd = "fexsend -~ LISTSHARE $owner:share=$sshare |";
  @list = grep { not m:^server/user: } vsystem($cmd);
  if (scalar(@list) > 1) {
    open $list,'>',$list or die "$prg: cannot write $list - $!\n";
    foreach (@list[0..1]) {
      $access = $1 if /^access=(\w+)$/;
    }
    print {$list} @list;
    close $list;
    open $list,$list or die "$prg cannot reopen $list - $!\n";
    if ($mode eq 'users') {
      @list = grep /^http/,<$list>;
    } elsif ($mode eq 'archives') {
      @list = grep /^$ap$/,<$list>;
    } else {
      @list = grep /^\S+ $vp/,<$list>;
    }
    close $list;
  }
  return $access,@list;
}


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


sub vsystem {
  my @cmd = @_;
  my $cmd;
  local $ENV{CALLER} = $prg;
  local $_;

  if ($_=$ENV{FEXID} and ($opt_v or $no_action)) {
    my @fid = split;
    $fid[-1] =~ s/[a-z0-9]/*/g;
    warn "FEXID='@fid'\n";
  }

  $_ = "@cmd";
  if (scalar(@cmd) == 1 and /\s/ and not (/^\w+=/ or /[\'\"\`\\*?&|<>;]/)) {
    @cmd = split;
  }
  if ($opt_v or $no_action) {
    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";
    }
  }

  return if $no_action;

  $cmd = "@cmd";
  if (scalar(@cmd) == 1) {
    if ($cmd =~ s/\|$//) {
      my @a = `$cmd`;
      return wantarray ? @a : join('',@a);
    } else {
      system $cmd;
    }
  } else {
    system @cmd;
  }
}


# 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 urldecode {
    local $_ = shift;
    s/\%([a-f\d]{2})/chr(hex($1))/ige;
    return $_;
}


sub uniq {
    my %x;
    grep !$x{$_}++,@_;
}


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


sub searchpath {
  my ($prg,$path,@PATH);

  @PATH = split(':',$ENV{PATH});
  foreach $prg (@_) {
    foreach $path (@PATH) {
      return $prg if -x "$path/$prg";
    }
  }
  return '';
}


sub strip {
  local $_ = shift;
  s/^\s+//;
  s/\s+$/\n/;
  while (s/^#.*\n//m) {}
  return $_;
}


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

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


sub versiondate {
  my @d = gmtime shift;
  return sprintf("%d%02d%02d_%02d%02d%02d",
                 $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
}


# emulate mkdir -p
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";
}
