#!/usr/bin/perl -wT

# FEX CGI for file archive sharing
#
# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
#

BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }

# use utf8;
use strict qw(vars);
use Fcntl qw(:flock :seek :mode);
use Digest::MD5	qw(md5_hex);

# add fex lib
(our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
die "$0: no $FEXLIB\n" unless -d $FEXLIB;

our ($spooldir,$dkeydir,$akeydir);
our ($archive_sharing,$mdomain,$MB,$DS,$hostname,$admin,$locale);
our ($vp,$RA);
our ($sender_from,$sendmail,$bcc);
our (@remote_domains);
our (%PARAM);
our $akey = '';

# load common code, local config : $HOME/lib/fex.ph
require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";

our $error = 'F*EX file archive sharing ERROR';

my $share = '';
my $archive = '';
my $owner = '';
my $user = '';
my $master = '';
my $pkey = '';
my $id = '';
my $aid = '';
my $access = '';
my $remove = '';
my $rename = '';
my $clone = '';
my $copy = '';
my $modify = '';
my $comment = '';
my $maxversions;
my $show = '';
my $notify = '';
my $notification = '';
my $nshare = '';
my $nuser = '';
my $description = '';
my $narchive = '';
my $help;
my $accesshelp;
my $logout = '';
my $style;
my $atype = 'tar|tgz|zip|7z|gz';
my $alignc = 'align="center"';
my $alignl = 'align="left"';
my $alignr = 'align="right"';
my $back = "javascript:history.back()";
my $CGI = $ENV{SCRIPT_NAME};
my $URI = $ENV{REQUEST_URI};
my $formpara =
  'method="post" accept-charset="UTF-8" enctype="multipart/form-data"';
my $head =
  qq'$ENV{SERVER_NAME} F*EX <a href="/sharing/">archive sharing</a>';

$ENV{LOCALE} = $locale = 'english';

#    $URI =~ m:^/fas\?owner=(.+)\?share=(.+)\?user=([^\?]+)$:)

if ($URI =~ m:^/fas/(.+\@[\w.-]+)/([\w-]+)/(.+\@[\w.-]+)/-$:) {
  query_pkey(norm($1),$2,norm($3));
  exit;
}

# user share URL
if ($URI =~ m:^/fas/(.+\@[\w.-]+)/([\w-]+)/(.+\@[\w.-]+)/(\w+)$:) {
  $owner = norm($1);
  $share = $2;
  $user  = norm($3);
  $pkey  = $4;
  $show  = "share:$share:archives";
}

if ($URI =~ m:^/fas\?owner=([^/?]+)$:) {
  redirect("/fup?from=$1?forward=$ENV{SCRIPT_NAME}");
}

$akey = $ENV{AKEY}||'';

# look for CGI parameters
&parse_parameters;
foreach my $v (keys %PARAM) {
  my $vv = $PARAM{$v};
  if    ($v =~ /^pkey$/i and $vv =~ /^(\w+)$/) { $pkey = $1 }
  elsif ($v =~ /^akey$/i and $vv =~ /^(\w+)$/) { $akey = $1 }
  elsif ($v =~ /^share$/i)                     { $share = norm($vv) }
  elsif ($v =~ /^archive$/i)                   { $archive = anorm($vv) }
  elsif ($v =~ /^user$/i)                      { $user = norm($vv) }
  elsif ($v =~ /^aid$/i)                       { $aid = $vv }
  elsif ($v =~ /^owner$/i)                     { $owner = norm($vv) }
  elsif ($v =~ /^remove$/i)                    { $remove = norm($vv) }
  elsif ($v =~ /^rename$/i)                    { $rename = norm($vv) }
  elsif ($v =~ /^clone$/i)                     { $clone = norm($vv) }
  elsif ($v =~ /^copy$/i)                      { $copy = norm($vv) }
  elsif ($v =~ /^modify$/i)                    { $modify = norm($vv) }
  elsif ($v =~ /^comment$/i)                   { $comment = $vv }
  elsif ($v =~ /^maxversions$/i)               { $maxversions = norm($vv) }
  elsif ($v =~ /^show$/i)                      { $show = norm($vv) }
  elsif ($v =~ /^access$/i)                    { $access = norm($vv) }
  elsif ($v =~ /^notify$/i)                    { $notify = norm($vv) }
  elsif ($v =~ /^notification$/i)              { $notification = norm($vv) }
  elsif ($v =~ /^description$/i)               { $description = $vv }
  elsif ($v =~ /^nshare$/i)                    { $nshare = norm($vv) }
  elsif ($v =~ /^narchive$/i)                  { $narchive = anorm($vv) }
  elsif ($v =~ /^nuser$/i)                     { $nuser = lc(norm($vv)) }
}

$akey = '' unless -f "$akeydir/$akey/@";

redirect("/fup?forward=$ENV{REQUEST_URI}") unless $akey or $pkey;

# if ($owner and $share and $user and not $akey and not $pkey) {
#   query_pkey($owner,$share,$user);
#   exit;
# }

if ($akey and not $pkey) {
  $owner = untaint(basename(readlink("$akeydir/$akey")||'/'));
  if ($id = readline1("$owner/@")) {
    $id = untaint($id);
    $user = $owner;
  } else {
    redirect("/fup?forward=$ENV{REQUEST_URI}");
    # redirect("/fup?forward=fas");
  }
}

http_die("owner missing") unless $owner;
http_die("user missing")  unless $user;

$owner .= '@'.$mdomain if $mdomain and $owner !~ /@/;
$user  .= '@'.$mdomain if $mdomain and $user  !~ /@/;

unless (checkaddress($owner)) {
  http_die("$owner is not a valid email address")
}
unless (checkaddress($user) or $user =~ /\.test$/) {
  http_die("$user is not a valid email address")
}
unless ($share =~ /^[\w-]*$/) {
  http_die("$share is not a valid share name")
}

my $sharing = readlink_("$owner/\@ARCHIVE_SHARING");
if ($sharing =~ /no/i or not $archive_sharing and $sharing !~ /yes/i) {
  http_die("archive sharing is not allowed");
}

my $shared = "$owner/SHARE";

if ($pkey) {
  http_die("share missing") unless $share;
  if ($owner eq $user) {
    $id = readline1("$owner/@")||'';
    if ($pkey eq md5_hex($id)) {
      $pkey = '';
      $akey = untaint(md5_hex("$owner:$id"));
      mksymlink("$akeydir/$akey","../$owner");
    } else {
      http_die("wrong share URL");
    }
  } else {
    my $rpkey = readline1("$shared/$share/users/$user/pkey")||'';
    # passkey = short alias of pkey
    if (length($pkey) == 8) {
      $pkey = $rpkey if $pkey eq substr(md5_hex($rpkey),0,8);
    }
    http_die("wrong pkey") if $pkey ne $rpkey;
    my $access = readlink("$shared/$share/users/$user/access")
      or http_die("no access for $owner/$share/$user");
    $master = $user if $access eq 'manage';
    $CGI .= "?owner=$owner?share=$share?user=$user?pkey=$pkey";
  }
}

$help = qqq(qq(
  '<p><hr><p>'
  'You can share archive files with other users.<br>'
  'Archives and users are stored in a so called <em>share</em> on the F*EX server.<br>'
  'A <em>share archive</em> is a tar or zip container file with a unique name and a version date.<br>'
  'An <em>archive set</em> comprises all versions of this archive.<br>'
));
if ($id) {
  $help .= qqq(qq(
    'To create new archives or users click on a share name.<br>'
  ));
} elsif ($master) {
  $help .= qqq(qq(
    'There can be any number of shares. Currently you see only (this) one.<br>'
  ));
} else {
  $help .= qqq(qq(
    'There can be any number of shares. Currently you see only (this) one.<br>'
    'Only the share master(s) can see, add or modify users.<br>'
  ));
}
$help .= qqq(qq(
  'To upload or download archive files use'
  '<a href="http://fex.belwue.de/usecases/fexpush.html">fexpush and fexpull</a>'
  '<p>'
  '<a href="/sharing/">More information</a>'
));
$accesshelp = qqq(qq(
  '<p>'
  '<b>user access rights:</b>'
  '<table border=1>'
  '<tr><td $alignc>read<td><ul>'
  '    <li>read archives'
  '</ul></tr>'
  '<tr><td $alignc>write<td><ul>'
  '    <li>read archives<br>'
  '    <li>write new archive version'
  '</ul></tr>'
  '<tr><td $alignc>add<td><ul>'
  '    <li>read archives<br>'
  '    <li>write new archive version<br>'
  '    <li>add new archive set</tr>'
  '</ul></tr>'
  '<tr><td $alignc>manage<td><ul>'
  '    <li>read archives<br>'
  '    <li>write new archive version<br>'
  '    <li>add new archive set<br>'
  '    <li>add new user<br>'
  '    <li>remove archive (version)<br>'
  '    <li>remove user<br>'
  '    <li>(un)set user access rights read|write|add'
  '</ul></tr>'
  '</table>'
  '<p>'
  '[<a href="/sharing/">More information</a>]'
));

if ($modify =~ /^comment:(.+):(.+):(($vp)\.($atype))$/) {
  my $share = $1;
  my $archive = $2;
  my $vt = $3;
  my $version = $4;
  my $container = $5;
  my $avtd = "$shared/$share/archives/$archive/$vt";
  unless (-f "$avtd/data") {
    http_die("$share:$archive:$vt does not exist");
  }
  my $comment = unhtml(decode_utf8(slurp("$avtd/comment")||''));
  $comment =~ s/\n/ /g;
  http_header('200 OK');
  print html_header($head);
  pq(qq(
    '<form action="/$CGI" $formpara>'
    'Comment for "$share:$archive:$version"<br>'
    '<input type="text" name="comment" value="$comment" size="64"><br>'
    '<input type="hidden" name="share" value="$share">'
    '<input type="hidden" name="archive" value="$archive:$vt">'
    '<input type="submit" value="save">'
    '</form>'
  ));
  exit;
}

if ($share and defined $PARAM{comment} and
    $archive =~ /(.+)_($vp\.($atype))$/)
{
  my $archive = $1;
  my $vt = $2;
  my $sds = "$shared/$share";
  unless ($id or $master) {
    if (readlink_("$sds/archives/$archive/$vt/uploader") ne $user) {
      http_die("you are not the uploader of $share:$archive:$vt");
    }
  }
  $comment =~ s/[\r\n]/ /g;
  $comment =~ s/^\s+//;
  $comment =~ s/\s+$//;
  my $cf = "$sds/archives/$archive/$vt/comment";
  if (open $cf,'>',$cf) {
    print {$cf} $comment,"\n";
    close $cf;
    faslog($sds,"$user changed comment for $archive:$vt");
  }
  if ($id or $master) {
    redirect("/$CGI?show=archive:$share:$archive");
  } else {
    redirect("/$CGI?show=archive:$archive");
  }
}

if ($id) {

  $logout = qq'[<a href="/fup?logout=logout">logout</a>]';

  if ($share and $share ne '_') {
    my $uo = "$shared/$share/users/$owner";
     unless (-d $uo) {
       mkdirp($uo);
       mksymlink("$uo/notification",'yes');
     }
  }

  if ($remove =~ /^share:([^\s\/]+)$/) {
    my $share = $1;
    my $sds = "$shared/$share";
    if ($sds =~ s/!$//) {
      rmrf($sds);
    } else {
      my @n;
      my $na = scalar(@n=glob("$sds/archives/*"));
      my $nu = scalar(@n=glob("$sds/users/*/pkey"));
      if ($nu or $na) {
        http_header('200 OK');
        print html_header($head);
        $nu = "$nu user"    . ($nu == 1 ? '' : 's');
        $na = "$na archive" . ($na == 1 ? '' : 's');
        pq(qq(
          '<h3>Share "$share" contains $na and $nu.</h3>'
          '<p>'
          '[<a href="/$CGI?remove=share:$share!">really remove</a>]'
          '[<a href="$back">keep</a>]'
          '</body></html>'
        ));
        exit;
      } else {
        rmrf($sds);
      }
    }
    redirect("/$CGI");
  }

  if ($clone =~ /^share:(.+)$/) {
    my $share = $1;
    if ($nshare) {
      if (-e "$shared/$nshare") {
        http_die("share $nshare does already exist");
      }
      unless (-d "$shared/$share") {
        http_die("unknown share $share");
      }
      unless (mkdir "$shared/$nshare") {
        http_die("cannot mkdir $nshare - $!\n");
      }
      esystem("rsync -a --exclude data $shared/$share/* $shared/$nshare/");
      unlink "$shared/$nshare/log";
      foreach my $a (glob "$shared/$nshare/archives/*/*") {
        $a = untaint($a);
        unlink "$a/download","$a/dkey";
      }
      foreach my $p (glob "$shared/$nshare/users/*/pkey") {
        $p = untaint($p);
        my $pkey = randstring(32);
        if (open $p,'>',$p) {
          print {$p} "$pkey\n";
          close $p;
        }
      }
      foreach my $data (glob "$shared/$share/archives/*/*/data") {
        my $ndata = $data;
        $ndata =~ s:\Q/$share/:/$nshare/:;
        link untaint($data),untaint($ndata) or
          http_die("cannot link $ndata - $!\n");
      }
      redirect("/$CGI");
    } else {
      http_header('200 OK');
      print html_header($head);
      pq(qq(
        '<form action="/$CGI" $formpara>'
        'Clone share "$share" to'
        '<input type="text"   name="nshare" size="16">'
        '<input type="hidden" name="clone" value="share:$share">'
        '<input type="submit" value="ok">'
        '</form>'
        '<p>'
        '<a href="$back">back</a>'
        '</body></html>'
      ));
      exit;
    }
  }

  if ($copy =~ /^archive:(.+):(.+):($vp\.($atype))$/) {
    my $share = $1;
    my $archive = $2;
    my $avt = $3;
    my $sda = "$shared/$share/archives";
    if ($narchive) {
      if (-e "$sda/$narchive/$avt") {
        http_die("archive $narchive:avt does already exist in share $share");
      }
      unless (-d "$sda/$archive/$avt") {
        http_die("unknown archive $archive:$avt in share $share");
      }
      unless (-d "$sda/$narchive") {
        http_die("unknown archive $narchive in share $share");
      }
      esystem("rsync -a --exclude data $sda/$archive/$avt $sda/$narchive/");
      faslog("$shared/$share",
             "$user copied archive $archive:$avt to archive $narchive");
      unlink "$sda/$narchive/$avt/download";
      unlink "$sda/$narchive/$avt/dkey";
      my $data = "$sda/$archive/$avt/data";
      my $ndata = "$sda/$narchive/$avt/data";
      link $data,$ndata or http_die("cannot link $data to $ndata - $!\n");
      if ($nshare eq '_') {
        my $dkey = randstring(8);
        symlink "../$sda/$narchive/$avt","$dkeydir/$dkey" and
        symlink $dkey,"$sda/$narchive/$avt/dkey";
      }
      redirect("/$CGI?show=archive:$share:$narchive");
    } else {
      my $archiveselect = '';
      foreach my $a (glob("$sda/*")) {
        if (-d $a and not -e "$a/$avt") {
          $archiveselect .= sprintf '<option>%s</option>',basename($a);
        }
      }
      http_header('200 OK');
      print html_header($head);
      if ($archiveselect) {
        pq(qq(
          '<form action="/$CGI" $formpara>'
          'Copy archive "$share:$archive:$avt" to archive set'
          '<select name="narchive" size="1">$archiveselect</select>'
          '<input type="hidden" name="copy" value="archive:$share:$archive:$avt">'
          '<input type="submit" value="ok">'
          '</form>'
        ));
      } else {
        pq(qq(
          '<h3>No other archive sets available</h3>'
          '[<a href="/$CGI?show=share:$share:archives">manage archive sets</a>]'
        ));
      }
      pq(qq(
        '<p>'
        '[<a href="$back">back</a>]'
        '</body></html>'
      ));
      exit;
    }
  }

  if ($clone =~ /^archive:(.+):(.+)$/) {
    my $share = $1;
    my $archive = $2;
    my $sds = "$shared/$share";
    if ($nshare) {
      my $sdn = "$shared/$nshare";
      if (-e "$sdn/archives/$archive") {
        http_die("archive $archive does already exist in share $nshare");
      }
      unless (-d "$sds/archives/$archive") {
        http_die("unknown archive $archive in share $share");
      }
      esystem("rsync -a --exclude data $sds/archives/$archive $sdn/archives");
      faslog($sdn,"$user copied archive $archive from share $share");
      foreach my $a (glob "$sdn/archives/$archive/*") {
        $a = untaint($a);
        unlink "$a/download","$a/dkey";
      }
      foreach my $data (glob "$sds/archives/$archive/*/data") {
        my $ndata = $data;
        $ndata =~ s:\Q/$share/:/$nshare/:;
        unless (link untaint($data),untaint($ndata)) {
          http_die("cannot link $ndata - $!\n");
        }
      }
      if ($nshare eq '_') {
        foreach my $a (glob "$sdn/archives/$archive/*") {
          $a = untaint($a);
          my $dkey = randstring(8);
          symlink "../$a","$dkeydir/$dkey" and
          symlink $dkey,"$a/dkey";
        }
      }
      redirect("/$CGI?show=share:$nshare:archives");
    } else {
      my $shareselect = '';
      foreach my $s (glob("$shared/*")) {
        if (-d $s and not -e "$s/archives/$archive") {
          $shareselect .= sprintf '<option>%s</option>',basename($s);
        }
      }
      http_header('200 OK');
      print html_header($head);
      if ($shareselect) {
        pq(qq(
          '<form action="/$CGI" $formpara>'
          'Copy archive set "$archive" to share'
          '<select name="nshare" size="1">$shareselect</select>'
          '<input type="hidden" name="clone" value="archive:$share:$archive">'
          '<input type="submit" value="ok">'
          '</form>'
        ));
      } else {
        pq(qq(
          '<h3>No other shares available</h3>'
          '[<a href="/$CGI?show=shares">manage shares</a>]'
        ));
      }
      pq(qq(
        '<p>'
        '[<a href="$back">back</a>]'
        '</body></html>'
      ));
      exit;
    }
  }

  if ($nshare) {
    $nshare =~ s/[^\w-]/_/g;
    my $sdn = "$shared/$nshare";
    unless (-d $sdn) {
      mkdirp("$sdn/users");
      symlink 'yes',"$sdn/notification";
      faslog($sdn,"$user created share");
    }
    redirect("/$CGI");
  }

  if (defined($maxversions) and $share) {
    my $mv = 0;
    my $sds = "$shared/$share";
    if (length($archive)) {
      my $versions = "$sds/archives/$archive/versions";
      unlink $versions;
      if ($maxversions =~ /^(\d+)$/ and $mv = int($1)) {
        symlink $mv,$versions;
      }
      faslog($sds,"$user set maxversions=$mv for archive $archive");
      redirect("/$CGI?show=archive:$share:$archive");
    } else {
      my $versions = "$sds/versions";
      unlink $versions;
      if ($maxversions =~ /^(\d+)$/ and $mv = int($1)) {
        symlink $mv,$versions;
      }
      faslog($sds,"$user set maxversions=$mv as default");
      redirect("/$CGI?show=share:$share:archives");
    }
  }

  if ($show =~ /^log:(.+)/) {
    my $share = $1;
    my $log = "$shared/$share/log";
    my @log = ();
    open $log,$log or http_die("cannot open $share/log - $!\n");
    http_header('200 OK');
    print html_header($head);
    my $sv = '';
    $sv .= qq' [<a href="/$CGI?show=share:$share:archives">show archive sets</a>]';
    if ($share ne '_') {
      $sv .= qq' [<a href="/$CGI?show=share:$share:users">show users</a>]';
    }
    $sv .= qq' [<a href="/$CGI">show shares</a>]';
    pq(qq(
      '<table>'
      '<tr><td><b>owner: <td><b>$owner</tr>'
      '<tr><td><b>share: <td><b>$share</tr>'
      '</table>'
      '<p>'
      '$sv'
      '<p>'
      '<pre>'
    ));
    while (<$log>) {
      s/</&lt;/g;
      push @log,$_;
    }
    print reverse @log;
    pq(qq(
      '</pre>'
      '$logout'
      '</body></html>'
    ));
    exit;
  }

} else { # not owner

  if ($show eq 'shares') {
    # share index
    $CGI =~ s/\?.*//;
    http_header('200 OK');
    print html_header($head);
    my ($oowner,$share);
    my @shares = ();
    foreach my $share (_sort(glob("$user/SHARE/*"))) {
      push @shares,untaint(basename($share)) if -d $share;
    }
    if (@shares) {
      pq(qq(
        '<h3>shares of owner $user:</h3>'
        '<table border="1">'
        '<tr><th>share<th>archive sets<th>users<th>size<th>action</tr>'
      ));
      foreach my $share (@shares) {
        my $sds = "$user/SHARE/$share";
        my @n;
        my $na = scalar(@n=glob("$sds/archives/*"));
        my $nu = scalar(@n=glob("$sds/users/*/pkey"));
        my $size = 0;
        map { $size += -s } glob("$sds/archives/*/*/data");
        $size = int($size/$MB)||'<1' if $size;
        pq(qq(
          '<tr>'
          '<td $alignc><a href="/$CGI?show=share:$share:archives">$share</a>'
          '<td $alignr>$na'
          '<td $alignr>$nu'
          '<td $alignr>$size&nbsp;MB'
        ));
        if ($share eq '_') {
          pq(qq'<td>');
        } else {
          pq(qq(
            '<td>[<a href="/$CGI?remove=share:$share">remove</a>]'
            '    [<a href="/$CGI?clone=share:$share">clone</a>]'
          ));
        }
        pq(qq'</tr>');
      }
      pq(qq(
        '</table>'
        '<p>'
      ));
    }
    othershares($user);
    exit;
  }

  if ($master and $clone =~ /^share:(.+)$/) {
    my $share = $1;
    my $sds = "$shared/$share";
    if (readlink_("$sds/users/$master/access") ne 'manage') {
      http_die("no access for $master to $owner/$share");
    }
    unless (-d $sds) {
      http_die("unknown share $share");
    }
    my $ms = "$master/SHARE/$share";
    if (-d $ms) {
      http_die(qq'you already have a share "$share"');
    }
    mkdirp("$master/SHARE");
    esystem("rsync -a --exclude data $sds $master/SHARE");
    unlink "$ms/log";
    foreach my $u (glob "$ms/users/*") {
      my $p = untaint("$u/pkey");
      my $pkey = randstring(32);
      if (open $p,'>',$p) {
        print {$p} "$pkey\n";
        close $p;
      }
    }
    unlink "$ms/users/$master/pkey";
    unlink "$ms/users/$master/access";
    foreach my $a (glob "$ms/archives/*/*") {
      $a = untaint($a);
      unlink "$a/download","$a/dkey";
    }
    foreach my $data (glob "$sds/archives/*/*/data") {
      my $ndata = $data;
      $ndata =~ s:\Q$owner:$master:;
      unless (link untaint($data),untaint($ndata)) {
        http_die("cannot link $ndata - $!\n");
      }
    }
    http_header('200 OK');
    print html_header($head);
    pq(qq(
      '<h3>Share "$share" cloned from $owner to your account $master</h3>'
      '<p>'
      '<a href="/$CGI">continue</a>'
      '</body></html>'
    ));
    exit;
  }

  if ($clone =~ /^archive:(.+):(.+)$/) {
    my $share = $1;
    my $archive = $2;
    unless (-f "$user/@") {
      http_die("$user is not a registered full user");
    }
    my $sharing = readlink_("$user/\@ARCHIVE_SHARING");
    if ($sharing =~ /no/i or not $archive_sharing and $sharing !~ /yes/i) {
      http_die("archive sharing is not allowed for user $user");
    }
    my $sds = "$shared/$share";
    unless (-d "$sds/users/$user") {
      http_die("no access for $user to $owner/$share");
    }
    my $ushared = "$user/SHARE";
    if ($nshare and $aid) {
      if ($aid ne readline1("$user/@")||'') {
        http_die("wrong auth-ID for user $user");
      }
      my $usn = "$ushared/$nshare";
      if (-e "$usn/archives/$archive") {
        http_die("archive $archive does already exist in your share $nshare");
      }
      unless (-d "$sds/archives/$archive") {
        http_die("unknown archive $archive in $owner/$share");
      }
      esystem("rsync -a --exclude data $sds/archives/$archive $usn/archives");
      faslog($usn,"$user copied archive $archive from share $owner:$share");
      foreach my $a (glob "$usn/archives/$archive/*") {
        $a = untaint($a);
        unlink "$a/download","$a/dkey";
      }
      foreach my $data (glob "$sds/archives/$archive/*/data") {
        my $ndata = $data;
        $ndata =~ s:\Q/$share/:/$nshare/:;
        $ndata =~ s:\Q$owner:$user:;
        unless (link untaint($data),untaint($ndata)) {
          http_die("cannot link $ndata - $!\n");
        }
      }
      if ($nshare eq '_') {
        foreach my $a (glob "$usn/archives/$archive/*") {
          $a = untaint($a);
          my $dkey = randstring(8);
          symlink "../$a","$dkeydir/$dkey" and
          symlink $dkey,"$a/dkey";
        }
      }
      redirect("/$CGI");
    } else {
      mkdirp("$user/SHARE/_/archives");
      my $shareselect = '';
      foreach my $s (glob("$user/SHARE/*")) {
        if (-d $s and not -e "$s/archives/$archive") {
          $shareselect .= sprintf '<option>%s</option>',basename($s);
        }
      }
      http_header('200 OK');
      print html_header($head);
      if ($shareselect) {
        pq(qq(
          '<form action="/$CGI" $formpara>'
          'Your account: $user<br>'
          'Your auth-ID: <input type="password" name="aid" size="12">'
          '<p>'
          'Copy archive set "$archive" from $owner share "$share" to your share'
          '<select name="nshare" size="1">$shareselect</select>'
          '<input type="hidden" name="clone" value="archive:$share:$archive">'
          '<input type="submit" value="ok">'
          '</form>'
        ));
      } else {
        pq(qq(
          '<h3>You already have a archive set "$archive" in your account $user</h3>'
        ));
      }
      pq(qq(
        '<p>'
        '<a href="$back">back</a>'
        '</body></html>'
      ));
      exit;
    }
  }
}

if ($id or $master) {

  if ($show =~ /^share:(.+):users/) {
    my $share = $1;
    my $sds = "$shared/$share";
    my $ssa = "show=share:$share:archives";
    my $fas = "$ENV{PROTO}://$ENV{HTTP_HOST}/$ENV{SCRIPT_NAME}";
    unless (-d $sds) {
      http_die("no such share $owner/$share");
    }
    if ($master and readlink_("$sds/users/$master/access") ne 'manage') {
      http_die("no access for $master to $owner/$share");
    }
    http_header('200 OK');
    print html_header($head);
    pq(qq(
      '<script>'
      'function popup(title,text) {'
      "  var w = window.open('','','width=1200,height=160');"
      "  w.document.write('<title>'+title+'</title>');"
      "  w.document.write(text);"
      "  w.document.write('<p><a href=\"#\" onclick=\"window.close()\">close</a>');"
      '  w.document.close();'
      '}'
      '</script>'
    ));
    if ($master) {
      pq(qq(
        '<table>'
        '<tr><td><b>share: <td><b>$share</tr>'
        '<tr><td><b>owner: <td><b>$owner</tr>'
        '<tr><td><b>user:  <td><b>$user</b> (logged in)</tr>'
        '<tr><td><b>access:<td><b>manage</tr>'
        '</table>'
        '<p>'
        '[<a href="/$CGI?$ssa">show share</a>]'
        '<p>'
      ));
    } else { # owner
      my $sv = '';
      $sv .= qq' [<a href="/$CGI?$ssa">show archive sets</a>]';
      $sv .= qq' [<a href="/$CGI">show all shares</a>]';
      $sv .= qq' [<a href="/$CGI?show=log:$share">view log</a>]' if -f "$sds/log";
      my $sowner =
        sprintf qq'<a href="" onclick="alert(\'%s/%s/%s/%s/%s\')">%s</a>',
                $fas,$owner,$share,$owner,md5_hex($id),$owner;
      pq(qq(
        '<table>'
        '<tr><td><b>owner:<td><b>$sowner</b> (logged in)</tr>'
        '<tr><td><b>share:<td><b>$share</tr>'
        '</table>'
        '<p>'
        '$sv'
        '<p>'
      ));
    }
    pq(qq(
      '<p>'
      '<table><tr valign="top"><td>'
      '<table border="1">'
      '<tr><th>user'
      '    <th>access'
      '    <th title="send notification email for new uploads">upload<br>notification'
#     '    <th>quota'
      '    <th>action'
      '</tr>'
    ));
    my @users = glob("$sds/users/*");
    foreach my $user (@users) {
      my $upkey = readline1("$user/pkey") or next;
      my $access = readlink("$user/access")||'none';
      my $notification = readlink("$user/notification")||'no';
      $user = basename($user);
      my $su = "$share:$user";
      my $nny = '';
      if ($notification eq 'no') {
        $nny =
          qq'<a href="/$CGI?notification=$su:never">never</a>|'.
          qq'no|'.
          qq'<a href="/$CGI?notification=$su:yes">yes</a>';
      } elsif ($notification eq 'never') {
        $nny =
          qq'never|'.
          qq'<a href="/$CGI?notification=$su:no">no</a>|'.
          qq'<a href="/$CGI?notification=$su:yes">yes</a>';
      } elsif ($notification eq 'yes') {
        $nny =
          qq'<a href="/$CGI?notification=$su:never">never</a>|'.
          qq'<a href="/$CGI?notification=$su:no">no</a>|'.
          qq'yes';
      }
      my $quota = 0;
      my $read   = $access eq 'read'   ? 'read' :
                   qq'<a href="/$CGI?access=$su:read">read</a>';
      my $write  = $access eq 'write'  ? 'write' :
                   qq'<a href="/$CGI?access=$su:write">write</a>';
      my $add    = $access eq 'add'    ? 'add' :
                   qq'<a href="/$CGI?access=$su:add">add</a>';
      my $manage = $access eq 'manage' ? 'manage' :
                   qq'<a href="/$CGI?access=$su:manage">manage</a>';
      pq(qq'<tr>');
      # passkey = short alias of pkey
      my $supkey = substr(md5_hex($upkey),0,8);
      my $title = 'share user URL';
      my $popup =
        "share user direct URL:<br>\\n".
        "<nobr>$fas/$owner/$share/$user/$upkey</nobr><p>\\n".
        "share user login URL:<br>\\n".
        "<nobr>$fas/$owner/$share/$user/-</nobr><br>\\n".
        "passkey: $supkey\\n";
      pq(qq(
        '<td><a href="" onclick="popup(\'$title\',\'$popup\')">$user</a>'
        '<td $alignc>$access'
        '<td $alignc>$notification'
#       '<td $alignc>$quota'
        '<td><ul>'
      ));
      if ($notification ne 'never') {
        pq(qq'    <li><a href="/$CGI?notify=$su">send user info mail</a><br>');
      }
      if ($user =~ /^anonymous/) {
        pq(qq(
          '    <li><a href="/$CGI?remove=user:$su">remove user</a><br>'
        ));
      } elsif ($id) {
        pq(qq(
          '    <li>access=[$read|$write|$add|$manage]<br>'
          '    <li>notification=[$nny]<br>'
          '    <li><a href="/$CGI?remove=user:$su">remove user</a><br>'
        ));
      } elsif ($master eq $user) {
        pq(qq(
          '    <li>notification=[$nny]<br>'
        ));
      } elsif ($access ne 'manage') {
        pq(qq(
          '    <li>access=[$read|$write|$add]<br>'
          '    <li>notification=[$nny]<br>'
          '    <li><a href="/$CGI?remove=user:$su">remove user</a><br>'
        ));
      }
      pq(qq'</ul></tr>');
    }
    my $nuser = "anonymous\@$ENV{SERVER_NAME}";
    $nuser = '' if -d "$sds/users/$nuser";
    pq(qq(
      '</table>'
      '<form action="/$CGI" $formpara>'
      'new user: <input type="text" name="nuser" value="$nuser" size="40">'
      '<input type="submit" value="create">'
      '<input type="hidden" name="share" value="$share">'
      '</form>'
      '<td>$accesshelp'
      '</tr></table>'
      '$logout'
      '</body></html>'
    ));
    exit;
  }

  if ($show =~ /^archive:([^:]+):([^:]+)(:edit)?/) {
    my $share = $1;
    my $archive = $2;
    my $edit = $3||'';
    my $show = "show=share:$share:archives";
    my $sds = "$shared/$share";
    unless (-d "$sds/archives/$archive") {
      http_die("no such archive $owner/$share/$archive");
    }
    if ($master and readlink_("$sds/users/$master/access") ne 'manage') {
      http_die("no access for $master to $owner/$share");
    }
    my $sd = "$sds/archives/$archive/description";
    if (defined $PARAM{description}) {
      open my $sd,'>',$sd or http_die("cannot write $sd - $!\n");
      $description =~ s/\n*$/\n/;
      print {$sd} $description;
      close $sd;
      faslog($sds,"$user changed description for archive $archive");
    } else {
      chomp($description = slurp($sd)||'');
    }
    $description = unhtml(decode_utf8($description));
    my $ed;
    if ($edit) {
      $ed =
        qq'<br>'.
        qq'<form action="/$CGI?show=archive:$share:$archive" $formpara>'.
        qq'<input type="text" name="description" value="$description" size="64"><br>'.
        qq'<input type="submit" value="save">'.
        qq'</form>';
    } else {
      $description =~ s!(https?://\S+)!<a href="$1">$1</a>!g;
      $ed =
        qq'[<a href="/$CGI?show=archive:$share:$archive:edit">edit description</a>]<br>'.
        qq'<em>$description</em>';
    }
    http_header('200 OK');
    print html_header($head);
    pq(qq'<table>');
    my $td = 'td valign="top"';
    if ($master) {
      my $access = readlink("$sds/users/$master/access")||'none';
      my $key = md5_hex("$archive:$pkey");
      my $afop = qq'<a href="/fop/$owner/$share/$user/$key/$archive">'.
                 qq'$archive</a>';
      pq(qq(
        '<tr><$td><b>share:  <td><b>$share</tr>'
        '<tr><$td><b>owner:  <td><b>$owner</tr>'
        '<tr><$td><b>user:   <td><b>$user</b> (logged in)</tr>'
        '<tr><$td><b>archive:<td><b>$afop</b> $ed</tr>'
        '<tr><$td><b>access: <td><b>$access</tr>'
        '</table>'
        '<p>'
        '[<a href="/$CGI?$show">show share</a>]'
      ));
    } else { # owner
      my $mv = readlink("$sds/archives/$archive/versions")||
               readlink("$sds/versions")||'unlimited'||
               'unlimited';
      my $key = md5_hex("$archive:$id");
      my $afop = qq'<a href="/fop/$owner/$share/$owner/$key/$archive">'.
                 qq'$archive</a>';
      pq(qq(
        '<tr><$td><b>owner:  <td><b>$owner</b> (logged in)</tr>'
        '<tr><$td><b>share:  <td><b>$share</tr>'
        '<tr><$td><b>archive:<td><b>$afop</b> $ed</tr>'
        '<tr><$td><b>max versions:</b><br>(per uploader)<td>'
        '         <form action="/$CGI" $formpara>'
        '         $mv [new value:'
        '	  <input type="text" name="maxversions" size="3">'
        '  	  <input type="hidden" name="share" value="$share">'
        '	  <input type="hidden" name="archive" value="$archive">'
        '	  <input type="submit" value="set">'
        '         will be active after next upload]'
        '	  </form></tr>'
        '</table>'
        '<p>'
        '[<a href="/$CGI?$show">show share</a>]'
        '[<a href="/$CGI?show=shares">show all shares</a>]'
      ));
    }
    pq(qq(
      '<p>'
      '<table border="1">'
    ));
    if ($share eq '_') {
      pq(qq'<tr><th>version<th>container<th>size<th><th>content<th>comment<th>action</tr>');
    } else {
      pq(qq'<tr><th>version<th>container<th>size<th>uploader<th>content<th>comment<th>action</tr>');
    }
    my @archives = glob("$sds/archives/$archive/*");
    foreach my $archive (reverse @archives) {
      my $size = -s "$archive/data" or next;
      my $content = content($archive);
      $size = int($size/$MB)||'<1' if $size;
      $archive =~ m:.*/archives/(.+)/($vp)\.($atype): or next;
      my $avt = $1.'_'.$2.'.'.$3;
      my $cp = "archive:$share:$1:$2.$3";
      my $mod = "comment:$share:$1:$2.$3";
      my $version = $2;
      my $container = $3;
      my $uploader = readlink("$archive/uploader")||$owner;
      my $comment = unhtml(readline1("$archive/comment")||'');
      my $url = "/fop/$owner/$share/$user/";
      if ($id) { $url .= md5_hex("$avt:$id") }
      else     { $url .= md5_hex("$avt:$pkey") }
      $url .= "/$avt";
      if ($share eq '_' and my $dkey = readlink("$archive/dkey")) {
        $url = "$ENV{PROTO}://$ENV{HTTP_HOST}/fop/$dkey/$avt";
        $uploader = ''; # "<code>$url</code>";
      }
      pq(qq(
        '<tr>'
        '<td><a href="$url">$version</a>'
        '<td $alignc>$container'
        '<td $alignr>$size&nbsp;MB'
        '<td><nobr>$uploader</nobr>'
        '<td>$content'
        '<td>$comment'
        '<td>[<a href="/$CGI?remove=$cp">remove</a>]'
        '    [<a href="/$CGI?copy=$cp">copy</a>]'
        '    [<a href="/$CGI?modify=$mod">edit&nbsp;comment</a>]'
        '</tr>'
      ));
    }
    pq(qq(
      '</table>'
      '<p>'
      '[<a href="/fup?from=$user?to=$owner:share=$share?archive=$archive?submit=share?pkey=$pkey">upload file</a>]'
#      '[<a href="/$CGI?$show">back</a>]'
      '<p>'
      '$logout'
      '</body></html>'
    ));
    exit;
  }

  if ($rename =~ /^archive:(.+):(.+)$/) {
    my $share = $1;
    my $archive = $2;
    my $sad = "$shared/$share/archives";
    if ($narchive) {
      if (-e "$sad/$narchive") {
        http_die("archive $narchive does already exist in share $share");
      }
      unless (-d "$sad/$archive") {
        http_die("unknown archive $archive in share $share");
      }
      rename "$sad/$archive","$sad/$narchive"
        or http_die("cannot rename $sad/$archive to $sad/$narchive - $!");
      faslog("$shared/$share","$user renamed archive $archive to $narchive");
      redirect("/$CGI?show=share:$share:archives");
    } else {
      http_header('200 OK');
      print html_header($head);
      pq(qq(
        '<form action="/$CGI" $formpara>'
        'Rename archive set "$archive" in share "$share" to'
        '<input type="text" name="narchive" size="32">'
        '<input type="hidden" name="rename" value="archive:$share:$archive">'
        '<input type="submit" value="ok">'
        '</form>'
        '<p>'
        '<a href="$back">back</a>'
        '</body></html>'
      ));
      exit;
    }
  }

  if ($access =~ /([\w-]+):(.+\@.+):(read|write|add|manage)/) {
    my $share = $1;
    my $suser = $2;
    my $access = $3;
    my $sds = "$shared/$share";
    my $suserd = "$shared/$share/users/$suser";
    unless (-d $suserd) {
      http_die("no such user $owner/$share/$suser");
    }
    if ($suser eq $owner) {
      http_die("cannot modify owner access right");
    }
    if ($master and readlink_("$sds/users/$master/access") ne 'manage') {
      http_die("no access for $master to $owner/$share");
    }
    if ($master and readlink_("$suserd/access") eq 'manage') {
      http_die("cannot modify master user $suser")
    }
    if ($access eq 'manage' and
        (not -f "$suser/@" or grep /ALLOWED|HOSTS/,glob("$suser/\@*"))) {
      http_die("cannot make external user $suser to master user")
    }
    if ($id or readlink_("$suserd/access") ne 'manage') {
      mksymlink("$suserd/access",$access);
      faslog($sds,"$user set access=$access for $suser");
    }
    redirect("/$CGI?show=share:$share:users");
  }

  if ($notification =~ /([\w-]+):(.+\@.+):(yes|no|never)/) {
    my $share = $1;
    my $suser = $2;
    my $notification = $3;
    my $sds = "$shared/$share";
    my $suserd = "$sds/users/$suser";
    if ($master and readlink_("$sds/users/$master/access") ne 'manage') {
      http_die("no access for $master to $owner/$share");
    }
    if ($id or $master eq $suser or
        $suser ne $owner and readlink_("$suserd/access") ne 'manage')
    {
      unless (-d $suserd) {
        http_die("no such user $owner/$share/$suser");
      }
      mksymlink("$suserd/notification",$notification);
      faslog($sds,"$user set notification=$notification for $suser");
      if ($ENV{HTTP_REFERER} =~ /show=.*:users/) {
        redirect("/$CGI?show=share:$share:users");
      } else {
        redirect("/$CGI?show=share:$share:archives");
      }
    }
  }

  if ($notify =~ /(.+):(.+)/) {
    my $share = $1;
    my $suser = $2;
    my $sds = "$shared/$share";
    if ($master and readlink_("$sds/users/$master/access") ne 'manage') {
      http_die("no access for $master to $owner/$share");
    }
    http_die("illegal share user $suser") unless checkaddress($suser);
    $pkey = readline1("$sds/users/$suser/pkey") or
      http_die("no pkey for user $suser");
    my $url = "$ENV{PROTO}://$ENV{HTTP_HOST}/$ENV{SCRIPT_NAME}"
            . "/$owner/$share/$suser/$pkey";
    my $description = decode_utf8(slurp("$sds/description")||'');
    fas_notify($suser,$user,$url,$description);
    faslog($sds,"$user sent notification to $suser");
    http_header('200 OK');
    print html_header($head);
    pq(qq(
      'notfication email has been sent to $suser'
      '<p>'
      '<a href="$back">back</a>'
      '</body></html>'
    ));
    exit;
  }

  if ($remove =~ /^user:([^\s\/]+):([^\s\/]+)/) {
    my $share = $1;
    my $suser = $2;
    my $sds = "$shared/$share";
    my $suserd = "$sds/users/$suser";
    if ($master and readlink_("$sds/users/$master/access") ne 'manage') {
      http_die("no access for $master to $owner/$share");
    }
    if ($id or readlink_("$suserd/access") ne 'manage') {
      rmrf($suserd);
      faslog($sds,"$user removed user $suser");
    }
    redirect("/$CGI?show=share:$share:users");
  }

  if ($remove =~ /^archive:([^\s\/]+?):([^\s\/]+)/) {
    my $share = $1;
    my $archive = $2;
    my $sds = "$shared/$share";
    if ($master and readlink_("$sds/users/$master/access") ne 'manage') {
      http_die("no access for $master to $owner/$share");
    }
    if ($archive =~ s/(.+):($vp\.($atype))$/$1\/$2/ or $archive =~ s/!$//) {
      rmrf("$sds/archives/$archive");
    } else {
      my @n;
      my $nv = scalar(@n=glob("$sds/archives/$archive/*/data"));
      if ($nv) {
        http_header('200 OK');
        print html_header($head);
        $nv = "$nv archive" . ($nv == 1 ? '' : 's');
        pq(qq(
          '<h3>Archive set "$share:$archive" contains $nv.</h3>'
          '<p>'
          '[<a href="/$CGI?remove=archive:$share:$archive!">really remove</a>]'
          '[<a href="$back">keep</a>]'
          '</body></html>'
        ));
        exit;
      } else {
        rmrf("$sds/archives/$archive");
      }
    }
    if ($archive =~ m:(.+)/(.+):) {
      faslog($sds,"$user removed archive $1:$2");
      redirect("/$CGI?show=archive:$share:$1");
    } else {
      faslog($sds,"$user removed archive $archive");
      redirect("/$CGI?show=share:$share:archives");
    }
  }

  if ($share and $narchive) {
    my $sds = "$shared/$share";
    $narchive =~ s/_?$vp//;
    $narchive =~ s/\.($atype)$//;
    mkdirp("$sds/archives/$narchive");
    faslog($sds,"$user created archive $narchive");
    redirect("/$CGI?show=share:$share:archives");
  }

  if ($share and $nuser) {
    my $sds = "$shared/$share";
    $nuser .= '@'.$mdomain if $nuser !~ /@/ and $mdomain;
    unless (checkaddress($nuser) or $nuser =~ /\.test$/) {
      http_die("illegal user $nuser");
    }
    my $dir = "$sds/users/$nuser";
    if (-d $dir) {
      http_die("user $nuser already exists in share $share");
    }
    mkdirp($dir);
    my $pkey = randstring(32);
    open $pkey,'>',"$dir/pkey" or http_die("cannot create $dir/pkey - $!\n");
    print {$pkey} "$pkey\n";
    close $pkey;
    symlink 'read',"$dir/access";
    if ($nuser =~ /^anonymous/) {
      symlink 'never',"$dir/notification";
    } else {
      symlink 'no',"$dir/notification";
    }
    faslog($sds,"$user created user $nuser");
    redirect("/$CGI?show=share:$share:users");
  }

  # default action for master user is show share archives

  if ($master and $share =~ /(.+)/ or $show =~ /^share:(.+):archives/) {
    my $share = $1;
    my $sds = "$shared/$share";
    my $ssu = "show=share:$share:users";
    unless (-d $sds) {
      http_die("no such share $owner/$share");
    }
    if ($master and readlink_("$sds/users/$master/access") ne 'manage') {
      http_die("no access for $master to $owner/$share");
    }
    if ($share ne '_') {
      my $uo = "$sds/users/$owner";
      unless (-d $uo) {
        mkdirp($uo);
        mksymlink("$uo/notification",'yes');
      }
    }
    my $nyn = 'no';
    my $notification = 'yes';
    if (readlink_("$sds/users/$user/notification") eq 'yes') {
      $nyn = 'yes';
      $notification = 'no';
    }
    $notification = "notification=$share:$user:$notification";
    $notification = qq'<a href="/$CGI?$notification">notification</a>';
    my $sd = "$sds/description";
    if (defined $PARAM{description}) {
      open my $sd,'>',$sd or http_die("cannot write $sd - $!\n");
      $description =~ s/[\s\n]*$//;
      print {$sd} $description,"\n";
      close $sd;
    } else {
      chomp($description = slurp($sd)||'');
    }
    $description = decode_utf8($description);
    my $hdescription = '';
    if ($description =~ /\S/) {
      $hdescription = unhtml($description);
      $hdescription =~ s/\n/<br>/g;
      $hdescription =~ s/<br><br>/<p>/g;
      $hdescription =~ s!(https?://\S+)!<a href="$1">$1</a>!g;
      $hdescription = "<em>$hdescription</em>";
    }
    http_header('200 OK');
    print html_header($head);
    my $td = 'td valign="top"';
    if ($master) {
      my $oli = '';
      if ($_ = readlink("$akeydir/$akey") and s/...// and $_ eq $owner) {
        $oli = "(logged in)";
      }
      pq(qq(
        '<table>'
        '<tr><$td><b>share:<td><b>$share</b><br>$hdescription</tr>'
        '<tr><$td><b>owner:        <td><b>$owner</b> $oli</tr>'
        '<tr><$td><b>user:         <td><b>$user</b> (logged in)</tr>'
        '<tr><$td><b>access:       <td><b>manage</tr>'
        '<tr><$td><b>$notification:<td><b>$nyn</tr>'
        '</table>'
        '<p>'
        '[<a href="/$CGI?$ssu">show users</a>]'
#       '[<a href="/$ENV{SCRIPT_NAME}?owner=$user">show own shares</a>]'
        '[<a href="/$CGI?show=shares">show shares</a>]'
        '[<a href="/$CGI?clone=share:$share">clone share</a>]'
        '<p>'
      ));
    } else {
      my $mv = readlink("$sds/versions")||'unlimited';
      my $sv = '';
      $sv .= qq' [<a href="/$CGI?$ssu">show users</a>]' if $share ne '_';
      $sv .= qq' [<a href="/$CGI?show=shares">show shares</a>]';
      $sv .= qq' [<a href="/$CGI?show=log:$share">view log</a>]' if -f "$sds/log";
      pq(qq(
        '<table>'
        '<tr><td><b>owner:<td><b>$owner</b> (logged in)</tr>'
      ));
      if ($share eq '_') {
        $description = '<em>Your personal share</em>';
        pq(qq'<tr><td><b>share:<td><b>_</b><br>$description</tr>');
      } elsif ($show =~ s/:edit$//) {
        pq(qq(
          '<tr><$td><b>share:<td><b>$share</b><br>'
          '<form action="/$CGI" $formpara>'
          '<input type="hidden" name="show" value="$show">'
          '<textarea name="description" cols="80" rows="5">'
          '$description'
          '</textarea><br>'
          '<input type="submit" value="save">'
          '</form></tr>'
        ));
      } else {
        pq(qq(
          '<tr><$td><b>share:'
          '<td><b>$share</b>'
          '[<a href="/$CGI?show=$show:edit">edit description</a>]<br>'
          '$hdescription'
          '</tr>'
        ));
      }
      pq(qq'<tr><td><b>$notification:<td><b>$nyn</tr>') if $share ne '_';
      my $mvt = 'title="max versions per user and per archive"';
      pq(qq(
        '<tr><td><b>max versions:</b><br>(per uploader)<td $mvt>'
        '<form action="/$CGI" $formpara>'
        '$mv [new value: <input type="text" name="maxversions" size="3" $mvt>'
        '<input type="submit" value="set">'
        '<input type="hidden" name="share" value="$share">'
        '(will be active after next upload)]'
        '</form>'
        '</tr>'
        '</table>'
        '<p>'
        '$sv<br>'
      ));
    }
    pq(qq(
      '<p>'
      '<table border="1">'
      '<tr><th>archive set<th>versions<th>size<th>description<th>action</tr>'
    ));
    my @archives = _sort(grep { -d } glob("$sds/archives/*"));
    foreach my $archive (@archives) {
      my @n;
      my $description = unhtml(decode_utf8(slurp("$archive/description")||''));
      my $mv = readlink("$archive/versions")||
               readlink("$sds/versions")||
              'unlimited';
      my $nv = 0;
      my $size = 0;
      foreach my $a (glob("$archive/*/data")) {
        $nv++;
        $size += -s $a;
      }
      $size = int($size/$MB)||'<1' if $size;
      $archive = basename($archive);
      $description =~ s!(https?://\S+)!<a href="$1">$1</a>!g;
      pq(qq(
        '<tr>'
        '<td $alignl><a href="/$CGI?show=archive:$share:$archive">$archive</a>'
        '<td $alignr>$nv'
        '<td $alignr>$size&nbsp;MB'
        '<td>$description'
        '<td>[<a href="/$CGI?remove=archive:$share:$archive">remove</a>]'
        '    [<a href="/$CGI?clone=archive:$share:$archive">copy</a>]'
        '    [<a href="/$CGI?rename=archive:$share:$archive">rename</a>]'
#       '    [<a href="/$CGI?show=archive:$share:$archive:edit">edit description</a>]'
        '</tr>'
      ));
    }
    pq(qq(
      '</table>'
      '<form action="/$CGI" $formpara>'
      'new archive set: <input type="text" name="narchive" size="32">'
      '<input type="submit" value="create">'
      '<input type="hidden" name="share" value="$share">'
      '</form>'
    ));
    my $upload = "from=$user?to=$owner:share=$share?submit=share";
    if ($id) {
      pq(qq'[<a href="/fup?$upload">upload file</a>]');
    } else {
      pq(qq'[<a href="/fup?$upload?pkey=$pkey">upload file</a>]');
    }
    pq(qq'<p>');
    print $logout if $id;
    print $help   if $master;
    pq(qq'</body></html>');
    exit;
  }

}

if ($id) {

  # share index
  http_header('200 OK');
  print html_header($head);
  pq(qq(
    '<h3>shares of owner $user:</h3>'
    '<table border="1">'
    '<tr><th>share<th>archive sets<th>users<th>size<th>action</tr>'
  ));
  my @shares = ();
  foreach my $share (_sort(glob("$shared/*"))) {
    push @shares,untaint(basename($share)) if -d $share;
  }
  foreach my $share (@shares) {
    my $sds = "$shared/$share";
    my @n;
    my $na = scalar(@n=glob("$sds/archives/*"));
    my $nu = scalar(@n=glob("$sds/users/*/pkey"));
    my $size = 0;
    map { $size += -s } glob("$sds/archives/*/*/data");
    $size = int($size/$MB)||'<1' if $size;
    pq(qq(
      '<tr>'
      '<td $alignc><a href="/$CGI?show=share:$share:archives">$share</a>'
      '<td $alignr>$na'
      '<td $alignr>$nu'
      '<td $alignr>$size&nbsp;MB'
    ));
    if ($share eq '_') {
      pq(qq'<td>');
    } else {
      pq(qq(
        '<td>[<a href="/$CGI?remove=share:$share">remove</a>]'
        '    [<a href="/$CGI?clone=share:$share">clone</a>]'
      ));
    }
    pq(qq'</tr>');
  }
  pq(qq(
    '</table>'
    '<p>'
    '<form action="/$CGI" $formpara>'
    '  new share:'
    '  <input type="text" name="nshare" size="16">'
    '  <input type="submit" value="create">'
    '</form>'
    '<p>'
  ));
  othershares($user);
  exit;
}

# share user (but not master!)
my $userd = "$shared/$share/users/$user";
http_die("internal error: master=$master") if $master;
http_die("no such share $owner/$share/$user") unless -d $userd;

# show archive versions
if ($show =~ /^archive:(.+)/) {
  my $archive = $1;
  my $archived = "$shared/$share/archives/$archive";
  my $access = readlink("$userd/access")||'read';
  my $description = unhtml(decode_utf8(slurp("$archived/description")||''));
  $description =~ s!(https?://\S+)!<a href="$1">$1</a>!g;
  unless (-d $archived) {
    http_die("no such archive $owner/$share/$archive");
  }
  my $key = md5_hex("$archive:$pkey");
  my $afop = qq'<a href="/fop/$owner/$share/$user/$key/$archive">'.
             qq'$archive</a>';
  http_header('200 OK');
  print html_header($head);
  my $td = 'td valign="top"';
  pq(qq(
    '<table>'
    '<tr><$td><b>share:  <td><b>$share</tr>'
    '<tr><$td><b>owner:  <td><b>$owner</tr>'
    '<tr><$td><b>user:   <td><b>$user</b> (logged in)</tr>'
    '<tr><$td><b>archive:<td><b>$afop</b><br><em>$description</em></tr>'
    '<tr><$td><b>access: <td><b>$access</tr>'
    '</table>'
    '<p>'
    '[<a href="$CGI?show=share:$share:archives">show share</a>]'
    '<p>'
    '<table border="1">'
    '<tr><th>version<th>container<th>size<th>uploader<th>content<th>comment<th>action</tr>'
  ));
  my @archives = glob("$archived/*");
  foreach my $archive (reverse @archives) {
    my $size = -s "$archive/data" or next;
    my $content = content($archive);
    $size = int($size/$MB)||'<1' if $size;
    $archive =~ m:.*/archives/(.+)/($vp)\.($atype): or next;
    my $avt = $1.'_'.$2.'.'.$3;
    my $version = $2;
    my $container = $3;
    my $modify = "modify=comment:$share:$1:$2.$3";
    my $uploader = readlink("$archive/uploader")||$owner;
    my $comment = unhtml(readline1("$archive/comment")||'');
    my $url = "/fop/$owner/$share/$user/".md5_hex("$avt:$pkey")."/$avt";
    my $action = '';
    if ($user eq $uploader) {
      $action = qq'[<a href="/$CGI?$modify">edit&nbsp;comment</a>]';
    }
    pq(qq(
      '<tr>'
      '<td><a href="$url">$version</a>'
      '<td $alignc>$container'
      '<td $alignr>$size&nbsp;MB'
      '<td><nobr>$uploader</nobr>'
      '<td>$content'
      '<td>$comment'
      '<td>$action'
      '</tr>'
    ));
  }
  pq(qq(
    '</table>'
    '<p>'
  ));
  # $access = '';
  if ($access eq 'write' or $access eq 'add') {
    my $fup = '/fup'.
      "?from=$user".
      "?to=$owner:share=$share".
      "?archive=$archive".
      "?submit=share".
      "?pkey=$pkey";
    pq(qq(
      '[<a href="$fup">upload file</a>]'
      '<p>'
    ));
  }
  pq(qq(
    '</body></html>'
  ));
  exit;
}

if ($notification =~ /^(yes|no)$/) {
  my $notification = $1;
  mksymlink("$userd/notification",$notification);
  faslog("$shared/$share","$user set notification=$notification for $user");
  redirect("/$CGI");
}

# share archive index for user
http_header('200 OK');
print html_header($head);
$access = readlink("$userd/access")||'read';
$description = unhtml(decode_utf8(slurp("$shared/$share/description")||''));
$description =~ s/\n*$//;
$description =~ s/\n/<br>/g;
$description =~ s/<br><br>/<p>/g;
$description =~ s!(https?://\S+)!<a href="$1">$1</a>!g;
$description = "<em>$description</em>";
$notification = readlink("$userd/notification")||'no';
if ($notification eq 'never') {
  $notification =
    qq'notification:<td><b>no';
} elsif ($notification eq 'no') {
  $notification =
    qq'<a href="/$CGI?notification=yes">notification:</a><td><b>no';
} elsif ($notification eq 'yes') {
  $notification =
    qq'<a href="/$CGI?notification=no">notification:</a><td><b>yes';
}

my $td = 'td valign="top"';
my $showshares = qq'[<a href="/$CGI?show=shares">show shares</a>]';
$showshares = '' if $user =~ /^anonymous/;
pq(qq(
  '<table>'
  '<tr><$td><b>share: <td><b>$share</b><br>$description</tr>'
  '<tr><$td><b>owner: <td><b>$owner</tr>'
  '<tr><$td><b>user:  <td><b>$user</b> (logged in)</tr>'
  '<tr><$td><b>access:<td><b>$access</tr>'
  '<tr><$td><b>$notification</tr>'
  '</table>'
  '<p>'
  '$showshares'
  '<p>'
  '<table border="1">'
  '<tr><th>archive set<th>versions<th>size<th>description<th>action</tr>'
));
my @archives = _sort(grep { -d } glob("$shared/$share/archives/*"));
foreach my $archive (@archives) {
  my $nv = 0;
  my $size = 0;
  my $fop = '';
  my $description = unhtml(decode_utf8(slurp("$archive/description")||''));
  foreach my $a (glob("$archive/*/data")) {
    $nv++;
    $size += -s $a;
    if ($a =~ m:.*/archives/(.+)/($vp)\.($atype):) {
      my $avt = $1.'_'.$2.'.'.$3;
      $fop = "/fop/$owner/$share/$user/".md5_hex("$avt:$pkey")."/$avt";
    }
  }
  $size = int($size/$MB)||'<1' if $size;
  $archive = basename($archive);
  pq(qq'<tr>');
  if (0 and $access eq 'read') {
    pq(qq'<td $alignl><a href="$fop">$archive</a>');
  } else {
    pq(qq'<td $alignl><a href="/$CGI?show=archive:$archive">$archive</a>');
  }
  pq(qq(
    '<td $alignr>$nv'
    '<td $alignr>$size&nbsp;MB'
    '<td>$description'
  ));
  if (-f "$user/@") {
    pq(qq'<td><a href="/$CGI?clone=archive:$share:$archive">copy</a>');
  } else {
    pq(qq'<td>');
  }
  pq(qq'</tr>');
}
pq(qq'</table>');
if ($access eq 'add') {
  my $fup = '/fup'.
    "?from=$user".
    "?to=$owner:share=$share".
    "?submit=share".
    "?pkey=$pkey";
  pq(qq(
    '<p>'
    '<a href="$fup">upload file</a>'
  ));
}
pq(qq'$help') if $access ne 'read';
pq(qq'</body></html>');
exit;


sub norm {
  local $_ = shift;
  s/^\s+//;
  s/\s+$//;
  s/[;,<>(){}\[\]\s\|\/\'\`\"\000-\037\\]/_/g;
  s/^\./_/;
  s/:\./:_/g;
  return untaint($_);
}


sub anorm {
  local $_ = shift;
  s/^\s+//;
  s/\s+$//;
  s/^\./_/;
  s/[^\w.+-]/_/g;
  return untaint($_);
}


sub fas_notify {
  my ($to,$user,$url,$description) = @_;
  my ($duser,$dto,$body);
  my ($mfrom,$hfrom) = mhfrom($user);
  my $header =
    'From: <$mfrom> ($hfrom via F*EX service $hostname)\n'.
    "To: <$to>\n".
    "Cc: <$user>\n".
    "Subject: F*EX archive sharing\n".
    "X-FEX-Client-Address: $RA\n".
    "X-FEX-Fexmaster: $ENV{SERVER_ADMIN}\n".
    "X-Mailer: F*EX\n";

  # explicite sender set in fex.ph?
  if ($sender_from) {
    # obsoleted feature!
    map { s/^From: <\Q$user/From: <$sender_from/ } $header;
    open $sendmail,'|-',$sendmail,$to,$user,$bcc
      or http_die("cannot start sendmail - $!");
  } else {
    # for special remote domains do not use same domain in From,
    # because remote MTA will probably reject this email
    $duser = $1 if $user =~ /@(.+)/;
    $dto   = $1 if $to   =~ /@(.+)/;
    if ($duser and $dto and @remote_domains and
        grep {
          $duser =~ /(^|\.)$_$/ and $dto =~ /(^|\.)$_$/
        } @remote_domains)
    {
      $header =~ s/(From: <)\Q$user\E(.*?)\n/$1$admin$2\nReply-To: $user\n/;
      open $sendmail,'|-',$sendmail,$to,$user,$bcc
        or http_die("cannot start sendmail - $!");
    } else {
      open $sendmail,'|-',$sendmail,'-f',$mfrom,$to,$user,$bcc
        or http_die("cannot start sendmail - $!");
    }
  }
  my $disclaimer = "Questions? ==> F*EX admin: $admin\n";
  $disclaimer .= "\n".$::disclaimer if $::disclaimer;
  my $info = $url;
  $info =~ s:/fas/.*:/sharing/:;
  $description =~ s/\n*$//;
  $body = qqq(qq(
    '$user has set up F*EX archive sharing for you:'
    ''
    '$url'
    ''
    '$description'
    ''
    'See $info'
    'for more information about F*EX archive sharing.'
    ''
    '$disclaimer'
  ));
# For a Windows F*EX client see http://fex.belwue.de/fexit.html
  print {$sendmail} $header,"\n",$body;
  close $sendmail and return $to;
  http_die("cannot send notification email (sendmail error $!)");
}


sub redirect {
  my $uri = shift;

  nvt_print(
    "HTTP/1.1 302 Found",
    "Location: $uri",
    'Content-Length: 0',
    ''
  );
  # control back to fexsrv for further HTTP handling
  &reexec;
}


sub othershares {
  my $user = shift;
  my ($oowner,$share);
  my @shares = ();

  foreach (asort(glob "*/SHARE/*/users/$user/pkey")) {
    ($oowner,undef,$share) = split '/';
    push @shares,"$oowner $share";
  }
  if (@shares) {
    pq(qq(
      '<h3>shares from other owners:</h3>'
      '<table border="1">'
      '<tr><th>owner<th>share<th>archive sets<th>size</tr>'
    ));
    foreach (@shares) {
      ($oowner,$share) = split;
      my $oos = "$oowner/SHARE/$share";
      my $pkey = readline1("$oos/users/$user/pkey");
      my @n;
      my $na = scalar(@n=glob("$oos/archives/*"));
      my $size = 0;
      map { $size += -s } glob("$oos/archives/*/*/data");
      $size = int($size/$MB)||'<1' if $size;
      pq(qq(
        '<tr>'
        '<td>$oowner'
        '<td $alignc><a href="/$CGI/$oowner/$share/$user/$pkey">$share</a>'
        '<td $alignr>$na'
        '<td $alignr>$size&nbsp;MB'
        '</tr>'
      ));
    }
    pq(qq'</table>');
  }
  if ($akey) {
    pq(qq(
      '<p>'
      '[<a href="/foc">F*EX operation control</a>]'
      '<p>'
      '$logout'
    ));
  }
  pq(qq(
    '$help'
    '</body></html>'
  ));
}


sub query_pkey {
  my ($owner,$share,$user) = @_;

  http_header('200 OK');
  print html_header($head);
  pq(qq(
    '<form action="/$CGI?owner=$owner?share=$share?user=$user" $formpara>'
    '<table>'
    '<tr><td><b>share:  <td>$share</tr>'
    '<tr><td><b>owner:  <td>$owner</tr>'
    '<tr><td><b>user:   <td>$user</tr>'
    '<tr><td><b>passkey:<td><input type="password" name="pkey" size="8"></tr>'
    '</table>'
    '<input type="submit" value="login">'
    '</form>'
    '</body></html>'
  ));
  exit;
}


sub content {
  my $archive = shift;
  my $alist = "$archive/alist";
  my $content = '';
  if (open $alist,$alist) {
    while (<$alist>) {
      if ($archive =~ /7z$/ and / \d\d:\d\d:\d\d\s+\d+\s+(.+)/
          or / \d\d:\d\d\s+(.+)/)
      {
        if (length($content)) {
          $content .= ' ...';
          last;
        } else {
          $content = unhtml($1);
        }
      }
    }
    close $alist;
  }
  return $content;
}


sub _sort {
  my @a = asort(@_);
  my @b = ();
  foreach (@a) {
    push @b,$_ if m:.*/(.): and $1 eq '_';
  }
  foreach (@a) {
    push @b,$_ if m:.*/(.): and $1 ne '_';
  }
  return @b;
}


sub esystem {
  my $cmd = shift;
  local $_ = `$cmd 2>&1`;
  if (/\w/) {
    $cmd =~ s/</&lt;/g;
    s/</&lt;/g;
    http_header('200 OK');
    print html_header($head);
    pq(qq(
      '<h3>ERROR</h3>'
      '<pre>'
      '<b>$cmd</b>'
      '$_'
      '</pre>'
      '</body></html>'
    ));
    exit;
  }
}

sub unhtml {
  local $_ = shift;
  s/^\s+//;
  s/[\s\n]+$//;
  s/ +/ /g;
  return htmlquote($_);
}
