#!/usr/bin/perl -wT

# F*EX CGI for document exchange
#
# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
#

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

use strict qw(vars subs);

use File::Basename;
use Digest::MD5	qw(md5_hex);
use Cwd		qw(abs_path getcwd);
use POSIX	qw(strftime locale_h);
use Fcntl 	qw(:flock :seek :mode);

# POSIX time format needed for HTTP header
setlocale(LC_TIME,'POSIX');

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

our $error = 'F*EX document ERROR';

# import from fex.pp and fex.ph
our ($spooldir,$docdir,$tmpdir,$akeydir,$akey,$charset);
our ($admin,$hostname,$sender_from,$sendmail,$bcc,@remote_domains,@durl);
our ($vp,$mrx,$bs,$timeout,$mdomain,$document_exchange,$style);
our ($FEXHOME,$MB,$RA);
our (@extra_header,@download_hosts);

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

our $head = "$ENV{SERVER_NAME} F*EX DOcument eXchange";

my $log = 'dox.log';
my $QS = $ENV{QUERY_STRING} || '';
my $uri = $ENV{PATH_INFO} || '';
my $owner = '';
my $user = 'anonymous';
my $file = '';
my $folder = '';
my $http_auth = '';
my $realm = '';
my $submit = '';
my $action = '';
my $mirror = '';
my $directory = '';
my $parentdir = '';
my $uploaddir = '';
my $newdir = '';
my $newfolder = '';
my $destination = '';
my $allowpublish = '';
my $userupload = '';
my $filedata = '';
my $utypes = 'gif|jpg|png|avi|mp\d|flv|m4v|ogg|tar|tgz|zip|7z|gz|bz2|rar|iso';
my $back = '<a href="javascript:history.back()">back</a>';
my $scroll = '<script>window.scrollTo(0,document.body.scrollHeight);</script>';
my $delete = '<font color="red">delete</font>';
my $deleteall = '<font color="red">DELETE</font>';
my $stdn = 'style="text-decoration:none"';
my $al = 'align="left"';
my $ar = 'align="right"';
my @files = ();
my @renamefrom = ();
my @renameto = ();
my %exclude = ();
my %PARAM = ();
my $dox = $ENV{SCRIPT_NAME};
my $hosturl = "$ENV{PROTO}://$ENV{HTTP_HOST}";

$ENV{PATH} = $ENV{FEXHOME}.'/bin:'.$ENV{PATH};

# $QS =~ s/%([\dA-F]{2})/unpack("a",pack("H2",$1))/ge;
$QS = decode_utf8(urldecode($QS));

if (@download_hosts and not ipin($RA,@download_hosts)) {
  http_die(
    "Downloads from your host ($RA) are not allowed.",
    "Contact $ENV{SERVER_ADMIN} for details."
  );
}

if (($ENV{HTTP_AUTHORIZATION}||'') =~ /Basic\s+(\S+)/) {
  $http_auth = decode_b64($1);
}

$uri =~ s:%3F:/?/:g; # escape '?' for URL-decoding
$uri =~ s/%([\dA-F]{2})/unpack("a",pack("H2",$1))/ge;
$uri =~ s:/\?/:%3F:g; # deescape '?'
$uri =~ s://+:/:;
$uri =~ s:^/::;

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

# look for CGI parameters
&parse_request;

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

if ($uri =~ m:(.+?)/(.+):) {
  $owner = $1;
  $file = $2;
  $file =~ s:/+$::;
  $folder = $file;
  $folder =~ s:/.*::;
} else {
  $owner = $uri;
  $owner =~ s:/+$::;
}

$owner =~ s:/::g;

if ($file =~ m:(^|/)\.\.(/|$):) {
  http_die('illegal file name');
}

if ($akey and readlink_("$akeydir/$akey") =~ m:.*/(.+):) {
  my $a = $1;
  if ($owner) {
    if ($a ne $owner) {
      redirect("/$dox");
    }
  } else {
    $owner = $a;
  }
}

my $doxo = "$dox/$owner";
my $doxurl = "$hosturl/$doxo/";

unless ($owner) {
  redirect("/fup?forward=/$dox");
}

unless (-f "$owner/@") {
  http_die("unknown user $owner");
}

# user client ip allowed?
if (length($folder) and not $akey) {
  my $access = "$owner/DOX/$folder/.fexdox/access";
  if (-s $access and open $access,$access) {
    my $noaccess = 1;
    while (<$access>) {
      /^#/ and next;
      s/\s//g;
      if (ipin($RA,$_)) {
        $noaccess = 0;
        last;
      }
    }
    close $access;
    if ($noaccess) {
      errorlog("access denied to $owner/DOX/$folder");
      http_error(403);
    }
  }
}


# zip archive can be downloaded without authentification
if ($file =~ /^[^\/]+\.zip$/) {
  chdir "$owner/DOX" or http_die("$owner : no documents available");
  if (-s $file) {
    http_output($file) and unlink $file;
  } else {
    http_die("$owner : $file not available");
  }
  exit;
}

my $useraccess = '';
if (length($folder) and
    (not $akey or readlink_("$akeydir/$akey") !~ m:\Q/$owner\E$:))
{
  if ((slurp("$owner/DOX/$folder/.fexdox/users")||'') =~ /^[^\s#]+:\S/m) {
    $useraccess = 'yes';
  }
  if (open my $fdc,"$owner/DOX/$folder/.fexdox/config") {
    while (<$fdc>) {
      s/#.*//;
      $useraccess = lc $1 if /^\s*useraccess\s*=\s*(\w+)/;
    }
    close $fdc;
  }
  if ($useraccess ne 'yes' and $useraccess ne 'anonymous') {
    http_header('200 OK');
    print html_header($head);
    pq(qq(
      '<h3>Access to folder /$folder is restricted to'
      '<a href="/fup?from=$owner?forward=/$dox/$owner">$owner</a></h3>'
    ));
    exit;
  }
}

&check_auth;

if ($akey) {
  my $doxua = lc readlink_("$owner/\@DOCUMENT_EXCHANGE");
  if ($doxua eq 'yes' or not $doxua and $document_exchange) {
    mkdirp("$owner/DOX");
  }
}

chdir "$owner/DOX" or http_die("DOX not available for $owner");

if ($file) {
  if (not -d $file and -d "$file!backup") {
    $file = "$file!backup";
  } elsif ("/$file/" =~ m:\Q/$folder/UPLOAD/:) {
    if ($akey) {
      $file =~ s:/UPLOAD.*:/.upload:;
      redirect("/$doxo/$file/");
    } elsif (-d "$folder/.upload/$user") {
      $file =~ s:\Q$folder\E/UPLOAD:$folder/.upload/$user:;
      $userupload = $file;
      mkdirp($userupload);
    }
  }
  mkdir $file if $file =~ m:^\Q$folder/.upload\E$:;
  if (not -e $file) {
    $file =~ s:(_$vp)/:$1!backup/:;
    unless (-e $file) {
      $file =~ s:!backup::;
      http_die("$owner : /$file does not exist");
    }
  }
}

if (length($folder)) {
  mkfexdox($folder);
  foreach ('.*','#*','*~') {
    $exclude{$_} = shp2prx($_);
  }
  if (open my $fdx,"$folder/.fexdox/private") {
    while (<$fdx>) {
      next if /^#/;
      s/[\r\n]//g;
      s://+:/:;
      s:^/\Q$folder:/:;
      s:/$::;
      $exclude{$_} = shp2prx($_) if length;
    }
    close $fdx;
  }
  if (open my $fdc,"$folder/.fexdox/config") {
    while (<$fdc>) {
      s/#.*//;
      $charset = $1 if /^\s*charset\s*=\s*(\S+)/;
    }
    close $fdc;
  }
}


if ($action eq 'okey' and -d $file) {
  okey($file);
  exit;
}

if ($action eq 'listit' and -d $file) {
  list($file);
  exit;
}

if ($action eq 'userlist' and -d $file) {
  userlist($file);
  exit;
}

if ($action eq 'zipit' and -d $file) {
  zipdir($file);
  exit;
}

if ($action eq 'syncit' and -d $file) {
  syncdir($file);
  exit;
}

if ($action eq 'streamit' and -d $file) {
  streamdir($file);
  exit;
}

if ($action eq 'fexit' and -d $file) {
  fexdir($file,$user);
  exit;
}

if ($submit eq 'fex it' and -d $file and @files) {
  fexfiles(@files,$user);
  exit;
}

if ($submit eq 'zip it' and -d $file and @files) {
  zipfiles(@files);
  exit;
}

if ($submit eq 'delete' and -d $file and @files) {
  delfiles(@files);
  doxdu($owner,$folder);
  my $dir = $file;
  unless ($akey) {
    $dir =~ s:\Q/.upload/$user:/UPLOAD:;
  }
  # $dir = urlencode($dir);
  redirect("$doxurl$dir/");
}

if ($submit eq 'publish' and @files) {
  publish(@files);
  my $dir = $file;
  $dir =~ s:/\.upload/[^/]+::;
  redirect("$doxurl$dir/");
}

if ($submit eq 'copy' and -d $file and -d $destination and @files) {
  copyfiles(@files);
  redirect("$doxurl$destination/");
}

if ($submit eq 'move' and -d $file and -d $destination and @files) {
  movefiles(@files);
  redirect($doxurl.urlencode($file).'/');
}

if ($submit eq 'rename' and -d $file and @files) {
  queryrename(@files);
  exit;
}

if (@renamefrom and @renameto) {
  renamefiles(@files);
  redirect($doxurl.urlencode($file).'/');
}

if ($submit eq 'save') {
  $filedata .= "\n" if length($filedata) and $filedata !~ /\n$/;
  savefile($file);
  redirect($doxurl.urlencode(dirname($file)).'/');
}

if (-d $file and $user and $action eq 'sendfile') {
  sendfile($file,$filedata);
  &reexec;
}

if ($user and $action eq 'notify') {
  notify_owner();
  exit;
}

if ($akey and $mirror) {
  mirror();
  exit;
}

if ($parentdir and $newdir) {
  if ($akey) {
    my $dir = "$parentdir/$newdir";
    mkdir $dir or http_die("cannot mkdir $dir - $!");
    update_folder($1) if $dir =~ m:([^/]+):;
    redirect("/$doxo/$parentdir/");
  } else {
    if ($parentdir !~ m:^\Q$folder/.upload/$user:) {
      http_die("illegal parentdir $parentdir");
    }
    my $dir = "$parentdir/$newdir";
    mkdir $dir or http_die("cannot mkdir $dir - $!");
    $dir = $parentdir;
    $dir =~ s:\Q/.upload/$user:/UPLOAD:;
    redirect("/$doxo/$dir/");
  }
}

if ($submit and $uploaddir) {
  redirect("/$dox") unless $akey;
  my $dir = "$folder/.upload/$uploaddir";
  mkdirp($dir);
  redirect("/$doxo/$folder/.upload/");
}

if ($allowpublish) {
  redirect("/$dox") unless $akey;
  my $user = $allowpublish;
  my $dir = "$folder/.upload/$user";
  unless (-d $dir) {
    http_die("$dir does not exist");
  }
  my $publish = "$folder/.upload/$user!publish";
  open $publish,'>',$publish or http_die("$publish - $!");
  print {$publish} "# User $user can publish his uploads (move to /$folder/)\n";
  close $publish;
  redirect("/$doxo/$folder/.upload/");
}

if ($newfolder) {
  redirect("/$dox") unless $akey;
  if (-d $newfolder) {
    http_die("$newfolder does already exist");
  }
  my @d = localtime time;
  my $nv = sprintf(
    '%s_%d%02d%02d_%02d%02d%02d',
    $newfolder,$d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]
  );
  mkdir $nv or http_die("cannot mkdir $nv - $!");
  symlink $nv,$newfolder or http_die("cannot symlink $nv - $!");
  redirect("/$dox");
}

if ($QS =~ /ACTION=logout/) {
  unlink "$akeydir/$akey" if $akey;
  redirect("/$dox");
}

if ($akey and $QS =~ /ACTION=edit/) {
  edit($file);
  exit;
}

if ($akey and $QS =~ /ACTION=logview/) {
  logview($file);
  exit;
}

if ($file and $QS eq 'ACTION=publishall') {
  publish_all($file);
  redirect("/$doxo/$folder/");
  exit;
}

if ($file and $QS eq 'ACTION=backup') {
  redirect("/$dox") unless $akey;
  $folder = basename($file);
  if (-d $folder and my $ov = untaint(readlink_($folder))) {
    my @d = localtime time;
    my $nv = sprintf(
      '%s_%d%02d%02d_%02d%02d%02d',
      $folder,$d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]
    );
    my $backup = "$ov!backup";
    unless (-d $backup) {
      $_ = `cp -al $ov $backup 2>&1`;
      http_die($_) if $?;
    }
    backup_cleanup($folder);
    redirect("/$dox");
  } else {
    http_die("unknown folder /$folder");
  }
} elsif ($file and $QS eq 'ACTION=restore') {
  redirect("/$dox") unless $akey;
  $file =~ s:/::;
  if (-d $file and $file =~ /(.+)_$vp(!backup)?$/ and -l $1) {
    $folder = $1;
    if ($file =~ s/!backup$//) {
    } else {
      $_ = `cp -al $file $file!backup 2>&1`;
      http_die($_) if $?;
    }
    unlink $folder;
    symlink $file,$folder;
    backup_cleanup($folder);
    redirect("/$dox");
  } else {
    http_die("unknown backup /$file");
  }
} elsif ($file and $QS eq 'ACTION=delete') {
  redirect("/$dox") unless $akey;
  if ($file !~ m:/:) {
    if (-l $file) {
      # delete all versions, backup and stream
      if (my @v = grep /^\Q$file\E_$vp(!\S+)?$/,glob "${file}_*") {
        foreach my $v (@v) {
          rmrf(untaint($v));
        }
      }
    } elsif (-d $file and $file =~ /(.+)_$vp$/) {
      $folder = $1;
      if (-l $folder and my @v = grep /^\Q$folder\E_$vp$/,glob "${folder}_*") {
        if (scalar(@v) == 1) {
          unlink $folder;
        } elsif (readlink_($folder) eq $file) {
          unlink $folder;
          if ($v[-1] ne $file) {
            symlink untaint($v[-1]),$folder;
          } else {
            symlink untaint($v[-2]),$folder;
          }
        }
      }
    }
  }
  rmrf($file);
  doxdu($owner,$folder);
  redirect("/$dox/".dirname($uri));
} elsif ($file =~ m:([^/]+): and -d $1) {
  if ($akey and $file eq "$folder/.fexdox" and not -d $file) {
    mkfexdox($folder);
  }
  if (-d $file) {
    if ($uri !~ m:/$:) {
      redirect("/$dox/$uri/");
    } else {
      showindex($file);
    }
  } elsif (-f $file) {
    sleep(2);
    http_output($file);
  } else {
    http_die("$owner : $file is not available");
  }
} elsif ($akey) {
  showindex('/');
} else {
  http_die("$owner : $file is not available");
}

&reexec;
exit;

sub check_auth {
  my $id = readline1("$spooldir/$owner/@")||'';
  my ($users);
  my (%pw,%access);

  if ($akey) {
    if (-f "$akeydir/$akey/@") {
      $user = $owner;
      return;
    } else {
      $akey = '';
    }
  }

  if ($http_auth =~ /^(fexmaster.*):/) {
    my $fm = $1;
    $fm .= '@'.$mdomain if $mdomain and $fm !~ /@/;
    $id = readline1("$spooldir/$fm/@")||'';
    if ($http_auth =~ /:$id$/) {
      $akey = 'fexmaster';
      if ($folder) {
        $realm = "/$owner/$folder";
      } else {
        $realm = "/$owner";
      }
      return;
    }
  }

  if ($folder) {
    $realm = "/$owner/$folder";
  } else {
    if ($QS =~ /^realm=([^\s\'\"]+)/) {
      http_header(
        '401 Authorization Required',
        "WWW-Authenticate: Basic realm=\"$1\"",
        'Content-Length: 0',
      );
      &reexec;
    } else {
      redirect("/fup?from=$owner?forward=/$dox/$owner");
    }
  }

  if ($http_auth eq "$owner:$id") {
    $user = $owner;
    return;
  }

  return if $useraccess eq 'anonymous';

  if (open $users,"$spooldir/$owner/DOX/$folder/.fexdox/users") {
    while (<$users>) {
      /^#/ and next;
      s/\s//g;
      my ($user,$pw) = split ':';
      $pw{lc($user)} = $pw if $pw;
    }
    close $users;
  }

  if ($http_auth =~ /(.+):(.+)/) {
    my $u = lc $1;
    my $p = $2;
    if ($pw{$u} and $pw{$u} eq $p) {
      $user = $u;
      return;
    }
  }

  http_header(
    '401 Authorization Required',
    "WWW-Authenticate: Basic realm=\"$realm\"",
    'Content-Length: 0',
  );
  &reexec;
}


sub http_output {
  my $file = shift;
  my ($filename,$size,$total_size,$range);
  my ($data,$type);
  my ($var,$env,$con);
  my @files;
  my @s;
  my $s = 0;
  my $b = 0;
  my $seek = 0;
  my $stop = 0;
  local $_;

  if (-l $file or not -f $file or $file =~ m:/\.: and not $akey) {
    http_error(404);
  }

  # reget?
  if ($range = $ENV{HTTP_RANGE}) {
    $seek = $1 if $range =~ /^bytes=(\d+)-/i;
    $stop = $1 if $range =~ /^bytes=\d*-(\d+)/i;
  }

  if (not $akey and excluded($file)) {
    http_die("no access for /$file");
  }

  if ($file =~ m:^/: or "/$file/" =~ m:\Q/../:) {
    http_die("illegal file name $file");
  }

  open $file,'<',$file or http_error(400);

  $type = 'application/octet-stream';
  if    ($file =~ /\.html?$/i)	{ $type = 'text/html' }
  elsif ($file =~ /\.css$/)	{ $type = 'text/css' }
  elsif ($file =~ /\.js$/)	{ $type = 'text/javascript' }
  elsif ($file =~ /\.txt$/i)	{ $type = 'text/plain' }
  elsif ($file =~ /\.ps$/)	{ $type = 'application/postscript' }
  elsif ($file =~ /\.pdf$/i)	{ $type = 'application/pdf' }
  elsif ($file =~ /\.mp3$/i)	{ $type = 'audio/mpeg' }
  elsif ($file =~ /\.mp4$/i)	{ $type = 'video/mp4' }
  elsif ($file =~ /\.avi$/i)	{ $type = 'video/x-msvideo' }
  elsif ($file =~ /\.jpg$/i)	{ $type = 'image/jpeg' }
  elsif ($file =~ /\.png$/i)	{ $type = 'image/png' }
  elsif ($file =~ /\.gif$/i)	{ $type = 'image/gif' }
  elsif ($file =~ /\.bmp$/i)	{ $type = 'image/x-ms-bmp' }
  elsif ($file =~ /\.ico$/i)	{ $type = 'image/vnd.microsoft.icon' }
  elsif ($file !~ /\.(tar|tgz|zip|jar|rar|arj|7z|bz2?|gz)$/i) {
    my $qfile = shellquote(untaint($file));
    $_ = `file $qfile 2>/dev/null`;
    if (/:.*HTML/) {
      $type = 'text/html';
    } elsif (/:.*text/i and not -x $file) {
      $type = 'text/plain';
      if    (/\sASCII\s/)    { $type .= "; charset=us-ascii" }
      elsif (/(ISO-[\w-]+)/) { $type .= "; charset=".lc($1) }
      else                   { $type .= "; charset=utf-8" }
    }
  }

  $type = 'text/plain' if $type eq 'text/html';

  $total_size = -s $file || 0;
  $size = $total_size - $seek - ($stop ? $total_size-$stop-1 : 0);

  if ($size < 0) {
    http_header('416 Requested Range Not Satisfiable');
    exit;
  }

  alarm($timeout*10);

  if ($seek or $stop) {
    my $range;
    if ($stop) {
      $range = sprintf("bytes %s-%s/%s",$seek,$stop,$total_size);
    } else {
      $range = sprintf("bytes %s-%s/%s",$seek,$total_size-1,$total_size);
    }
    nvt_print(
      'HTTP/1.1 206 Partial Content',
      'Server: fexsrv',
      "Content-Length: $size",
      "Content-Range: $range",
      "Content-Type: $type",
    );
  } else {
    my $date = http_date($file);
    nvt_print(
      'HTTP/1.1 200 OK',
      'Server: fexsrv',
      "Last-Modified: $date",
      "Expires: 0",
      "Content-Length: $size",
      "Content-Type: $type",
    );
  }
  nvt_print($_) foreach(@extra_header);
  nvt_print('');

  # binary data # can be stream!
  seek $file,$seek,0 if $seek;
  while ($bs and $b = read($file,$data,$bs)) {
    if ($stop and $s+$b > $size) {
      $b = $size-$s;
      $data = substr($data,0,$b);
      $bs = 0;
    }
    $s += $b;
    alarm($timeout*10);
    print $data or last;
  }
  doxlog(sprintf "%s %s/%s",hexencode($file),$s,$size) if $s;

  alarm(0);
  close $file;
  return($s+$seek == $total_size);
}


# show directory index
sub showindex {
  my $dir = shift;
  my ($htmldoc,$size,$dirhe,$path);
  my $pathhref = '';
  my @links = ();
  my @dirs = ();
  my %versions = ();
  my %folder = ();
  my @files = ();
  my @users = ();
  my $allowed;
  my $uid = randstring(8);
  my $js = slurp("$docdir/DOX/dox.js");
  my $showdel;
  my $v;
  local $_;

  $dir =~ s://+:/:;
  $dir =~ s:^/::;
  $dir =~ s:/$::;
  $dir ||= '.' if $akey;

  my $udir = urlencode($dir);

  $js =~ s/\$RANDOM\$/$uid/g;

  $htmldoc = html_header($head);
  $htmldoc .= qqq(qq(
    '<script>'
    'function toggle_checkboxes(cb) {'
    '  for (let checkbox of document.getElementsByName("file"))'
    '    checkbox.checked = cb.checked;'
    '}'
    '</script>'
  ));

  if ($akey and $dir eq '.') {

    # toplevel folders view

    opendir $dir,$dir or http_die("$dir - $!");
    while (defined($_ = readdir $dir)) {
      next if /^[.#]/;
      if ($v = readlink and $v =~ /$vp$/) {
        $folder{$v} = $_;
      }
      if (-d and /((.+_$vp)!backup)$/ and not -d $2) {
        rename $1,$2 and s/!backup$//;
      }
      if (-d and /(.+)_($vp(!backup)?)$/) {
        push @{$versions{$1}},$2;
      }
    }
    closedir $dir;

    $style = qqq(qq(
      'table {'
      '  border-collapse: collapse;'
      '}'
      'th,td {'
      '  border: 1px solid black;'
      '  padding: 10px;'
      '}'
    ));

    $htmldoc .= qq'<script>\n$js</script>\n';
    $htmldoc .= '<h2>';
    if ($akey eq 'fexmaster') {
      $htmldoc .= "DOX of $owner ($akey access)\n";
    } else {
      $htmldoc .= "DOX of $owner\n";
    }
    $htmldoc .= '</h2>';
    my $logout = button("/$dox?ACTION=logout",'logout');
    $htmldoc .= qqq(qq(
      '<style>'
      '$style'
      '</style>'
      '$logout'
      '&nbsp;'
      '[<a href="/DOX/index.html">documentation</a>]'
      '<p>'
      '<table border=1>'
      '<tr><th>folder<th>size<th>last modification<th>backup versions<th>folder actions</tr>'
    ));
    foreach my $d (asort(keys %versions)) {
      my $kb = readlink(".$d.du")||0;
      my ($mb,$date);
      $mb = int($kb/1024) || '<1';
      $showdel = 'a';
      if (open my $fdc,"$d/.fexdox/config") {
        while (<$fdc>) {
          s/#.*//;
          $showdel = ''  if /^\s*showdelete\s*=\s*no/;
          $showdel = 'a' if /^\s*showdelete\s*=\s*all/;
          $showdel = 'b' if /^\s*showdelete\s*=\s*backup/;
        }
        close $fdc;
      }
      if (readlink_($d) =~ /_(\d\d\d\d)(\d\d)(\d\d)_(\d\d)(\d\d)(\d\d)$/) {
        $date = "$1-$2-$3 $4:$5:$6";
      } else {
        $date = "????-??-?? ??:??:??";
      }
      $htmldoc .= qq'<tr><td><a href="/$doxo/$d/"><b>/$d</b></a>';
      $htmldoc .= qq'<td align="right">$mb MB<td>$date<td>';
      @{$versions{$d}} = sort @{$versions{$d}};
      foreach (reverse @{$versions{$d}}) {
        my $vd = my $v = $_; local $_;
        my $dv = $d.'_'.$v;
        $vd = "$1-$2-$3 $4:$5:$6" if $v =~ /(\d\d\d\d)(\d\d)(\d\d)_(\d\d)(\d\d)(\d\d)/;
        next if $folder{$dv};
        if ($v =~ s/!backup//g) {
          next if readlink_($d) !~ /$v$/;
          my $href = "javascript:alert('folder $d version is already $v')";
          my $sv = $d.'_'.$v;
          $htmldoc .= qq'<a href="/$doxo/$sv/"><code>$v</code></a> '.
                      button($href,'restore');
        } else {
          my $sv = $d.'_'.$v;
          $htmldoc .= qq'<a href="/$doxo/$sv/"><code>$v</code></a> '.
                      button("/$doxo/$dv?ACTION=restore",'restore');
        }
        if ($showdel =~ /^[ab]/) {
          $htmldoc .= ' '.button("/$doxo/$dv?ACTION=delete",$delete);
        }
        $htmldoc .= '<br>';
      }
      $htmldoc .= qq'<td>';
      if (-d readlink_($d).'!backup') {
        my $href = "javascript:alert('backup of folder $d is up to date')";
        $htmldoc .= button($href,'backup');
      } else {
        $htmldoc .= button("/$doxo/$d?ACTION=backup",'backup');
      }
      if ($showdel eq 'a') {
        $htmldoc .= ' ' . button("/$doxo/$d?ACTION=delete",$deleteall);
      }
      $htmldoc .= "</tr>\n";
    }
    $htmldoc .= "</table>\n<p>\n";
    $htmldoc .= qqq(qq(
      '<p>'
      '<ul>'
      '<li><form name="newfolder"'
      '  action="/$dox"'
      '  method="POST"'
      '  accept-charset="$charset"'
      '  enctype="multipart/form-data">'
      '  <input type="submit" value="Create">'
      '  new (empty) folder <input type="text" name="newfolder" size="40">'
      '</form>'
      '<p>'
      '<li><form name="upload"'
      '  action="/fup"'
      '  method="POST"'
      '  accept-charset="$charset"'
      '  enctype="multipart/form-data"'
      '  onsubmit="return showstatus()">'
      '  <input type="hidden" name="from"     value="$owner">'
      '  <input type="hidden" name="to"       value=".">'
      '  <input type="hidden" name="uid"      value="$uid">'
      '  <input type="hidden" name="comment"  value="DOX:SAVE=/">'
      '  <input type="hidden" name="filesize" value="">'
      '  <a id="uploadselect">'
      '    Select a'
      '    <button onclick="showfileupload(\'.zip\')">local zip file for upload</button>'
      '    or select a'
      '    <button onclick="showdirectoryupload()">local directory for upload</button>'
      '    to create a new folder with content.'
      '  </a>'
      '  <a id="submit"></a>'
      '</form>'
      '</ul>'
    ));

  } elsif ($akey and $dir eq "$folder/.upload") {

    $htmldoc .= "<h2>";
    $htmldoc .= qq'<a href="/$doxo">DOX of $owner</a> ';
    $htmldoc .= $akey eq 'fexmaster' ?
                "($akey access)":
                "(logged in as owner)";
    $htmldoc .= "</h2>\n";

    opendir $dir,$dir or http_die("$dir - $!");
    while (defined($_ = readdir $dir)) {
      next if /^\.\.?$/;
      next if /\n/;
      next if -l "$dir/$_";
      if (lstat "$dir/$_") {
        if    (-d _) { push @dirs,$_ }
        elsif (-f _) { push @files,$_ }
      }
    }
    closedir $dir;


    my $action = "/$doxo/".urlencode($dir)."?ACTION";
    my $pathhref = qq'<a href="/$doxo/$folder">$folder</a>/.upload';

    if (@dirs or @files) {
      $htmldoc .=              button("$action=listit",'list it');
      $htmldoc .= ' &nbsp; ' . button("$action=zipit",'zip it');
      $htmldoc .= ' &nbsp; ' . button("$action=fexit",'fex it');
      $htmldoc .= ' &nbsp; ' . button("$action=syncit",'sync it') if $akey;
      $htmldoc .= ' &nbsp; ' . button("$action=streamit",'stream it');
    }
    $htmldoc .= ' &nbsp; ' . button("/$doxo/$file",'reload');
    $htmldoc .= ' &nbsp; ' . button("/$doxo$realm",'folders overview');
    $htmldoc .= ' &nbsp; ' . button("/$dox?ACTION=logout",'logout');
    $htmldoc .= ' &nbsp; ';
    $htmldoc .= qq'[<a href="/DOX/index.html">documentation</a>]\n';
    $htmldoc .= qqq(qq(
      '<h2><tt>/$pathhref/</tt></h2>'
      '<p><hr><p>'
    ));

    $htmldoc .= "<ul><li>";
    $htmldoc .= button("/$doxo/$folder/.fexdox/users?ACTION=edit",
                       'Add or edit');
    $htmldoc .= " users</ul>";


    my @users = ();
    if (open my $users,"$folder/.fexdox/users") {
      while (<$users>) {
        s/#.*//;
        s/\s//g;
        push @users,$1 if /^([^\/]+?@[\w.-]+):./;
      }
      close $users;
    }
    my $selection = '<select name="uploaddir" size="1">';
    foreach (@users) {
      unless (-d "$folder/.upload/$_") {
        $selection .= '<option>'.htmlquote($_).'</option>';
      }
    }
    $selection .= "</select>";
    if ($selection =~ /<option>/) {
      $htmldoc .= qqq(qq(
        '<p>'
        '<ul><li><form name="newuploaddir"'
        '  action="/$doxo/$file"'
        '  method="POST"'
        '  accept-charset="$charset"'
        '  enctype="multipart/form-data">'
        '  <input type="submit" name="submit" value="Create">'
        '  an upload directory for user $selection'
        '</form></ul>'
      ));
    }

    # first the user upload directories
    if (@dirs) {
      $htmldoc .= qqq(qq(
        '<h3>Upload directories of your users</h3>'
        '<form name="files"'
        '  action="/$doxo/$file"'
        '  method="POST"'
        '  accept-charset="$charset"'
        '  enctype="multipart/form-data">'
        '<pre>'
      ));
      my $format = "%9s files # <b><a href=\"%s\"><em>%s/</em></a></b>\n";
      foreach my $d (asort(@dirs)) {
        my $ud = urlencode($d);
        my $hd = htmlencode($d);
        $htmldoc .= qq'<input type="checkbox" name="file" value="$ud"> ';
        $htmldoc .= sprintf $format,d3(countfiles("$dir/$d")),$ud,$hd;
      }
      $htmldoc .= qqq(qq(
        '</pre>'
        '&nbsp; &#8627; Action for selected directories:'
        '<input type="submit" name="submit" value="delete">'
        '</form>'
      ));
    }

    # then the files
    if (my $n = scalar(@files)) {
      $htmldoc .= qqq(qq(
        '<h3>Files ($n)</h3>'
        '<form name="files"'
        '  action="/$doxo/$file"'
        '  method="POST"'
        '  accept-charset="$charset"'
        '  enctype="multipart/form-data">'
        '<pre>'
      ));
      my $format = "%s %20s bytes # <a href=\"%s\"><em>%s</em></a>\n";
      foreach my $f (asort(@files)) {
        next if $f eq 'log';
        my $uf = urlencode($f);
        my $hf = htmlencode($f);
        $htmldoc .= qq'<input type="checkbox" name="file" value="$uf"> ';
        $htmldoc .= sprintf $format,
                    isodate(mtime("$dir/$f")),d3(-s "$dir/$f"||0),$uf,$hf;
      }
      if (-f "$dir/log") {
        $htmldoc .= qq'\n<input type="checkbox"> ';
        $htmldoc .= sprintf $format,
                    isodate(mtime("$dir/log")),d3(-s "$dir/log"||0),
                    'log?ACTION=logview','log';
      }
      $htmldoc .= qqq(qq(
        '</pre>'
        '&nbsp; &#8627; Action for selected files:'
        '<input type="submit" name="submit" value="delete">'
        '</form>'
      ));

      my $selection = '<select name="allowpublish" size="1">';
      foreach (@dirs) {
        if (/^$mrx$/ and not -f ("$dir/$_!publish")) {
          $selection .= '<option>'.htmlquote($_).'</option>';
        }
      }
      $selection .= "</select>";
      if ($selection =~ /<option>/) {
        $htmldoc .= qqq(qq(
          '<p>'
          '<ul><li><form name="allowpublish"'
          '  action="/$doxo/$folder"'
          '  method="POST"'
          '  accept-charset="$charset"'
          '  enctype="multipart/form-data">'
          '  <input type="submit" value="Allow">'
          '  user $selection to publish uploads'
          '  (move to <code>/$folder/</code>)'
          '</form></ul>'
        ));
      }
    }

    my $url = $ENV{REQUEST_URL};
    $url =~ s:/\.upload.*::;
    $htmldoc .= qqq(qq(
      '<p><hr><p>'
      'URL for your users:<br>'
      '$url/'
    ));

  } else {

    if (not $akey and $file !~ /^\Q$userupload/ and excluded($dir)) {
      http_die("no access for /$dir");
    }

    opendir $dir,$dir or http_die("$dir - $!");
    while (defined($_ = readdir $dir)) {
      next if /^\.\.?$/;
      next if /\n/;
      next if -l "$dir/$_";
      next if not ($akey or $dir =~ m:/\.upload($|/):) and excluded("$dir/$_");
      if (lstat "$dir/$_") {
        if    (-d _) { push @dirs,$_ }
        elsif (-f _) { push @files,$_ }
      }
    }
    closedir $dir;

    if ($akey and $dir !~ m:/: and not grep /^\.fexdox$/,@dirs) {
      push @dirs,'.fexdox';
    }

    $showdel = 'a';
    if ($akey and open my $fdc,"$folder/.fexdox/config") {
      while (<$fdc>) {
        s/#.*//;
        $showdel = ''  if /^\s*showdelete\s*=\s*no/;
        $showdel = 'a' if /^\s*showdelete\s*=\s*all/;
        $showdel = 'b' if /^\s*showdelete\s*=\s*backup/;
        $showdel = 'd' if /^\s*showdelete\s*=\s*dir/;
      }
      close $fdc;
    }

#    $htmldoc .= "<h1>[$ENV{PATH_INFO}]</h1>\n";
    $path = urldecode($ENV{PATH_INFO});
#    $htmldoc .= "<h1>[$path]</h1>\n";
    $path =~ s:/.+?/::; # remove owner
    $path =~ s:!backup/:/:;
    $pathhref = htmlencode(basename($path));

    while ($path =~ s:(.+)/.+:$1:) {
      my $dir = htmlencode(basename($path));
      my $upath = urlencode($path);
      $pathhref = qq'<a href="/$doxo/$upath">$dir</a>/$pathhref';
    }

    $realm = "?realm=$realm" if $realm;

    $htmldoc .= "<h2>";
    if ($akey) {
      $htmldoc .= qq'<a href="/$doxo$realm">DOX of $owner</a> ';
      $htmldoc .= $akey eq 'fexmaster' ? "($akey access)" : "(logged in as owner)";
    } else {
      $htmldoc .= "DOX of $owner (user: $user)";
    }
    $htmldoc .= "</h2>\n";

    if ($userupload) {
      my $okey = randstring(8);
      my $okeyd = "$spooldir/$owner/\@OKEY";
      mkdir $okeyd;
      symlink $user,"$okeyd/$okey"
        or http_die("cannot create OKEY $okeyd/$okey - $!");

      if (countfiles("$folder/.upload/$user")) {
        $htmldoc .= "<script>\n$js</script>\n";
        my $action = "/$doxo/".urlencode($file)."?ACTION";
        $htmldoc .= button("$action=notify",'notify owner');
        if (-f "$folder/.upload/$user!publish" and
            $file =~ m:(\Q$folder/.upload/\E[^/]+)$:)
        {
          $htmldoc .= ' &nbsp; ';
          $htmldoc .= button("$action=publishall",'publish all');
        }
        $htmldoc .= qq' &nbsp; ';
        $htmldoc .= qq'[<a href="/DOX/user.html">documentation</a>]\n'
      }
      $htmldoc .= qqq(qq(
        '<h2><tt>/$pathhref/</tt></h2>'
        '<p><hr><p>'
        '<ul><li><form name="newdir"'
        '  action="/$doxo/$file"'
        '  method="POST"'
        '  accept-charset="$charset"'
        '  enctype="multipart/form-data">'
        '  <input type="hidden" name="parentdir" value="$udir">'
        '  <input type="submit" value="Create"> new directory'
        '  <input type="text" name="newdir" size="40">'
        '</form></ul>'
        '<p>'
        '<form name="files"'
        '  action="/$doxo/$file"'
        '  method="POST"'
        '  accept-charset="$charset"'
        '  enctype="multipart/form-data">'
        '<pre>'
      ));

      # first the (sub)directories
      foreach my $d (asort(@dirs)) {
        my $ud = urlencode($d);
        my $hd = htmlquote($d);
        $htmldoc .= qq'<input type="checkbox" name="file" value="$ud"> ';
        $htmldoc .= sprintf qq'%9s files <b><a href="%s">%s/</a></b>\n',
                    d3(countfiles("$dir/$d")),$ud,$hd;
      }
      $htmldoc .= "\n";

      # then the files
      foreach my $f (asort(@files)) {
        $htmldoc .= sprintf '<input type="checkbox" name="file" value="%s"> ',
                    urlencode($f);
        $htmldoc .= sprintf "%s %20s bytes %s\n",
                    isodate(mtime("$dir/$f")),d3(-s "$dir/$f"||0),
                    htmlencode($f);
      }

      $htmldoc .= "</pre>\n";
      if (@dirs or @files) {
        $htmldoc .= qqq(qq(
          '<input type="checkbox" onClick="toggle_checkboxes(this)">'
          '(de)select all files and directories<br>'
          '&nbsp; &#8627; Action for selected files and directories:'
          '<input type="submit" name="submit" value="delete">'
        ));
      }
      $htmldoc .= "</form>\n";
      $htmldoc .= qqq(qq(
        '<ul><li><form name="upload"'
        '  action="/fup"'
        '  method="POST"'
        '  accept-charset="$charset"'
        '  enctype="multipart/form-data"'
        '  onsubmit="return showstatus()">'
        '  <input type="hidden" name="from"     value="$user">'
        '  <input type="hidden" name="to"       value="$owner">'
        '  <input type="hidden" name="uid"      value="$uid">'
        '  <input type="hidden" name="okey"     value="$okey">'
        '  <input type="hidden" name="comment"  value="DOX:SAVE=$udir">'
        '  <input type="hidden" name="filesize" value="">'
        '  <a id="uploadselect">'
        '    Select a'
        '    <button onclick="showfileupload()">local file for upload</button>'
        '    or select a'
        '    <button onclick="showdirectoryupload()">local directory for upload</button><br>'
        '    (If you upload a file named <code>dox.zip</code> it will be extracted, preserving the file attributes)'
        '  </a>'
        '  <a id="submit"></a>'
        '</form></ul>'
      ));

    } else {

      if ($akey and $folder !~ /_$vp$/) {
        $htmldoc .= "<script>\n$js</script>\n";
      }

      $path = $ENV{PATH_INFO};
      $path =~ s:/+$::;
      my $action = "/$dox$path?ACTION";
      if ($akey and $file =~ m:(\Q$folder/.upload/\E[^/]+)$:) {
        if (countfiles($1)) {
          $htmldoc .= button("$action=publishall",'pubish all');
          $htmldoc .= ' &nbsp; ';
        }
      }
      if (@dirs or @files) {
        $htmldoc .=              button("$action=listit",'list it');
        $htmldoc .= ' &nbsp; ' . button("$action=zipit",'zip it');
        if ($user =~ /@/ and checkaddress($user)) {
          $htmldoc .= ' &nbsp; ' . button("$action=fexit",'fex it');
        }
        if ($akey or $dir eq $folder) {
          $htmldoc .= ' &nbsp; ' . button("$action=syncit",'sync it');
        }
        $htmldoc .= ' &nbsp; ' . button("$action=streamit",'stream it');
        $htmldoc .= ' &nbsp; ' . button("/$doxo/$file",'reload');
      }
      if ($akey) {
        $htmldoc .= ' &nbsp; ' . button("/$doxo$realm",'folders overview');
        $htmldoc .= ' &nbsp; ' . button("/$dox?ACTION=logout",'logout');
        $htmldoc .= ' &nbsp; ';
        $htmldoc .= qq'[<a href="/DOX/index.html">documentation</a>]'
      } elsif ($user =~ /@/ and checkaddress($user)) {
        $htmldoc .= qq' &nbsp; ';
        my $wopen = "window.open(this.href,'fup','width=1024,height=768');".
                    "return false;";
        $htmldoc .= qq'<a href="$action=sendfile" onclick="$wopen" $stdn>'.
                      '<button>send file</button></a>';
        if (-d "$folder/.upload/$user") {
          $htmldoc .= qq' &nbsp; ';
          $htmldoc .= qq'<a href="/$doxo/$folder/UPLOAD">'.
                        '<button>upload</button></a>';
        }
        $htmldoc .= qq' &nbsp; ';
        $htmldoc .= qq'[<a href="/DOX/user.html">documentation</a>]'
      } else {
        $htmldoc .= qq' &nbsp; ';
        $htmldoc .= qq'[<a href="/DOX/user.html">documentation</a>]'
      }
      $htmldoc .= "\n";
      $htmldoc .= "<h2><tt>/$pathhref/</tt></h2>\n";
      $htmldoc .= "<p><hr><p>\n";

      $path = urldecode($ENV{PATH_INFO});
# $htmldoc .= "<h1>[$ENV{PATH_INFO}]</h1>\n";
      $path =~ s:/.+?/::; # remove owner
      $path =~ s:/+$::;
      # $htmldoc .= "<h2>$path</h2>\n";
      if ($_ = slurp("$path/.#.html")||slurp("$path/#.html")) {
        s:</body.*::si;
        s:</html.*::si;
        s:<(script):&lt;$1:g;
        $htmldoc .= $_."\n<p><hr><p>\n";
      }

      if ($akey and "$path/" !~ m:^\Q$folder/.fexdox/:) {
        $htmldoc .= qqq(qq(
          '<ul><li><form name="newdir"'
          '  action="/$dox"'
          '  method="POST"'
          '  accept-charset="$charset"'
          '  enctype="multipart/form-data">'
          '  <input type="hidden" name="parentdir" value="$udir">'
          '  <input type="submit" value="Create"> new directory'
          '  <input type="text" name="newdir" size="40">'
          '</form></ul>'
          '<p>'
        ));
      }

      if (@files or @dirs) {
        if ($akey) {
          # $htmldoc .= "(see below for action on selected files or directories)\n";
        } elsif (@files) {
          # $htmldoc .= "(see below for action on selected files)\n";
        }
        $htmldoc .= qqq(qq(
          '<form name="files"'
          '  action="/$doxo/$file"'
          '  method="POST"'
          '  accept-charset="$charset"'
          '  enctype="multipart/form-data">'
        ));
      }

      # first the (sub)directories
      if (my $n = scalar(@dirs)) {
        $htmldoc .= "<h3>Directories ($n)</h3>\n";
        $htmldoc .= "<pre>\n";
        $htmldoc .= "<table border=0>\n";

        foreach my $d (asort(@dirs)) {
          $htmldoc .= "<tr><td>";
          if ($akey) {
            if ($dir eq $folder and ($d eq '.fexdox' or $d eq '.upload')) {
            } else {
              $htmldoc .= sprintf
                '<input type="checkbox" name="file" value="%s"> ',
                urlencode($d);
            }
            $htmldoc .= "<td>";
          }
          my $format = "&nbsp; <b><a href=\"%s\">%s/</a></b>\n";
          if (excluded("$path/$d")) {
            $format = "# <b><a href=\"%s\"><em>%s/</em></a></b>\n";
          }
          $htmldoc .= sprintf "<td $ar>%9s files<td>$format</tr>\n",
            d3(countfiles("$dir/$d")),
            urlencode($d),
            htmlencode($d);
        }
        $htmldoc .= "</table>\n";
        $htmldoc .= "</pre>\n";
      }

      # then the files
      if (my $n = scalar(@files)) {
        $htmldoc .= "<h3>Files ($n)</h3>\n";
      }
      $htmldoc .= "<pre>\n";
      foreach my $f (asort(@files)) {
        my $format = "  <a href=\"%s\">%s</a>\n";
        if (excluded("$path/$f")) {
          $format = "# <a href=\"%s\"><em>%s</em></a>\n";
        }
        $format = "%s %20s bytes $format";
        my $action = '';
        if ($akey) {
          if ($path eq "$folder/.fexdox") {
            $action = "?ACTION=edit";
          } elsif ("$dir/$f" eq "$folder/.upload/log") {
            $action = "?ACTION=logview";
          }
        }
        my $uf = urlencode($f);
        my $hf = htmlencode($f);
        $htmldoc .= qq'<input type="checkbox" name="file" value="$uf"> ';
        $htmldoc .= sprintf $format,
                            isodate(mtime("$dir/$f")),d3(-s "$dir/$f"||0),
                            $uf.$action,$hf;
      }
      $htmldoc .= "</pre>\n";
      if (@files or @dirs and $akey) {
        if ($path ne "$folder/.upload") {
          my $x = $akey ? 'and directories' : '';
          $htmldoc .= qqq(qq(
            '<input type="checkbox" onClick="toggle_checkboxes(this)">'
            '(de)select all files $x<br>\n'
          ));
        }
        $htmldoc .= "&nbsp; &#8627; Action for selected files and directories:\n";
        if ($akey) {
          if ($path eq "$folder/.upload") {
            $htmldoc .= qq'<input type="submit" name="submit" value="delete">\n';
          } else {
            my (@folders,@dirs,$selection);
            @folders = grep { -d and -l and $_ ne $folder } glob '*';
            $selection = '<select name="destination" size="1">';
            $selection .= "<option>$_</option>" foreach asort(@folders);
            $selection .= "</select>";
            $htmldoc .=
              qq'<script>\n'.
              qq'function showcopy() {'.
              qq"  document.getElementById('actions').innerHTML = '".
              qq'  <input type="submit" name="submit" value="copy">'.
              qq"  to folder $selection'; ".
              qq"}\n".
              qq'</script>\n';
            foreach (find($folder)) {
              if (-d and not -l) {
                $_ .= '/';
                next if $_ eq "$file/";
                next if m:^\Q$folder/.\E(fexdox|upload)/|/\.versions/:;
                push @dirs,"/$_";
              }
            }
            $selection = '<select name="destination" size="1">'.
                         "<option>/$folder/</option>";
            foreach (asort(@dirs)) {
              local $_ = htmlquote($_);
              $selection .= "<option>$_</option>";
            }
            $selection .= "</select>";
            $htmldoc .=
              qq'<script>\n'.
              qq'function showmove() {'.
              qq"  document.getElementById('actions').innerHTML = '".
              qq'  <input type="submit" name="submit" value="move">'.
              qq"  to directory $selection'; ".
              qq"}\n".
              qq'</script>\n';
            $htmldoc .= qq'<a id="actions">\n';
            $htmldoc .= qq'<input type="submit" name="submit" value="zip it">\n';
            $htmldoc .= qq'<input type="submit" name="submit" value="fex it">\n';
            if (@folders) {
              $htmldoc .= qq'<button onclick="showcopy()">copy</button>\n';
            }
            if ($folder !~ /_$vp$/) {
              if (@dirs) {
                $htmldoc .= qq'<button onclick="showmove()">move</button>\n';
              }
              if ("$path/" =~ m:^\Q$folder/.upload/:) {
                $htmldoc .= qq'<input type="submit" name="submit" value="publish">\n';
              }
              if ("$path/" !~ m:^\Q$folder/.fexdox/:) {
                $htmldoc .= qq'<input type="submit" name="submit" value="rename">\n';
              }
              $htmldoc .= qq'<input type="submit" name="submit" value="delete">\n';
           }
            $htmldoc .= "</a>\n";
          }
        } else {
          $htmldoc .= qq'<input type="submit" name="submit" value="zip it">\n';
          if ($user =~ /@/ and checkaddress($user)) {
            $htmldoc .= qq'<input type="submit" name="submit" value="fex it">\n';
          }
        }
        $htmldoc .= "</form>\n";
      }
      if ($akey and $folder !~ /_$vp$/) {
        $htmldoc .= "<ul>\n";
        if ("$path/" !~ m:^\Q$folder/.upload/:) {
          $htmldoc .= qqq(qq(
            '<li><form name="upload"'
            '  action="/fup"'
            '  method="POST"'
            '  accept-charset="$charset"'
            '  enctype="multipart/form-data"'
            '  onsubmit="return showstatus()">'
            '  <input type="hidden" name="from"     value="$owner">'
            '  <input type="hidden" name="to"       value=".">'
            '  <input type="hidden" name="uid"      value="$uid">'
            '  <input type="hidden" name="comment"  value="DOX:SAVE=$udir">'
            '  <input type="hidden" name="filesize" value="">'
            '  <a id="uploadselect">'
            '    Select a'
            '    <button onclick="showfileupload()">local file for upload</button>'
          ));
          if ("$path/" !~ m:^\Q$folder/.fexdox/:) {
            $htmldoc .= qqq(qq(
              '    or select a'
              '    <button onclick="showdirectoryupload()">local directory for upload</button><br>'
              '    (If you upload a file named <code>dox.zip</code> it will be extracted, preserving the file attributes)'
            ));
          }
          $htmldoc .= qqq(qq(
            '  </a>'
            '  <a id="submit"></a>'
            '</form>'
          ));
          if ("$path/" !~ m:^\Q$folder/.fexdox/:) {
            $htmldoc .= qqq(qq(
              '<li><form name="mirror"'
              '  action="/$doxo/$dir"'
              '  method="POST"'
              '  accept-charset="$charset"'
              '  enctype="multipart/form-data">'
              '  <input type="submit" value="Mirror"> this URL:'
              '  <input type="text" name="mirror" size="80">'
              '  </form>'
            ));
          }
        }
        if ($path eq $folder or $path eq "$folder/.fexdox") {
          my @users = ();
          if (open my $users,"$folder/.fexdox/users") {
            while (<$users>) {
              /^#/ and next;
              s/\s//g;
              push @users,$1 if /^([^\/]+?@[\w.-]+):./;
            }
            close $users;
          }
          if (@users) {
            $htmldoc .= "<li>Manage your ";
            $htmldoc .= button("/$doxo/$folder/.upload",
                               'user upload directories');
            $htmldoc .= "\n";
          }
        }
        $htmldoc .= "</ul>\n";
        if ("$path/" !~ m:^\Q$folder/.\E(fexdox|upload)/:) {
          $htmldoc .= qqq(qq(
            '<p><hr><p>'
            'URL of this page (for your users):<br>'
          ));
          foreach (@durl) {
            local $_ = $_;
            s:/fop.*:$ENV{REQUEST_URI}<br>\n:;
            if ($ENV{PROTO} eq 'https' and /^https/ or $ENV{PROTO} eq 'http') {
              $htmldoc .= $_;
            }
          }
        }
      }
    }
  }

  if ($dir eq "$folder/.fexdox") {
    my $url = $ENV{REQUEST_URL};
    $url =~ s:/\.fexdox.*::;
    $htmldoc .= qqq(qq(
      '<p><hr><p>'
      'URL for your users:<br>'
      '$url/'
    ));
  }

  $htmldoc .= "</body>\n</html>\n";

  $size = length($htmldoc);
#  $size = length(encode_utf8($htmldoc));
  doxlog(hexencode($dir).'/ '.$size);

  http_header(
    '200 OK',
    "Content-Length: $size",
  );
  if ($charset =~ /utf/i) {
    # binmode(STDOUT,':raw');
    print $htmldoc;
  } else {
    # binmode(STDOUT,':raw');
    print $htmldoc;
  }
}


sub countfiles {
  my $dir = shift;
  my $n = 0;
  local $_;

#  return 0;

#  $dir = shellquote($dir);
#  my @files = `find $dir -type f`;
#  return scalar(@files);

  opendir $dir,$dir or return $n;
  while (defined($_ = readdir $dir)) {
    next if /^\.\.?$/;
    $_ = "$dir/$_";
    lstat;
    next if -l _;
    if (-d _) {
      $n += countfiles($_);
    } elsif (-f _) {
      $n++;
    }
  }
  closedir $dir;
  return $n;
}


sub edit {
  my $file = shift;
  my $path = dirname($file);
  my $text = '';
  my ($htmldoc);
  local $/;

  open $file,$file or http_die("$file - $!\n");
  $text = <$file>;
  close $file;
  $text =~ s/\r//g;
  $text =~ s/&/&amp;/g;
  $text =~ s/</&lt;/g;
  $text =~ s/\n*$/\n/;

  $htmldoc = html_header($head);
  $htmldoc .= qqq(qq(
    '<h2>DOX of $owner</h2>'
    '<h3>edit /$file :</h3>'
    '<form name="edit"'
    '  action="/$doxo/$file"'
    '  method="POST"'
    '  accept-charset="$charset"'
    '  enctype="multipart/form-data">'
    '  <textarea name="filedata" cols="80" rows="25">'
  ));
  $htmldoc .= $text;
  $htmldoc .= qqq(qq(
    '</textarea><br>'
    '<input type="submit" name="submit" value="save">'
    '</form>'
  ));
  $htmldoc .= button('javascript:history.back()','cancel');

  my $size = length(encode_utf8($htmldoc));
  http_header('200 OK',"Content-Length: $size");
  print $htmldoc;
  exit;
}


sub logview {
  my $file = shift;
  my $path = dirname($file);
  my $text = '';
  my @log = ();
  my $htmldoc;
  local $/ = "\n\n";
  local $_;

  open $file,$file or http_die("$file - $!\n");
  @log = <$file>;
  close $file;

  $htmldoc = html_header($head);
  $htmldoc .= "<h2>$file</h2>\n";
  $htmldoc .= "<pre>\n";

  while (defined($_ = pop @log)) {
    s/^\n*//;
    s/\n*$/\n\n/;
    $htmldoc .= htmlquote($_);
  }

  $htmldoc .= qqq(qq(
    '</pre>'
    '$back'
    '</body></html>'
  ));

  my $size = length($htmldoc);
  http_header('200 OK',"Content-Length: $size");
  # binmode(STDOUT,':raw');
  print $htmldoc;
  exit;
}


sub button {
  my $href = shift;
  my $button = shift;
  return qq'<a href="$href" $stdn><button>$button</button></a>';
}


sub mkfexdox {
  my $folder = shift;
  my $fexdox = "$folder/.fexdox";
  my ($config,$info);

  unlink($fexdox) unless -d $fexdox;
  mkdirp($fexdox);
  mkdir "$folder/.upload";

  $info = "$fexdox/#.html";
  if (not -f $info and open $info,'>',$info) {
    my $href = qq'<a href="$hosturl/DOX/#Folders_and_configuration">help</a>';
    print {$info} "<h3>Folder configuration, see $href</h3>\r\n";
    close $info;
  }

  $config = "$fexdox/config";
  unless (-f $config) {
    open $config,'>',$config or http_die("cannot write $config - $!");
    print {$config}
      "# Lines beginning with # are comments.\r\n",
      "\r\n",
      "# access for other users\r\n",
      "#useraccess=no\r\n",
      "useraccess=yes\r\n",
      "#useraccess=anonymous\r\n",
      "\r\n",
      "# number of backups fexdox automatically creates and keeps\r\n",
      "backups=1\r\n",
      "\r\n",
      "# file name character set\r\n",
      "charset=utf-8\r\n",
      "\r\n",
      "# show delete button or not\r\n",
      "#showdelete=no\r\n",
      "#showdelete=backup\r\n",
      "showdelete=all\r\n",
      "";
    close $config;
  }

  $config = "$fexdox/users";
  unless (-f $config) {
    open $config,'>',$config or http_die("cannot write $config - $!");
    print {$config}
      "# Lines beginning with # are comments.\r\n",
      "#\r\n",
      "# User accounts are USER:PASSWORD strings.\r\n",
      "# If the user shall be enabled to upload files, it must be an email address.\r\n",
      "# Example:\r\n",
      "# framstag\@rus.uni-stuttgart.de:letthereberock\r\n",
      "";
    close $config;
  }

  $config = "$fexdox/access";
  unless (-f $config) {
    open $config,'>',$config or http_die("cannot write $config - $!");
    print {$config}
      "# Lines beginning with # are comments.\r\n",
      "#\r\n",
      "# Access is restricted to ips or ip ranges listed here.\r\n",
      "127.0.0.1\r\n",
      "0.0.0.0-255.255.255.255\r\n",
      "0:0:0:0:0:0:0:0-ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\r\n",
      "";
    close $config;
  }

  $config = "$fexdox/private";
  unless (-f $config) {
    open $config,'>',$config or http_die("cannot write $config - $!");
    print {$config}
      "# Lines beginning with # are comments.\r\n",
      "#\r\n",
      "# List of private files and directories to be invisible for users.\r\n",
      "# Files and directories with . or # as first character are private by default.\r\n",
      "# You can use the shell patterns * ? [...]\r\n",
      "# Examples:\r\n",
      "#\r\n",
      "# internal.pdf\r\n",
      "# *.tmp\r\n",
      "# /software/test/alpha\r\n",
      "";
    close $config;
  }
}


sub list {
  my $dir = shift;
  my $files = ();
  my $htmldoc = html_header($head);
  local $_;

  foreach (find($dir)) {
    next if -l or not -f;
    next if not $akey and excluded($_);
    push @files,$_;
  }

  $htmldoc .= qqq(qq(
    '<html>'
    '<body>'
    '<h1>/$dir/</h1>'
    '<pre>'
  ));

  foreach (asort(@files)) {
    if (m:\Q$dir\E/(.+)/(.+):) {
      my $hd = htmlencode($1);
      my $ud = urlencode("/$doxo/$dir/$1");
      my $hf = htmlencode($2);
      my $uf = urlencode("/$doxo/$dir/$1/$2");
      $htmldoc .= sprintf
        qq'%s %20s bytes <a href="%s">%s</a>/<a href="%s">%s</a>\n',
        isodate(mtime($_)),d3(-s||0),$ud,$hd,$uf,$hf;
    } elsif (m:\Q$dir\E/(.+):) {
      my $hf = htmlencode($1);
      my $uf = urlencode("/$doxo/$dir/$1");
      $htmldoc .= sprintf
        qq'%s %20s bytes <a href="%s">%s</a>\n',
        isodate(mtime($_)),d3(-s||0),$uf,$hf;
    }
  }

  $htmldoc .= qqq(qq(
    '<p>'
    '$back'
    '</body>'
    '</html>'
  ));

  my $size = length($htmldoc);
  doxlog(hexencode($dir).'/ '.$size);

  http_header(
    '200 OK',
    "Content-Length: $size",
  );
  # binmode(STDOUT,':raw');
  print $htmldoc;
}


sub userlist {
  my $dir = shift;
  my %files = ();
  local $_;

  unless (-d "$dir/.upload/$user") {
    http_error(403);
  }

  foreach (find($dir)) {
    next if -l or not -f;
    next if m:/[.#]|~$:;
    next if excluded($_);
    $files{$1} = $_ if m:\Q$dir/\E(.+):;
  }

  foreach (find("$dir/.upload/$user")) {
    next if -l or not -f;
    $files{$1} = $_ if m:\Q$dir/.upload/$user/\E(.+):;
  }

  http_header(
    '200 OK',
    "Content-Type: text/plain",
  );

  # print "$dir/.upload/$user\n";
  foreach (asort(keys %files)) {
    printf "%d %s\n",mtime($files{$_}),hexencode($_);
  }
}


sub zipdir {
  my $dir = shift;
  my $zip = $dir;
  my @zip = qw'zip -r';
  my $uf = my $cf = 1;
  my @exclude = ();

  $zip =~ s:[^\w\@%~^,+-]:_:g;
  $zip .= sprintf "_%s.zip",time;

  foreach (find($dir)) {
    unless ($akey) {
      if (-l or excluded($_)) {
        $_ .= '/*' if -d and not -l;
        push @exclude,$_;
        next;
      }
    }
    next if -l or not -f;
    if (/\.($utypes)$/i) {
      $cf += -s;
    } else {
      $uf += -s;
    }
  }

  if ($uf+$cf > 2**30 or $uf/$cf < 0.2 and $uf+$cf > 2**24) {
    push @zip,'-0';
  }

  http_header('200 OK');

  pq(qq(
    '<html>'
    '<body>'
    '<pre>'
  ));
  push @zip,$zip,$dir;
  push @zip,'-x',@exclude if not $akey and @exclude;
  doxlog("[@zip]");
  if ($akey) {
    print htmlquote("\$ @zip\n");
  }
  unlink $zip;
  if (open my $zip,'-|',@zip) {
    while (<$zip>) {
      # print $scroll,htmlencode(decode_utf8($_));
      print $scroll,htmlencode($_);
    }
    close $zip;
  }
  print "</pre>\n";
  if (my $s = -s $zip) {
    $s = int($s/$MB);
    print qq'Download <a href="/$dox/$owner/$zip">$zip</a> ($s MB)\n';
  }
  pq(qq(
    '<p>'
    '$back'
    '$scroll'
    '</body>'
    '</html>'
  ));

}


sub zipfiles {
  my $files = @_;
  my $dir = $file;
  my $zip = basename($dir);
  my @zip = qw'zip';
  my $uf = my $cf = 1;
  local $_;

  $zip =~ s:[^\w\@%~^,+-]:_:g;
  $zip .= sprintf "_%s.zip",time;

  map { $_="$dir/$_" } @files;

  unless ($akey) {
    foreach my $file (@files) {
      if (excluded($file)) { http_die("no access for $file") }
      if (-d $file)        { http_die("cannot fex $file/") }
    }
  }

  foreach (@files) {
    if (my $size = -s) {
      if (/\.($utypes)$/i) {
        $cf += $size;
      } else {
        $uf += $size;
      }
    }
  }

  if ($uf+$cf > 2**30 or $uf/$cf < 0.2 and $uf+$cf > 2**24) {
    push @zip,'-0';
  }

  http_header('200 OK');

  pq(qq(
    '<html>'
    '<body>'
    '<pre>'
  ));
  if ($akey) { push @zip,'-r' }
  else       { push @zip,'-j' }
  push @zip,$zip,@files;
  doxlog("[@zip]");
  if ($akey) {
    print htmlquote("\$ @zip\n");
  }
  unlink $zip;
  if (open $zip,'-|',@zip) {
    while (<$zip>) {
      print $scroll,htmlencode($_);
    }
    close $zip;
  }
  print "</pre>\n";
  if (my $s = -s $zip) {
    $s = int($s/$MB);
    pq(qq(
      'Download <a href="/$dox/$owner/$zip">$zip</a> ($s MB)'
      '$scroll\n'
    ));
  }
  pq(qq(
    '<p>'
    '$back'
    '</body>'
    '</html>'
  ));
}


sub fexdir {
  my $dir = shift;
  my $recipient = shift;
  my $fexsend = "fexsend -q -C 'DOX $owner'";

  unless ($recipient =~ /@/ and checkaddress($recipient)) {
    http_die("$recipient is not a valid email address");
  }

  nvt_print(
    'HTTP/1.1 200 OK',
    'Server: fexsrv',
    "Content-Type: text/html; charset=$charset",
    '',
  );

  pq(qq(
    '<html>'
    '<body>'
    '<pre>'
  ));
  if ($akey) {
    # $fexsend .= " -A $dir.zip $dir/* $dir/.??*";
    $fexsend .= " -a $dir.zip $dir";
  } else {
    my $X = '.\*';
    foreach my $x (asort(keys %exclude)) {
      $x =~ s/([?*])/\\$1/g;
      $x =~ s/([^\w\/.-])/\\$1/g;
      $X .= "#$x";
    }
    $fexsend .= " -# $X -a $dir.zip $dir/*";
  }
  $fexsend .= " $recipient";
  doxlog("[$fexsend]");
  print "\$ $fexsend\n";
  if (open $fexsend,"$fexsend 2>&1|") {
    while (<$fexsend>) {
      print $scroll,htmlencode($_);
    }
    close $fexsend;
  }
  pq(qq(
    '</pre>'
    '$back'
    '$scroll'
    '</body>'
    '</html>'
  ));
}


sub fexfiles {
  my $recipient = pop;
  my @files = @_;
  my $dir = $file;
  my $zip = shellquote(basename($dir)).'.zip';
  my $fexsend;

  if ($recipient =~ /@/ and checkaddress($recipient)) {
    http_header('200 OK');
  } else {
    http_die("$recipient is not a valid email address");
  }

  chdir $dir or http_die("$dir - $!");

  unless ($akey) {
    foreach my $file (@files) {
      if (excluded("$dir/$file")) { http_die("no access for $file") }
      if (-d $file)               { http_die("cannot fex $file/") }
    }
  }

  pq(qq(
    '<html>'
    '<body>'
    '<pre>'
  ));
  map { s/[\'\\]/_/g } @files;
  $fexsend = "fexsend -q -C 'DOX $owner : @files' ";
  $fexsend .= $akey ? '-A' : '-a';
  $fexsend .= " $zip @files $recipient";
  doxlog("[$fexsend]");
  print "\$ $fexsend\n";
  if (open $fexsend,"$fexsend 2>&1|") {
    while (<$fexsend>) {
      print $scroll,htmlencode($_);
    }
    close $fexsend;
  }
  pq(qq(
    '</pre>'
    '$back'
    '$scroll'
    '</body>'
    '</html>'
  ));
}


sub delfiles {
  my @files = @_;
  my $dir = $file;
  local $_;

  unless ($akey or "$file/" =~ m:^\Q$folder/.upload/$user/:) {
    http_die("no permission");
  }

  chdir $dir or http_die("$dir - $!");

  foreach my $file (@files) {
    unless (-f $file or -d $file) {
      http_die("no such file or directory $dir/$file")
    }
  }

  foreach my $file (@files) {
    if (-f $file) {
      unlink($file);
    } elsif (-d $file) {
      unlink("$file!publish") if $dir =~ m:/\.upload$: and $file =~ /@/;
      rmrf($file);
    }
  }

  chdir "$spooldir/$owner/DOX" or die $!;
  update_folder($folder) if $file !~ m:^\Q$folder/.upload/:
}


sub movefiles {
  my @files = @_;
  my $dir = $file;

  unless ($akey) { http_die("no permission") }

  unless (-d $destination) {
    http_die("destination /$destination is not a directory")
  }

  map { $_="$dir/$_" } @files;

  my $errors = move(@files,$destination);
  update_folder($folder);
  if ($errors) {
    $errors = htmlquote($errors);
    http_header('200 OK');
    print html_header($head);
    pq(qq(
      '<h1>move error</h1>'
      '$errors'
      '</body>'
      '</html>'
    ));
    &reexec;
  }
}


sub copyfiles {
  my @files = @_;
  my $dir = $file;

  unless ($akey) { http_die("no permission") }

  foreach my $file (@files) {
    unless (-f "$dir/$file" or -d "$dir/$file") {
      http_die("no such file or directory $dir/$file")
    }
  }

  if ($folder =~ /^\Q$destination\E_$vp$/) {
    # use same source directory if coming from same folder other version
    $destination = $dir;
    $destination =~ s/_$vp//;
    mkdirp($destination);
  } else {
    # add source folder name if coming from foreigner folder
    $destination .= "/$folder";
    $destination =~ s/!backup$//;
    unless (-d $destination) {
      mkdir $destination or http_die("cannot mkdir $destination - $!");
    }
  }

  foreach my $file (@files) {
    rmrf("$destination/$file");
    if (-f "$dir/$file") {
      link "$dir/$file","$destination/$file";
    } else {
      system qw'cp -al',"$dir/$file","$destination/$file";
    }
  }
  update_folder($1) if $destination =~ m:([^/]+):;
}


sub savefile {
  my $file = shift;

  unless ($akey) {
    http_die("no permission")
  }

  if ($file =~ m:^/: or "/$file/" =~ m:\Q/../:) {
    http_die("illegal file name $file");
  }

  unless (-f $file) {
    http_die("/$file does not exist");
  }

  my $qfile = shellquote($file);
  system "$FEXHOME/bin/vv -s $qfile 2>/dev/null";
  open $file,'>',$file or http_die("cannot write $file - $!");
  print {$file} $filedata;
  close $file;
}


sub queryrename {
  my @files = @_;
  my $dir = urlencode($file);
  unless ($akey) { http_die("no permission") }

  http_header('200 OK');
  print html_header($head);
  pq(qq(
    '<h1>/$dir/</h1>'
    '<form name="rename"'
    '  action="/$doxo/$dir"'
    '  method="POST"'
    '  accept-charset="$charset"'
    '  enctype="multipart/form-data">'
    '<table border=0>'
    '<tr><th align="left">old name<th>&rarr;<th align="left">new name</tr>'
  ));

  foreach my $file (@files) {
    print "<tr>";
    printf '<td>%s<input type="hidden" name="renamefrom" value="%s">',
           htmlencode($file),htmlquote($file);
    print "<td>&rarr;";
    printf '<td><input type="text" name="renameto" value="%s" size="60">',
           htmlquote($file);
    print "</tr>\n";
  }

  pq(qq(
    '</table>'
    '<input type="submit">'
    '</form>'
    '</body>'
    '</html>'
  ));
  exit;
}


sub renamefiles {
  my @files = @_;
  my $dir = decode_utf8($file);
  my $i = 0;

  unless ($akey) { http_die("no permission") }

  if (scalar(@renamefrom) != scalar(@renameto)) {
    http_die("rename: different parameter numbers")
  }

  chdir $dir or http_die("$dir - $1");

#  http_header('200 OK');
#  print html_header($head);
#  printf "<h1>/%s/</h1><pre>\n",htmlquote($dir);
#  foreach my $old (@renamefrom) {
#    printf "[%s] &rarr; [%s]\n",htmlquote($old),htmlquote($renameto[$i]);
#    $i++;
#  }
#  exit;

  foreach my $rf (@renamefrom) {
    my $rt = $renameto[$i];
    if ($rf ne $rt and not lstat $rt and length($rt)) {
      rename($rf,$rt);
    }
    $i++;
  }

}


sub update_folder {
  my $folder = shift;
  my @d = localtime time;
  my $lv = readlink($folder) or return;
  my $nv = sprintf(
    '%s_%d%02d%02d_%02d%02d%02d',
    $folder,$d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]
  );

  rename untaint($lv),$nv or return;
  unlink $folder;
  symlink $nv,$folder;
  if (opendir my $dox,'.') {
    while (defined($_ = readdir $dox)) {
      if (-d and not -l and /$vp/) {
        if (/^((\Q$folder\E_$vp)!backup)$/ and -d $2) {
          rmrf($1);
        } elsif (/^((\Q$folder\E_$vp)!backup)$/) {
          rename $1,$2;
        }
      }
    }
    closedir $dox;
  }
}


sub sendfile {
  my $dir = shift;
  my $okey = randstring(8);
  my $okeyd = "$spooldir/$owner/\@OKEY";
  my $url = $ENV{REQUEST_URL};

  unless ($user =~ /@/ and checkaddress($user)) {
    http_die("$user is not a valid email address");
  }

  mkdir $okeyd;
  symlink $user,"$okeyd/$okey"
    or http_die("cannot create OKEY $okeyd/$okey - $!");

  $url =~ s:\?.*::;
  my $comment = urlencode($url);
  $url =~ s:/$dox/.*:/fup?to=$owner&okey=$okey&comment=$comment:;

  redirect($url);
  exit;
}


sub okey {
  my $dir = shift;
  my $okey = randstring(8);
  my $okeyd = "$spooldir/$owner/\@OKEY";

  unless ($user =~ /@/ and checkaddress($user)) {
    http_die("$user is not a valid email address");
  }

  mkdir $okeyd;
  symlink $user,"$okeyd/$okey"
    or http_die("cannot create OKEY $okeyd/$okey - $!");

  nvt_print(
    'HTTP/1.0 200 OK',
    "Server: fexsrv",
    "X-okey: $okey",
    "Content-Type: text/plain",
    ''
  );

  print "okey=$okey\n";
  exit;
}


sub notify_owner {
  my $upload = "$folder/.upload/$user";
  my @files = ();
  my ($mfrom,$hfrom) = mhfrom($user);
  my $header = qqq(qq(
    'From: <$mfrom> ($hfrom via F*EX service $hostname)'
    'To: $owner'
    'Subject: DOX upload /$folder/'
    'MIME-Version: 1.0'
    'Content-Type: text/plain; charset=UTF-8'
    'Content-Transfer-Encoding: 8bit'
  ));
  local $_;

  chdir $upload or http_die("$owner : $upload - $!");

  foreach (asort(find("."))) {
    next if -l or not -f;
    push @files,"$1\n" if m:^\./(.+):;
  }

  # explicite sender set in fex.ph?
  if ($sender_from) {
    # obsoleted feature!
    map { s/^From: <\Q$user/From: <$sender_from/ } $header;
    open $sendmail,'|-',$sendmail,$owner,$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 e-mail
    my $dfrom = $1 if $user  =~ /@(.+)/;
    my $dto   = $1 if $owner =~ /@(.+)/;
    if ($dfrom and $dto and @remote_domains and
        grep { $dfrom =~ /(^|\.)$_$/ and $dto =~ /(^|\.)$_$/ } @remote_domains)
    {
      $header =~ s/(From: <)\Q$user\E(.*?)\n/$1$admin$2\nReply-To: $user\n/;
      open $sendmail,'|-',$sendmail,$owner,$bcc
        or http_die("cannot start sendmail - $!");
    } else {
      open $sendmail,'|-',$sendmail,'-f',$mfrom,$owner,$bcc
        or http_die("cannot start sendmail - $!");
    }
  }

  my @body = (
    "$doxurl$folder/.upload/$user\n",
    "\n",
    @files
  );
  print {$sendmail} $header,"\n",@body;

  if (close $sendmail) {
    http_header('200 OK');
    print html_header($head);
    pq(qq(
      '<h2>Notification email has been sent to $owner</h2>'
      '<a href="/$doxo/$folder/UPLOAD">back to DOX</a>'
    ));
  } else {
    http_die("cannot send notification email (sendmail error $!)");
  }

}


sub mirror {
  my $bytes = 0;
  my ($quota,$du) = check_recipient_quota($owner);
  if ($quota and $du > $quota) {
    http_die("$owner is overquota");
  }
  chdir $file or http_die("$owner : $file - $!");
  my $wget='wget -e robots=off -w 1 -nv -nH -np -m';
  $mirror .= '/' if $mirror =~ m:.*/[^./]+$:;
  $mirror = untaint(shellquote($mirror));
  open $wget,"$wget $mirror 2>&1|" or http_die("cannot run wget - $!");

  http_header('200 OK');
  print html_header($head);
  print "<h1>Mirroring to /$file/</h1>\n";
  print "<pre>\n";

  while (<$wget>) {
    if (/URL:(.+(\d+)\]) -> /) {
      $bytes += $2;
      printf "%s%s\n",$scroll,htmlquote($1) or exit;
      if ($quota and $du+$bytes/$MB > $quota) {
        pq(qq(
          '</pre>'
          '<h1>Overquota! ($quota MB)</h1>'
          '$scroll'
          '</body></html>'
        ));
        exit;
      }
    }
  }

  pq(qq(
    '</pre>'
    '<a href="/$doxo/$file/">back to DOX</a>'
    '</body>'
    '</html>'
  ));
  exit;
}


sub publish {
  my @files = @_;
  my $sdir = $file;
  my $ddir = $sdir;

  unless ($akey)    { http_die("no permission") }
  unless (-d $sdir) { http_die("unknown upload directory $sdir") }

  map { $_ = "$sdir/$_" } @files;
  $ddir =~ s:^\Q$folder/.upload/\E[^/]+(.*):$folder$1:;
  mkdirp($ddir);
  publishlog(@files);
  my $errors = move(@files,$ddir);
  update_folder($folder);
  if ($errors) {
    $errors = htmlquote($errors);
    http_header('200 OK');
    print html_header($head);
    pq(qq(
      '<h1>move error</h1>'
      '$errors'
      '</body>'
      '</html>'
    ));
    &reexec;
  }
}


sub publish_all {
  my $dir = shift;
  my @files = ();
  my $user = '';
  local $_;

  if (-d $dir and $dir =~ m:^\Q$folder/.upload/\E([^/]+)$:) {
    $user = $1;
  } else {
    http_die("unknown upload directory $dir");
  }

  foreach (glob "$dir/*") {
    next if -l;
    foreach (asort(find($_))) {
      push @files,$_ if -f and not -l;
    }
  }
  publishlog(@files) if @files;

  @files = glob "$dir/*" or return;
  map { /(.+)/; $_ = $1 } @files;

  my $errors = move(@files,$folder);
  update_folder($folder);

  if ($errors) {
    $errors = htmlquote($errors);
    http_header('200 OK');
    print html_header($head);
    pq(qq(
      '<h1>move error</h1>'
      '$errors'
      '</body>'
      '</html>'
    ));
    exit;
  }
}


sub syncdir {
  my $dir = shift;
  my @fexsync = ('fexsync');

  unless ($akey) {
    if ($dir ne $folder) {
      http_die('syncing not allowed for users');
    }
    my $exclude = '\.[^/]*';
    foreach (asort(values %exclude)) {
      s:^/+::;
      $exclude .= '|'.$_;
    }
    foreach (find($dir)) {
      if (-l) {
        s:^$folder/:./:;
        $exclude .= '|'.quotemeta($_);
      }
    }
    push @fexsync,'-X',$exclude;
  }

  nvt_print(
    'HTTP/1.1 200 OK',
    'Server: fexsrv',
    "Content-Type: text/html; charset=$charset",
    '',
  );

  pq(qq(
    '<html>'
    '<body>'
  ));
  push @fexsync,$dir;
  doxlog("[@fexsync]");
  print "\$ @fexsync\n" if $akey;
  local $ENV{FEXHOME} = '';
  local $ENV{FEXCOMMENT} = "$owner/DOX/$dir";
  local $ENV{FEXID} = '';
  local $ENV{FEXXX} = '';
  local $ENV{FEXSERVER} = '';
  if (open my $fexsync,'-|',@fexsync) {
    while (<$fexsync>) {
      if (/to start sync receiving without FEXID/) {
        print "<h3>To start sync receiving run:</h3>\n";
        print "<pre>\n";
        $_ = <$fexsync>;
        s/:\d+/:$ENV{PORT}/;
        print;
        last;
      }
    }
    while (<$fexsync>) {
      s!^server/user:.*!!;
      last if /^Recipient: /;
      print $scroll,htmlencode($_);
    }
    while (<$fexsync>) { }
    close $fexsync;
  }
  pq(qq(
    '</pre>'
    '<script>history.back()</script>'
    '</body>'
    '</html>'
  ));
}


sub streamdir {
  my $dir = shift;
  my $stream = $dir;
  my @tar = qw'tar -c';
  my ($sex,$tar,$data,$sexsend);

  $SIG{ALRM} = sub {
    $SIG{__DIE__} = 'DEFAULT';
    die "<h2>TIMEOUT<h2>\n";
  };
  alarm($timeout*10);

  if ($akey) {
    if (-l $dir) {
      push @tar,qw'-f -',"$dir/.";
    } else {
      push @tar,qw'-f -',$dir;
    }
  } else {
    push @tar,"--exclude=.*";
    foreach (asort(keys %exclude)) {
      s:^/+::;
      push @tar,"--exclude=$_";
    }
    foreach (find($dir)) {
      push @tar,"--exclude=$_" if -l;
    }
    if (-l $dir) {
      push @tar,qw'-f -',map {$_=untaint($_)} glob("$dir/*");
    } else {
      push @tar,qw'-f -',$dir;
    }
  }

  my $idf = "$ENV{HOME}/.fex/id";
  open $idf,$idf or http_die("no $idf");
  my $url = <$idf>;
  my $fexuser = <$idf>;
  close $idf;
  unless ($fexuser) {
    http_die("no fexuser in $idf");
  }
  chomp $url;
  chomp $fexuser;

  nvt_print(
    'HTTP/1.1 200 OK',
    'Server: fexsrv',
    "Content-Type: text/html; charset=$charset",
    '',
  );

  pq(qq(
    '<html>'
    '<body>'
  ));
  $stream =~ s/[^\w\@.+-]/_/g;
  $stream .= ':'.randstring(8);
  $sex = "@tar | sexsend public $stream";
  doxlog("[$sex]");
  my $sexurl = "$url/sex?user=$fexuser&ID=public&stream=$stream";
  print "\$ $sex\n" if $akey;
  pq(qq(
    "<h3>To start stream receiving run:</h3>"
    "<pre>"
    "sexget $url/$fexuser:public $stream | tar xvf -"
    ""
    "wget -O- '$sexurl' | tar xvf -"
    ""
    "curl '$sexurl' | tar xvf -"
    "</pre>"
  ));
  local $ENV{FEXHOME} = '';
  local $ENV{FEXID} = '';
  local $ENV{FEXXX} = '';
  local $ENV{FEXSERVER} = '';
  open $sexsend,"|sexsend public $stream >/dev/null" or exit;
  open $tar,'-|',@tar or exit;
  while (read($tar,$data,$bs)) {
    print {$sexsend} $data or exit;
    alarm($timeout*10);
  }
  close $sexsend;
  close $tar;
  pq(qq(
    '<script>history.back()</script>'
    '</body>'
    '</html>'
  ));
}


sub backup_cleanup {
  my $folder = shift;
  my $current = readlink($folder) or return;

  foreach my $v (grep /^\Q$folder\E_$vp$/,glob "*") {
    if ($v ne $current and -d $v and -d "$v!backup") {
      rmrf(untaint("$v!backup"));
    }
  }
}


sub d3 {
  local $_ = shift;
  while (s/(\d)(\d\d\d\b)/$1,$2/) {};
  return $_;
}


sub http_date {
  my $file = shift;
  my @stat;

  if (@stat = stat($file)) {
    return strftime("%a, %d %b %Y %T GMT",gmtime($stat[9]));
  } else {
    return 0;
  }
}


# test if file is excluded (private)
sub excluded {
  my $file = shift;
  $file =~ s://+:/:;
  $file =~ s:^/::;
  $file =~ s:/$::;
  $file =~ s:^\Q$folder/::;
  foreach my $p (keys %exclude) {
    my $pp = $exclude{$p};
    $pp = '.*/'.$pp if $pp !~ m:^/:;
    return 1 if "/$file" =~ m:^$pp(/.*)?$:;
  }
}


sub reldir {
  local $_ = '/'.shift.'/';
  while (s:/\.\./:/__/:) {}
  s://+:/:g;
  m:/(.+)/:;
  return $1;
}


sub redirect {
  my $uri = urlencode(shift);

  $uri =~ s/%3F/?/g;
  $uri =~ s/%26/&/g;

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


sub doxlog {
  my $msg = shift;
  my $ra = $RA||'-';

  $ra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
  $ra =~ s/\s//g;
  $msg = sprintf("%s %s %s %s %s\n",isodate(time),$ra,$owner,$user,$msg);
  writelog('dox.log',$msg);
}


sub publishlog {
  my @files = @_;
  my @d = localtime time;
  my $log;
  local $_;

  mkdir "$folder/.upload";
  $log = "$folder/.upload/log";
  open $log,'>>',$log or return;
  flock($log,LOCK_EX);

  printf {$log}
    "\nPUBLISH %d-%02d-%02d %02d:%02d:%02d %s %s %s\n",
    $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0],
    $user,$ENV{REMOTE_HOST}||'-',$ENV{REMOTE_ADDR}||'.';
  foreach (asort(@files)) {
    s:/+:/:g;
    s:^\Q$folder/::;
    s:^\Q.upload/::;
    print {$log} "$1\n" if /(.+)/;
  }
  close $log;
}


sub showenv {
  http_header('200 OK');
  foreach my $v (asort(keys %ENV)) {
    printf "%s = '%s'\n",$v,$ENV{$v};
  }
}


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


# parse GET and POST requests
sub parse_request {
  my ($boundary);
  my $QS = $ENV{QUERY_STRING};
  local $_;

  # parse HTTP QUERY_STRING (parameter=value pairs)
  if ($QS) {
    $QS =~ s/\?/&/g if $QS !~ /&/ and $QS =~ /\?\w+=/;
    foreach (split '&',$QS) {
      if (s/^(\w+)=(.*)//) {
        my $p = uc($1);
        my $v = $2;
        # decode URL-encoding
        $v =~ s/%([a-f0-9]{2})/chr(hex($1))/gie;
        setparam($p,$v);
      }
    }
  }

  if ($ENV{REQUEST_METHOD} eq 'POST') {
    $SIG{ALRM} = sub {
      $SIG{__DIE__} = 'DEFAULT';
      die "TIMEOUT\n";
    };
    alarm($timeout);
    # binmode(STDIN,':raw');

    if (($ENV{CONTENT_TYPE}||'') =~ /boundary=\"?([^\s\";,]+)/) {
      $boundary = $1;
    } else {
      http_die("malformed HTTP POST (no boundary found)");
    }

    while (&nvt_read) {
      alarm($timeout);
      if (/^Content-Disposition:\s*form-data;\s*name="([a-z]\w*)"/i) {
        my $name = $1;
        my $data = '';
        nvt_skip_to('^\s*$');
        while (&nvt_read) {
          alarm($timeout);
          last if /^--\Q$boundary/;
          $data .= $_."\n";
        }
        setparam($name,$data);
      }
      last if /^--\Q$boundary--/;
    }
  }

  alarm(0);
}



# set CGI parameter variables
sub setparam {
  my ($v,$vv) = @_;
  my ($idf,$to);
  local $_;

  $v = uc(despace($v));

  chomp($vv);
  $PARAM{$v} = $vv;
  if ($v eq 'LOGOUT' and $akey) {
    unlink "$akeydir/$akey";
    my $login = $FEXHOME.'/cgi-bin/login';
    if (-x $login) {
      $login = readlink($login) || 'login';
      nvt_print(
        "HTTP/1.1 302 Found",
        "Location: $hosturl/$login",
        'Content-Length: 0',
        ""
      );
    } else {
      nvt_print(
        "HTTP/1.1 302 Found",
        "Location: $hosturl/fup",
        'Content-Length: 0',
        ""
      );
    }
    &reexec;
  } elsif ($v eq 'SUBMIT') {
    $submit = lc($vv);
  } elsif ($v eq 'DIRECTORY') {
    # $directory = reldir(decode_utf8($vv));
    $directory = reldir($vv);
  } elsif ($v eq 'DESTINATION') {
    # $destination = reldir(decode_utf8(urldecode($vv)));
    $destination = reldir(urldecode($vv));
  } elsif ($v eq 'PARENTDIR') {
    # $parentdir = reldir(decode_utf8(urldecode($vv)));
    $parentdir = reldir(urldecode($vv));
  } elsif ($v eq 'UPLOADDIR' and $vv =~ /^($mrx)$/) {
    $uploaddir = $1;
  } elsif ($v eq 'NEWDIR' and $vv =~ /^\s*([^\/]+?)\s*$/) {
    # $newdir = decode_utf8(urldecode($1));
    $_ = urldecode($1);
    s:[\\/]:_:g;
    $newdir = $_;
  } elsif ($v eq 'NEWFOLDER' and $vv =~ /^\s*(.+?)\s*$/) {
    $_ = $1;
    s/[^a-z_\d\@~^,.+-]/_/gi;
    s/^\./_/;
    $newfolder = $_;
  } elsif ($v eq 'ALLOWPUBLISH' and $vv =~ /^($mrx)$/) {
    $allowpublish = $1;
  } elsif ($v eq 'ACTION' and $vv =~ /^([\w:]+)$/) {
    $action = $1;
  } elsif ($v eq 'MIRROR' and $vv =~ /\.[a-z]/i) {
    $mirror = urldecode($vv);
    $mirror =~ s/\s//g;
    $mirror =~ s/[<>|]/_/g;
  } elsif ($v eq 'FILE' and $vv =~ /^([^\/]+)$/) {
    # push @files,decode_utf8(urldecode($1));
    $_ = urldecode($1);
    s:[\\/]:_:g;
    push @files,$_;
  } elsif ($v eq 'RENAMEFROM' and $vv =~ /^\s*(.*?)\s*$/) {
    local $_ = $1;
    s:/:_:g;
    # push @renamefrom,decode_utf8(urldecode($_));
    push @renamefrom,urldecode($_);
  } elsif ($v eq 'RENAMETO' and $vv =~ /^\s*(.*?)\s*$/) {
    $_ = urldecode($1);
    s:[\n\r]: :g;
    s:[\\/]:_:g;
    # push @renameto,decode_utf8($_);
    push @renameto,$_;
  } elsif ($v eq 'FILEDATA') {
    $filedata = $vv;
  } else {
    http_die("unknown or empty parameter $v");
  }
}
