]> git.treefish.org Git - fex.git/commitdiff
Original release 20160919 master 20160919
authorfextracker <fextracker@treefish.org>
Tue, 20 Sep 2016 02:00:06 +0000 (04:00 +0200)
committerfextracker <fextracker@treefish.org>
Tue, 20 Sep 2016 02:00:06 +0000 (04:00 +0200)
2016-09-19: dop: do not show return value of &lt;&lt;perl-code;>> in dynamic html
2016-09-19: file if this code ends with a ";"
2016-09-07: new fex.ph config variable $purge
2016-09-01: dop: removed (forgotten) CGI::Carp
2016-08-29: fexsend,fexget: update function aborts if new version is not newer
2016-08-03: added timeout to error output, fixes hanging fup
2016-08-03: fexsend: fixed bug dangling symlinks raise an error in archive mode
2016-07-21: fexsrv: map http client headers HTTP-HOST HTTP-VERSION PROXY* to
2016-07-21: HTTP_X_HOST HTTP_X_VERSION HTTP_X_PROXY*
2016-07-11: added missing fex.png fexit.png to distribution
2016-05-31: fur: fixed bug no external user registration possible

49 files changed:
bin/ezz
bin/fbm
bin/fex_cleanup
bin/fexget
bin/fexsend
bin/fexsrv
bin/fpg
bin/l
bin/logwatch
bin/sexsend
bin/zz
cgi-bin/fac
cgi-bin/fup
cgi-bin/fur
doc/Changes
doc/SSL
doc/concept
doc/new
doc/version
htdocs/FAQ/admin.faq
htdocs/FAQ/admin.html
htdocs/FAQ/all.html
htdocs/FAQ/faq.pl
htdocs/FAQ/local.html
htdocs/FAQ/meta.faq
htdocs/FAQ/meta.html
htdocs/FAQ/misc.html
htdocs/FAQ/user.html
htdocs/FAQ/xx.html [new file with mode: 0644]
htdocs/FAQ/xx.pl [new file with mode: 0755]
htdocs/FAQ/zz.pl [new file with mode: 0644]
htdocs/download/fexget
htdocs/download/fexsend
htdocs/download/sexsend
htdocs/fex.png [new file with mode: 0644]
htdocs/fexit.html
htdocs/fexit.png [new file with mode: 0644]
htdocs/version
install
lib/dop
lib/fex.ph
lib/fex.pp
locale/czech/htdocs/FAQ/FAQ.html
locale/french/htdocs/FAQ/FAQ.html
locale/galician/htdocs/FAQ/FAQ.html
locale/german/htdocs/FAQ/FAQ.html
locale/italian/htdocs/FAQ/FAQ.html
locale/spanish/htdocs/FAQ/FAQ.html
locale/translations

diff --git a/bin/ezz b/bin/ezz
index 523dc8c014759266c77b356cd8767aee1aa3d3e7..39dc91e318edc4c1f208177baeeff7c30f67e35a 100755 (executable)
--- a/bin/ezz
+++ b/bin/ezz
-#!/bin/sh
+#!/usr/bin/perl -w
+#
+# vv : visual versioning
+# zz : generic shell clip board
+# ezz : clip board editor
+#
+# http://fex.rus.uni-stuttgart.de/fstools/vv.html
+# http://fex.rus.uni-stuttgart.de/fstools/zz.html
+#
+# by Ulli Horlacher <framstag@rus.uni-stuttgart.de>
+#
+# Perl Artistic Licence
+#
+# vv is a script to handle file versions:
+# list, view, recover, diff, purge, migrate, save, delete
+#
+# vv is an extension to emacs idea of backup~ files
+#
+# File versions are stored in local subdirectory .versions/
+#
+# To use vv with jed, install to your jed library path:
+#
+#   http://fex.rus.uni-stuttgart.de/sw/share/jedlib/vv.sl
+#
+# To use vv with vim, add to your .vimrc:
+#
+#   autocmd BufWritePre  * execute '! vv -s ' . shellescape(@%)
+#   autocmd BufWritePost * execute '! vv -b ' . shellescape(@%)
+#
+# To use vv with emacs, add to your .emacs:
+#
+#   (add-hook 'before-save-hook (lambda () (shell-command (
+#    concat "vv -s " (shell-quote-argument (buffer-file-name))))))
+#   (add-hook 'after-save-hook  (lambda () (shell-command (
+#    concat "vv -b " (shell-quote-argument (buffer-file-name))))))
+#   (setq make-backup-files nil)
+#
+# To use vv with ANY editor, first set:
+#
+#   export EDITOR=your_favourite_editor
+#   alias ve='vv -e'
+#
+# and then edit your file with:
+#
+#   ve file
+#
+# $HOME/.vvrc is the config file for vv
 
 
-ZZ=${ZZ:-$HOME/.zz}
+# 2013-04-15 initial version
+# 2013-04-16 added options -m and -v
+# 2013-04-18 added option -s
+# 2013-04-22 realfilename() fixes symlink problematics
+# 2013-04-22 use rsync instead of cp
+# 2013-04-23 added option -I
+# 2013-04-23 renamed from jedv to vv
+# 2013-04-24 added options -e -0
+# 2013-05-09 added option -R
+# 2013-05-22 modified option -d to double argument
+# 2013-05-22 added vvrc with $exclude and @diff
+# 2013-07-05 fixed bug potential endless loop in rotate()
+# 2014-04-16 added change-file-test for opt_s (needs .versions/$file)
+# 2014-04-18 added option -b : save backup
+# 2014-05-02 fixed bug wrong file ownership when using as root
+# 2014-06-18 options -r -d -v : parameter is optional, default is 1
+# 2014-06-18 fixed (stupid!) bug option -s does only sometimes saving
+# 2014-06-20 options -d -v : argument is optional, default is last file
+# 2014-07-22 fixed bug no (new) backup version 0 on option -r
+# 2014-11-14 added option -D : delete last saved version
+# 2014-11-14 make .versions/ mode 777 if parent directory is world writable
+# 2015-03-19 allow write access by root even if file and .versions/ have different owners
+# 2015-03-20 better error formating for jed
+# 2015-06-02 added option -r . to restore last saved backup
+# 2016-03-07 added options -M -L
+# 2016-03-08 renamed option -I to -H
+# 2016-05-02 added -A option to preserve ACLs with rsync
+# 2016-06-07 option -v : use PAGER=cat if STDOUT is not a tty
+# 2016-06-08 added zz, ezz and installer vvzz
+# 2016-07-06 avoid empty $ZZ versioning
+# 2016-09-12 added option -q quiet mode
 
 
-usage() {
-  exec cat<<EOD
-ezz is the edit helper program for the generic zz clip board program.
-The clip board is \$ZZ (default: \$HOME/.zz). Options and modes are:
+use Getopt::Std;
+use File::Basename;
+use Digest::MD5 'md5_hex';
+use Cwd 'abs_path';
 
 
-"ezz"                  edit \$ZZ
-"... | ezz"            write STDIN from pipe to \$ZZ and call editor
-"... | ezz +"          add STDIN from pipe to \$ZZ and call editor
-"ezz 'perl-script'"    run perl-script on \$ZZ
-"ezz - 'perl-script'"  run perl-script on \$ZZ and write result to STDOUT
-"ezz filter [args]"    run filter [with args] on \$ZZ
-"ezz - filter [args]"  run filter [with args] on \$ZZ and write result to STDOUT
-"ezz -r"               restore \$ZZ from last ezz operation (\$ZZ~)
+$prg = abs_path($0);
+$0 =~ s:.*/::;
+
+$ZZ = $ENV{ZZ} || "$ENV{HOME}/.zz";
+
+&install if $0 eq 'vvzz';
+&zz      if $0 eq 'zz';
+&ezz     if $0 eq 'ezz';
+
+# vv
+$usage = <<EOD;
+usage: $0 [-l] [file]
+       $0 -r . file
+       $0 -r version-number file [new-file]
+       $0 -d version-number[:version-number] file
+       $0 -v version-number file
+       $0 -s file
+       $0 -D file
+       $0 -e file
+       $0 -M file|.
+       $0 -L file|.
+       $0 -m [-R]
+       $0 -p
+       $0 -q
+       $0 -H
+options: -l   list available versions
+         -v   view version
+         -r   recover file (. is last saved backup)
+         -d   show diff
+         -s   save file to new version
+         -D   delete last saved version
+         -e   edit file with \$EDITOR (with versioning)
+         -p   purge orphaned versions (without current file)
+         -q   quiet mode
+         -m   migrate backup files to version files (-R all recursive)
+         -M   migrate to more versions (upto 100)
+         -L   migrate to less versions (upto 10)
+         -H   show more information
+examples: $0 project.pl
+          $0 -d 2 project.pl
+          $0 -r 2 project.pl project_2.pl
+EOD
+
+$vvrc = $ENV{HOME} . '/.vvrc';
+
+$opt_l = 1;
+$opt_h = $opt_p = $opt_m = $opt_s = $opt_0 = $opt_e = $opt_H = $opt_b = 0;
+$opt_q = $opt_D = $opt_R = 0;
+$opt_r = $opt_d = $opt_v = $opt_M = $opt_L = '';
+${'opt_+'} = 0;
+getopts('hHls0bepqmRDrdv+M:L:') or die $usage;
+
+if ($opt_h) {
+  print $usage;
+  exit;
+}
+
+if ($opt_H) {
+  open $prg,$prg or die "$0: $prg - $!\n";
+  $_ = <$prg>;
+  $_ = <$prg>;
+  while (<$prg>) {
+    last if /^\s*$/ or /^#\s*\d\d\d\d-\d\d-\d\d/;
+    print;
+  }
+  exit;
+}
+
+if ($opt_r) {
+  die "usage: $0 -r version-number file\n" unless @ARGV;
+  if ($ARGV[0] =~ /^(\d\d?|\.)$/) { $opt_r = shift }
+  else                            { $opt_r = 1 }
+  die "usage: $0 -r version-number file\n" if scalar @ARGV != 1;
+}
+
+if ($opt_d) {
+  if (@ARGV and $ARGV[0] =~ /^\d\d?(:\d\d?)?$/) { $opt_d = shift }
+  else                                          { $opt_d = 1 }
+  &check_ARGV;
+  die "usage: $0 -d version-number file\n" unless @ARGV;
+}
+
+if ($opt_v) {
+  if (@ARGV and $ARGV[0] =~ /^\d\d?$/) { $opt_v = shift }
+  else                                 { $opt_v = 1 }
+  &check_ARGV;
+  die "usage: $0 -v version-number file\n" unless @ARGV;
+}
+
+if ($0 eq 've' or $opt_e) {
+  $a = pop @ARGV or die $usage;
+  $opt_e = 1;
+} else {
+  $a = shift @ARGV;
+  die $usage if not $opt_r and @ARGV;
+}
+
+unless (-e $vvrc) {
+  open $vvrc,'>',$vvrc or die "$0: cannot write $vvrc - $!\n";
+  print {$vvrc} q{
+$exclude = q(
+  \.tmp$
+  ^mutt-.+-\d+
+  ^#.*#$
+);
+
+@diff = qw'diff -u';
+
+};
+  close $vvrc;
+}
+
+require $vvrc;
+
+if ($a) {
+
+  $file = realfilename($a);
+  $ofile = "$file~";
+  $bfile = basename($file);
+  $dir = dirname($file);
+  $vdir = "$dir/.versions";
+  $vfile = "$vdir/$bfile";
+  $vfile0 = "$vfile~0~";
+  $vfile1 = "$vfile~1~";
+  $vfile01 = "$vfile~01~";
+
+  # change eugid if root and version directory belongs user
+  my @s = stat($vdir);
+  if ($> == 0 and (not @s or $s[4])) {
+    if (my @s = stat($a)) {
+      $) = $s[5];
+      $> = $s[4];
+    }
+  }
+
+  if ($opt_r ne '.' and not ($opt_M or $opt_L)) {
+    if (not -e $file and -s $vfile) {
+      warn "$0: $a does not exist any more\n";
+      print "found $vfile - recover it? ";
+      $_ = <STDIN>;
+      copy($vfile,$file,'.') if /^y/i;
+      exit 0;
+    }
+    die "$0: $a does not exist\n" unless -e $file;
+    die "$0: $a is not a regular file\n" if -l $file or not -f $file;
+  }
+} else {
+  $file = '*';
+  $vdir = ".versions";
+}
+
+if ($opt_M) {
+  if (-d $opt_M and not -l $opt_M) {
+    my $vvv = "$opt_M/.versions";
+    mkdir $vvv;
+    die "$0: cannot mkdir $vvv - $!\n" unless -d $vvv;
+    opendir $vvv,$vvv or die "$0: cannot opendir $vvv - $!\n";
+    while (my $v = readdir($vvv)) {
+      mv100("$opt_M/$1") if -f "$vvv/$v" and $v =~ /(.+)~1~$/;
+    }
+    close $vvv;
+    $vvv .= "/.versions";
+    unless (-d $vvv) {
+      mkdir $vvv or die "$0: cannot mkdir $vvv - $!\n";
+    }
+    $vvv .= "/n";
+    unlink $vvv;
+    symlink 100,$vvv or die "$0: cannot create $vvv - $!\n";
+  } else {
+    die "usage: $0 -M file\n" if @ARGV or $opt_r;
+    mv100($opt_M);
+  }
+  exit;
+}
+
+if ($opt_L) {
+  if (-d $opt_L and not -l $opt_L) {
+    my $vvv = "$opt_L/.versions";
+    mkdir $vvv;
+    die "$0: cannot mkdir $vvv - $!\n" unless -d $vvv;
+    opendir $vvv,$vvv or die "$0: cannot opendir $vvv - $!\n";
+    while (my $v = readdir($vvv)) {
+      mv10("$opt_L/$1") if -f "$vvv/$v" and $v =~ /(.+)~01~$/;
+    }
+    closedir $vvv;
+    $vvv .= "/.versions";
+    unless (-d $vvv) {
+      mkdir $vvv or die "$0: cannot mkdir $vvv - $!\n";
+    }
+    $vvv .= "/n";
+    unlink $vvv;
+    symlink 10,$vvv or die "$0: cannot create $vvv - $!\n";
+  } else {
+    die "usage: $0 -L file\n" if @ARGV or $opt_r;
+    mv10($opt_L);
+  }
+  exit;
+}
+
+if ($opt_e) {
+  die $usage unless $a;
+  $editor = $ENV{EDITOR} or die "$0: environment variable EDITOR not set\n";
+  system(qw'vv -s',$file) if -f $file; # save current version
+  system($editor,@ARGV,$file); exit $? if $?;
+  unlink $ofile;                       # delete new file~ created by editor
+  system(qw'vv -0',$file);             # post rotating
+  system(qw'vv -b',$file);             # save backup
+  exit;
+}
+
+if ($opt_v) {
+  die "$0: no such file $bfile\n" unless $bfile;
+  if (-f "$vfile~0$opt_v~") { $vfile .= "~0$opt_v~" }
+  else                      { $vfile .= "~$opt_v~" }
+  if (-f $vfile) {
+    if (-t STDOUT) {
+      if (($ENV{EDITOR}||$0) =~ /jed/) {
+        $ENV{JEDINIT} = "SAVE_STATE=0";
+        exec 'jed',$vfile,qw'-tmp -f set_readonly(1)';
+      } elsif ($ENV{PAGER}) {
+        exec $ENV{PAGER},$vfile;
+      } else {
+        exec 'view',$vfile;
+      }
+    } else {
+      exec 'cat',$vfile;
+    }
+  } else {
+    die "$0: no $vfile\n";
+  }
+  exit;
+}
+
+if ($opt_p) {
+  opendir $vdir,$vdir or die "$0: no $vdir\n";
+  while ($vfile = readdir($vdir)) {
+    next unless -f "$vdir/$vfile";
+    $bfile = $vfile;
+    $bfile =~ s/~\d\d?~$//;
+    if (not -f $bfile or -l $bfile) {
+      unlink "$vdir/$vfile";
+      $purge{$bfile}++;
+    }
+  }
+  if (@purge = keys %purge) {
+    foreach $p (@purge) {
+      printf "%2d %s~ purged\n",$purge{$p},$p;
+    }
+  }
+  exit;
+}
+
+if ($opt_m) {
+  migrate('.');
+  exit;
+}
+
+if (length($opt_r)) {
+  die "$0: no such file $bfile\n" unless $bfile;
+  if ($opt_r eq '.') {
+    die "$0: no $vfile\n" unless -f $vfile;
+    copy($vfile,$file,$opt_r);
+  } else {
+    if ($opt_r =~ /^\d$/ and -f "$vfile~0$opt_r~") {
+      $vfile .= "~0$opt_r~"
+    } else {
+      $vfile .= "~$opt_r~"
+    }
+    die "$0: no version $opt_r for $file\n" unless -f $vfile;
+    if ($nfile = shift @ARGV) {
+      copy($vfile,$nfile);
+    } else {
+      copy($file,$vfile0) if mtime($file) > mtime($vfile0);
+      copy($vfile,$file);
+    }
+  }
+  exit;
+}
+
+if (length($opt_d)) {
+  die "$0: no such file $bfile\n" unless $bfile;
+  @diff = qw'diff -u' unless @diff;
+  if ($opt_d =~ /^(\d\d?):(\d\d?)$/) {
+    if (-f "$vdir/$bfile~0$1~" and -f "$vdir/$bfile~0$2~") {
+      exec @diff,"$vdir/$bfile~0$2~","$vdir/$bfile~0$1~"
+    } else {
+      exec @diff,"$vdir/$bfile~$2~","$vdir/$bfile~$1~"
+    }
+  } else {
+    if (-f "$vdir/$bfile~0$opt_d~") {
+      exec @diff,"$vdir/$bfile~0$opt_d~",$file;
+    } else {
+      exec @diff,"$vdir/$bfile~$opt_d~",$file;
+    }
+  }
+  exit $!;
+}
+
+if ($opt_s) {
+  die $usage unless $file;
+  if ($exclude) {
+    $exclude =~ s/^\s+//;
+    $exclude =~ s/\s+$//;
+    $exclude =~ s/\s+/|/g;
+    if ($bfile =~ /$exclude/) {
+      warn "\r\n$0: ignoring $bfile\n";
+      exit;
+    }
+  }
+  unless (-d $vdir) {
+    mkdir $vdir or die "$0: cannot mkdir $vdir - $!\n";
+  }
+  chmod 0777,$vdir if (stat $dir)[2] & 00002;
+
+  # migrate old file~ to versions
+  if (-f $ofile and not -l $ofile and -r $ofile) {
+    $vfn = rotate($vfile);
+    rename($ofile,$vfn);
+  }
+
+  # rotate and save if file has changed
+  if (-f $vfile1) {
+    if (md5f($vfile1) ne md5f($file)) {
+      $vfn = rotate($vfile);
+      copy($file,$vfn);
+    }
+    exit;
+  }
+  # rotate and save if file has changed
+  if (-f $vfile01) {
+    if (md5f($vfile01) ne md5f($file)) {
+      $vfn = rotate($vfile);
+      copy($file,$vfn);
+    }
+    exit;
+  }
+  # save new file
+  if ((readlink("$vdir/.versions/n")||10) == 100) {
+    copy($file,$vfile01);
+  } else {
+    copy($file,$vfile1);
+  }
+  exit;
+}
+
+# backup version
+if ($opt_b) {
+  die $usage unless $file;
+  unless (-d $vdir) {
+    mkdir $vdir or die "\r\n$0: cannot mkdir $vdir - $!\n";
+  }
+  copy($file,$vfile);
+  if ($ENV{VIMRUNTIME}) {
+    print "\n";
+  } else {
+    warn "$file --> $vfile\n" unless $opt_q;
+  }
+  exit;
+}
+
+# special post rotating from -e
+if ($opt_0) {
+  my @sb = stat $file or die "$0: $file - $!\n";
+  if (-f $vfile1) {
+    while (my @sv = stat $vfile1) {
+      # no version change?
+      if ($sb[7] == $sv[7] and $sb[9] == $sv[9]) {
+        # rotate back
+        rb10($vfile);
+      } else {
+        last;
+      }
+    }
+  }
+  if (-f $vfile01) {
+    while (my @sv = stat $vfile01) {
+      # no version change?
+      if ($sb[7] == $sv[7] and $sb[9] == $sv[9]) {
+        # rotate back
+        rb10($vfile);
+      } else {
+        last;
+      }
+    }
+  }
+  exit;
+}
+
+# delete last version, roll back
+if ($opt_D) {
+  die "usage: $0 -D file\n" unless $vfile1 or $vfile01;
+  stat $file or die "$0: $file - $!\n";
+  # 0 version?
+  if (-f $vfile0) {
+    unlink $vfile0;
+  } else {
+    # rotate back
+    rb10($vfile) if -f $vfile1;
+    rb100($vfile) if -f $vfile01;
+  }
+  exec $0,'-l',$file;
+  exit;
+}
+
+# default!
+if ($opt_l) {
+  `stty -a` =~ /columns (\d+)/;
+  $tw = ($1 || 80)-36;
+  if (opendir $vdir,$vdir) {
+    while ($vfile = readdir($vdir)) {
+      if (-f "$vdir/$vfile") {
+        if ($bfile) {
+          if ($vfile =~ /^\Q$bfile\E~(\d\d?)~$/) {
+            push @{$v{$file}},$1;
+          }
+        } else {
+          if ($vfile =~ /^(.+)~(\d\d?)~$/) {
+            push @{$v{$1}},$2;
+          } else {
+            push @{$v{$vfile}},0;
+          }
+        }
+      }
+    }
+    closedir $vdir;
+    $ct = '';
+    foreach $file (sort keys %v) {
+      if (not -f $file or -l $file) {
+        warn "$0: orphaned $file~\n";
+        next;
+      }
+      @v = sort @{$v{$file}};
+      if ($bfile) {
+        @stat = stat $file or die "$0: $file - $!\n";
+        print "version bytes        date time";
+        if (${'opt_+'}) {
+          print "     content";
+          $ct = content($file);
+          $ct =~ s/(.{$tw}).+/$1*/;
+        }
+        print "\n";
+        if (length($v[0]) == 1) { $lf = "%s  %10s  %s %s\n" }
+        else                    { $lf = "%2s %10s  %s %s\n" }
+        printf $lf,'.',size($stat[7]),isodate($stat[9]),$ct;
+        foreach $v (@v) {
+          $vfile = "$vdir/$bfile~$v~";
+          @stat = stat $vfile or next;
+          if (${'opt_+'}) {
+            $ct = content($vfile);
+            $ct =~ s/(.{$tw}).+/$1*/;
+          }
+          printf $lf,int($v),size($stat[7]),isodate($stat[9]),$ct;
+        }
+      } else {
+        my $n = scalar(@v);
+        $n-- if $v[0] == 0; # do not count zero version
+        printf "%d %s\n",$n,$file;
+      }
+    }
+  }
+  exit;
+}
+
+
+sub size {
+  my $s = shift;
+  if    ($s > 9999999999) { $s = int($s/2**30).'G' }
+  elsif ($s > 9999999)    { $s = int($s/2**20).'M' }
+  elsif ($s > 9999)       { $s = int($s/2**10).'k' }
+  return $s;
+}
+
+
+sub content {
+  my $file = shift;
+  my $ct;
+  local $_;
+
+  chomp ($ct = `file $file`);
+  $ct =~ s/.*?: //;
+  $ct =~ s/,.*//;
+
+  if ($ct =~ /text/ and open $file,$file) {
+    read $file,$_,1024;
+    close $file;
+    s/[\x00-\x20]+/ /g;
+    s/^ //;
+    s/ $//;
+    $ct = '"'.$_.'"';
+  }
+
+  return $ct;
+}
+
+
+sub isodate {
+  my @d = localtime shift;
+  return sprintf('%d-%02d-%02d %02d:%02d:%02d',
+                 $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
+}
+
+sub rotate {
+  my $vf = shift; # version base file
+  my $vf1 = "$vf~1~";
+  my $vf01 = "$vf~01~";
+  my ($vfi,$vfn);
+
+  if (-f $vf1) {
+    for (my $i = 8; $i >= 0; $i--) {
+      $vfi = sprintf("%s~%d~",$vf,$i);
+      $vfn = sprintf("%s~%d~",$vf,$i+1);
+      if (-e $vfi) {
+        rename $vfi,$vfn or die "$0: $vfi --> $vfn : $!\n";
+      }
+    }
+    # was there a version 0?
+    if (-e $vf1) {
+      my $bf = $vf;
+      $bf =~ s:/\.versions/:/:;
+      my @sb = stat $bf;
+      my @sv = stat $vf1;
+      # version change? (other size or mtime)
+      if (@sb and @sv and $sb[7] == $sv[7] and $sb[9] == $sv[9]) {
+        # same version
+        unlink $vf1;
+      } else {
+        # other version
+        rotate($vf);
+      }
+    }
+    return "$vf~1~";
+  } elsif (-f $vf01) {
+    for (my $i = 98; $i >= 0; $i--) {
+      $vfi = sprintf("%s~%02d~",$vf,$i);
+      $vfn = sprintf("%s~%02d~",$vf,$i+1);
+      if (-e $vfi) {
+        rename $vfi,$vfn or die "$0: $vfi --> $vfn : $!\n";
+      }
+    }
+    # was there a version 0?
+    if (-e $vf01) {
+      my $bf = $vf;
+      $bf =~ s:/\.versions/:/:;
+      my @sb = stat $bf;
+      my @sv = stat $vf01;
+      # version change? (other size or mtime)
+      if (@sb and @sv and $sb[7] == $sv[7] and $sb[9] == $sv[9]) {
+        # same version
+        unlink $vf01;
+      } else {
+        # other version
+        rotate($vf);
+      }
+    }
+    return "$vf~01~";
+  }
+
+  return "$vf~1~";
+}
+
+sub copy {
+  my ($from,$to,$restore) = @_;
+
+  unless ($restore) {
+    if (-l $file or not -f $file) {
+      die "$0: $file is not a regular file\n";
+    }
+  }
+
+  if (open $to,'>>',$to) {
+    close $to;
+    if (system(qw'rsync -aA',$from,$to) == 0) {
+      if ($ENV{VIMRUNTIME}) {
+        print "\n";
+      } else {
+        warn "$from --> $to\n" unless $opt_q;
+      }
+    } else {
+      exit $?;
+    }
+  } else {
+    die "\r\n$0: cannot write $to - $!\n";
+  }
+}
+
+sub realfilename {
+  my $file = shift;
+
+  return $file unless -e $file;
+
+  if (-l $file) {
+    my $link = readlink($file);
+    if ($link !~ /^\// and $file =~ m:(.*/).:) {
+      $link = $1 . $link;
+    }
+    return realfilename($link);
+  } else {
+    return $file;
+  }
+}
+
+sub migrate {
+  my $dir = shift;
+  my $vdir = "$dir/.versions";
+  my $dfile;
+
+  opendir $dir,$dir or die "$0: cannot read directory $dir - $!\n";
+  while ($file = readdir($dir)) {
+    $dfile = "$dir/$file";
+    next if -l $dfile or $file eq '.' or $file eq '..';
+    if (-d $dfile and $opt_R and $file ne '.versions') {
+      migrate($dfile);
+    } elsif (-f $dfile and $file =~ /~$/) {
+      if (-d $vdir) {
+        for ($i = 8; $i > 0; $i--) {
+          $n = $i+1;
+          rename "$vdir/$file$i~","$vdir/$file$n~";
+        }
+      } else {
+        mkdir $vdir or die "$0: cannot mkdir $vdir - $!\n";
+      }
+      $nfile = sprintf("%s/%s1~",$vdir,$file);
+      rename $dfile,$nfile or die "$0: cannot move $dfile to $nfile - $!\n";
+      warn "$dfile --> $nfile\n" unless $opt_q;
+    }
+  }
+  closedir $dir;
+}
+
+sub mtime {
+  my @s = stat shift;
+  return @s ? $s[9] : 0;
+}
+
+sub md5f {
+  my $file = shift;
+  my $md5 = 0;
+  local $/;
+
+  if (open $file,$file) {
+    $md5 = md5_hex(<$file>);
+    close $file;
+  }
+  return $md5;
+}
+
+
+# if ARGV is empty use last saved file as default file argument
+sub check_ARGV {
+  local $_;
+  local *V;
+
+  if (not @ARGV) {
+    if (-d '.versions' and open V,'ls -at .versions|') {
+      while (<V>) {
+        chomp;
+        if (-f) {
+          close V;
+          s/~\d+~$//;
+          @ARGV = ($_);
+          return;
+        }
+      }
+    }
+  }
+
+}
+
+
+sub mv10 {
+  my $file = shift;
+  my $vfile = dirname($file).'/.versions/'.basename($file);
+
+  die "$0: $file has no extended versions\n" unless -f "$vfile~01~";
+  for (my $i=1; $i<10; $i++) {
+    my $vfile1 = "$vfile~$i~";
+    my $vfile2 = "$vfile~0$i~";
+    if (-f $vfile2) {
+      warn "$vfile2 --> $vfile1\n" unless $opt_q;
+      rename $vfile2,$vfile1 or die "$0: $!\n";
+    }
+  }
+  for (my $i=10; $i<100; $i++) {
+    unlink "$vfile~$i~";
+  }
+}
+
+sub mv100 {
+  my $file = shift;
+  my $vfile = dirname($file).'/.versions/'.basename($file);
+
+  die "$0: $file has already extended versions\n" if -f "$vfile~01~";
+  die "$0: $file has no versions\n" unless -f "$vfile~1~";
+  for (my $i=1; $i<10; $i++) {
+    my $vfile1 = "$vfile~$i~";
+    my $vfile2 = "$vfile~0$i~";
+    if (-f $vfile1) {
+      warn "$vfile1 --> $vfile2\n" unless $opt_q;
+      rename $vfile1,$vfile2 or die "$0: $!\n";
+    }
+  }
+}
+
+
+# rotate back
+sub rb10 {
+  my $vfile = shift;
+
+  for (my $i = 1; $i <= 8; $i++) {
+    my $vfi = sprintf("%s~%d~",$vfile,$i);
+    my $vfn = sprintf("%s~%d~",$vfile,$i+1);
+    if (-f $vfn) {
+      rename $vfn,$vfi;
+    } else {
+      unlink $vfi if $i == 1;
+      last;
+    }
+  }
+}
+
+
+# rotate back
+sub rb100 {
+  my $vfile = shift;
+
+  for (my $i = 1; $i <= 98; $i++) {
+    my $vfi = sprintf("%s~%02d~",$vfile,$i);
+    my $vfn = sprintf("%s~%02d~",$vfile,$i+1);
+    if (-f $vfn) {
+      rename $vfn,$vfi;
+    } else {
+      unlink $vfi if $i == 1;
+      last;
+    }
+  }
+}
+
+
+
+sub pathsearch {
+  my $prg = shift;
+
+  foreach my $dir (split(':',$ENV{PATH})) {
+    return "$dir/$prg" if -x "$dir/$prg";
+  }
+}
+
+
+# zz is the generic clip board program
+#
+# to use zz with vim, write to your .vimrc:
+#
+# noremap <silent> zz> :w !zz<CR><CR>
+# noremap <silent> zz< :r !zz --<CR>
+sub zz {
+  my $bs = 2**16;
+  my $wm = '>';
+  my ($file,$tee,$x);
+
+  if ("@ARGV" =~ /^(-h|--help)$/) {
+    print <<'EOD';
+zz is the generic clip board program. It can hold any data, ASCII or binary.
+The clip board itself is $ZZ (default: $HOME/.zz).
+See also the clip board editor "ezz".
+Limitation: zz does not work across accounts or hosts! Use xx instead.
+
+Options and modes are:
+
+  "zz"              show content of $ZZ
+  "zz file(s)"      copy file(s) content into $ZZ
+  "zz -"            write STDIN (keyboard, mouse buffer) to $ZZ
+  "zz +"            add STDIN (keyboard, mouse buffer) to $ZZ
+  "... | zz"        write STDIN from pipe to $ZZ
+  "... | zz +"      add STDIN from pipe to $ZZ
+  "... | zz -"      write STDIN from pipe to $ZZ and STDOUT
+  "zz | ..."        write $ZZ to pipe
+  "... | zz | ..."  save pipe data to $ZZ (like tee)
+  "zz --"           write $ZZ to STDOUT
+  "zz -v"           show clip board versions (history)
+  "zz -1"           write $ZZ version 1 to STDOUT
+  "zz -9"           write $ZZ version 9 to STDOUT
+
+Examples:
+
+  zz *.txt
+  ls -l | zz
+  zz | wc -l
+  (within vi)   :w !zz
+  (within vi)   :r !zz
+  (within mutt) |zz
+EOD
+    exit;
+  }
+
+  if ("@ARGV" eq '-v') {
+    exec qw'vv -+l',$ZZ;
+  }
+
+  if ("@ARGV" =~ /^-(\d)$/) {
+    exec "vv -v $1 '$ZZ' | cat";
+  }
+
+  # read mode
+  if (-t STDIN and not @ARGV or "@ARGV" eq '--') {
+    exec 'cat',$ZZ;
+  }
+
+  # write mode
+  system "vv -s '$ZZ' >/dev/null 2>&1" if -s $ZZ;
+
+  if (@ARGV and $ARGV[0] eq '+') {
+    shift @ARGV;
+    $wm = '>>';
+  }
+
+  if ("@ARGV" eq '-') {
+    @ARGV = ();
+    $tee = 1 unless -t STDIN;
+  }
+
+ $tee = 1 unless @ARGV or -t STDIN or -t STDOUT;
+ $bs = 2**12 if $tee;
+
+  open $ZZ,$wm,$ZZ or die "$0: cannot write $ZZ - $!\n";
+
+  if (@ARGV) {
+    while ($file = shift @ARGV) {
+      if (-f $file) {
+        if (open $file,$file) {
+          while (read($file,$x,$bs)) {
+            my $s = syswrite $ZZ,$x;
+            defined($s) or die "$0: cannot write to $ZZ - $!\n";
+          }
+          close $file;
+        } else {
+          warn "$0: cannot read $file - $!\n";
+        }
+      } elsif (-e $file) {
+        warn "$0: $file is not a regular file\n";
+      } else {
+        warn "$0: $file does not exist\n";
+      }
+    }
+    close $ZZ;
+    $ZZ1 = $ZZ.'~1~';
+    $ZZ1 =~ s:(.*)/(.*):$1/.versions/$2:;
+    if (-e $ZZ and not -s $ZZ and -s $ZZ1 ) {
+      system qw'rsync -aA',$ZZ1,$ZZ;
+    }
+  } else {
+    while (read(STDIN,$x,$bs)) {
+      syswrite $ZZ,$x;
+      syswrite STDOUT,$x if $tee;
+    }
+  }
+
+  exit;
+}
+
+
+sub ezz {
+  my $bs = 2**16;
+  my $wm = '>';
+  my $editor = $ENV{EDITOR} || 'vi';
+  my ($out,$file,$x);
+
+  $ENV{JEDINIT} = "SAVE_STATE=0";
+
+  if ("@ARGV" =~ /^(-h|--help)$/) {
+    print <<'EOD';
+ezz is the edit helper for the zz clip board program.
+The clip board itself is $ZZ (default: $HOME/.zz).
+
+Options and modes are:
+
+  "ezz"                    edit $ZZ with $EDITOR
+  "... | ezz"              write STDIN from pipe to $ZZ and call $EDITOR
+  "... | ezz +"            add STDIN from pipe to $ZZ and call $EDITOR
+  "ezz 'perl commands'"    execute perl commands on $ZZ
+  "ezz - 'perl commands'"  execute perl commands on $ZZ and show result
+  "ezz filter [args]"      run filter [with args] on $ZZ
+  "ezz - filter [args]"    run filter [with args] on $ZZ and show result
 
 Examples:
 
   ls -l | ezz
 
 Examples:
 
   ls -l | ezz
-  ezz "s/ /_/g"
+  ezz 's/ /_/g'
   ezz head -3
   ezz - head -3
   ezz head -3
   ezz - head -3
-
-Limitation: zz does not work across different accounts!
 EOD
 EOD
+    exit;
+  }
+
+  system "vv -s '$ZZ' >/dev/null 2>&1" if -s $ZZ;
+
+  unless (-t STDIN) {
+    if ("@ARGV" eq '+') {
+      @ARGV = ();
+      $wm = '>>';
+    }
+    open $ZZ,$wm,$ZZ or die "$0: cannot write $ZZ - $!\n";
+    syswrite $ZZ,$x while read(STDIN,$x,$bs);
+    close $ZZ;
+  }
+
+  if (@ARGV) {
+    $out = shift @ARGV if $ARGV[0] eq '-';
+    $cmd = shift @ARGV or exec 'cat',$ZZ;
+    rename $ZZ,"$ZZ~" or die "$0: cannot move $ZZ to $ZZ~ - $!\n";
+    $cmd = quotemeta $cmd;
+    @ARGV = map { quotemeta } @ARGV;
+    if (pathsearch($cmd)) {
+      system "$cmd @ARGV <'$ZZ~'>'$ZZ'";
+    } else {
+      system "perl -pe $cmd @ARGV <'$ZZ~'>'$ZZ'";
+    }
+    if ($? == 0) { unlink "$ZZ~" }
+    else         { rename "$ZZ~",$ZZ }
+    exec 'cat',$ZZ if $out;
+  } else {
+    exec $editor,$ZZ;
+  }
+  exit;
 }
 
 }
 
-JEDINIT="SAVE_STATE=0"; export JEDINIT
-
-if [ ! -t 0 ]; then
-  if [ x"$1"x = x+x ]; then
-    shift
-    cat >>$ZZ
-  else
-    cat >$ZZ
-  fi
-fi
-
-test -z "$1" && exec ${EDITOR:-vi} $ZZ
-
-case "X$*" in
-  X-h) usage;;
-  X-r) exec mv $ZZ~ $ZZ;;
-esac
-
-OUT="$1"
-test "X$OUT" = X- && shift
-test -z "$1" && exec cat $ZZ
-mv $ZZ $ZZ~
-case `type "$1" 2>&1` in
-  *not\ found) perl -pe "$@" <$ZZ~>$ZZ || mv $ZZ~ $ZZ;;
-            *) "$@"          <$ZZ~>$ZZ || mv $ZZ~ $ZZ;;
-esac
-test "X$OUT" = X- && exec cat $ZZ
+
+sub install {
+  my ($dir);
+  local $| = 1;
+
+  print "Installation directory: ";
+  $dir = <STDIN>||'';
+  chomp $dir;
+  $dir =~ s:/+$::;
+  $dir ||= '.';
+  if ($dir eq '.') {
+    unlink qw'zz ezz vv';
+    link $prg,'zz'   or die "$0: cannot create zz - $!\n";
+    link $prg,'ezz'  or die "$0: cannot create ezz - $!\n";
+    rename $prg,'vv' or die "$0: cannot create vv - $!\n";
+  } else {
+    die "$0: $dir does not exist\n"     unless -e $dir;
+    die "$0: $dir is not a directory\n" unless -d $dir;
+    die "$0: $dir is not writable\n"    unless -w $dir;
+    chdir $dir or die "$0: cannot cd $dir - $!\n";
+    unlink qw'zz ezz vv';
+    system qw'rsync -a',$prg,'vv';
+    exit $? if $?;
+    link 'vv','zz'  or die "$0: cannot create $dir/zz - $!\n";
+    link 'vv','ezz' or die "$0: cannot create $dir/ezz - $!\n";
+  }
+  print "Installation completed. See:\n";
+  print "\t$dir/vv -h\n";
+  print "\t$dir/zz -h\n";
+  print "\t$dir/ezz -h\n";
+  exit;
+}
diff --git a/bin/fbm b/bin/fbm
index 1d9c10d4f5e40a091edaddf38203a71192db5415..e6d81aaddf28f7cfdb4bfd85345420430d89ebed 100755 (executable)
--- a/bin/fbm
+++ b/bin/fbm
@@ -20,7 +20,7 @@ use constant M => 2**20;
 
 our ($SH,$windoof,$sigpipe,$useragent);
 our ($FEXSERVER);
 
 our ($SH,$windoof,$sigpipe,$useragent);
 our ($FEXSERVER);
-our $version = 20160328;
+our $version = 20160919;
 
 # server defaults
 my $server = 'fex.rus.uni-stuttgart.de';
 
 # server defaults
 my $server = 'fex.rus.uni-stuttgart.de';
index 1d87dcfe9e59cfc861cd6767f22fb3ce836d84e1..1f38d6b42b5bc975b692e76d026a09afacf8779b 100755 (executable)
@@ -41,7 +41,8 @@ our ($FEXHOME);
 our ($spooldir,@logdir,$docdir);
 our ($akeydir,$ukeydir,$dkeydir,$skeydir,$gkeydir,$xkeydir,$lockdir);
 our ($durl,$debug,$autodelete,$hostname,$admin,$admin_pw,$bcc);
 our ($spooldir,@logdir,$docdir);
 our ($akeydir,$ukeydir,$dkeydir,$skeydir,$gkeydir,$xkeydir,$lockdir);
 our ($durl,$debug,$autodelete,$hostname,$admin,$admin_pw,$bcc);
-$keep_default = 5;
+our $keep_default = 5;
+our $purge = $keep_default*3;
 
 # load common code, local config : $HOME/lib/fex.ph
 require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
 
 # load common code, local config : $HOME/lib/fex.ph
 require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
@@ -418,8 +419,9 @@ exit;
 sub cleanup {
   my ($to,$from,$file) = @_;
   my ($data,$download,$notify,$mtime,$warn,$dir,$filename,$dkey,$delay);
 sub cleanup {
   my ($to,$from,$file) = @_;
   my ($data,$download,$notify,$mtime,$warn,$dir,$filename,$dkey,$delay);
-  my $comment = '';
   my $keep = $keep_default;
   my $keep = $keep_default;
+  my $purge = $::purge || 3*$keep;
+  my $comment = '';
   my $kf = "$to/$from/$file/keep";
   my $ef = "$to/$from/$file/error";
   local $_;
   my $kf = "$to/$from/$file/keep";
   my $ef = "$to/$from/$file/error";
   local $_;
@@ -440,8 +442,9 @@ sub cleanup {
         logdel($file,"$file deleted");
       }
     } elsif ($mtime = lmtime("$file/error")) {
         logdel($file,"$file deleted");
       }
     } elsif ($mtime = lmtime("$file/error")) {
-      if ($today > 3*$keep*DS+$mtime) {
-        verbose("rmrf $file (today=$today mtime_error=$mtime keep=$keep)");
+      $purge = $1*$keep if $purge =~ /(\d+).*keep/;
+      if ($today > $purge*DS+$mtime) {
+        verbose("rmrf $file (today=$today mtime_error=$mtime keep=$keep purge=$purge)");
         logdel($file,"$file deleted");
       }
     } else {
         logdel($file,"$file deleted");
       }
     } else {
index b0616a16fe5653e4d7830bb24116f34b6d2e30c6..3ac605f51f571676dad713d63bb88a2b7d74751e 100755 (executable)
@@ -13,6 +13,7 @@ use strict qw'vars subs';
 use Config;
 use POSIX;
 use Encode;
 use Config;
 use POSIX;
 use Encode;
+use Cwd 'abs_path';
 use Getopt::Std;
 use File::Basename;
 use Socket;
 use Getopt::Std;
 use File::Basename;
 use Socket;
@@ -30,7 +31,7 @@ our $SH;
 our ($fexhome,$idf,$tmpdir,$windoof,$useragent);
 our ($xv,%autoview);
 our $bs = 2**16; # blocksize for tcp-reading and writing file
 our ($fexhome,$idf,$tmpdir,$windoof,$useragent);
 our ($xv,%autoview);
 our $bs = 2**16; # blocksize for tcp-reading and writing file
-our $version = 20160328;
+our $version = 20160919;
 our $CTYPE = 'ISO-8859-1';
 our $fexsend = $ENV{FEXSEND} || 'fexsend';
 our $DEBUG = $ENV{DEBUG};
 our $CTYPE = 'ISO-8859-1';
 our $fexsend = $ENV{FEXSEND} || 'fexsend';
 our $DEBUG = $ENV{DEBUG};
@@ -89,6 +90,7 @@ usage: $0 [-v] [-m limit] [-s filename] [-o] [-k] [-X] [-P proxy:port] F*EX-URL(
    or: $0 [-v] -a
    or: $0 -l [-i tag]
    or: $0 -H
    or: $0 [-v] -a
    or: $0 -l [-i tag]
    or: $0 -H
+   or: $0 -V
 options: -v verbose mode
          -m limit kB/s
          -s save to filename (-s- means: write to STDOUT/pipe)
 options: -v verbose mode
          -m limit kB/s
          -s save to filename (-s- means: write to STDOUT/pipe)
@@ -102,6 +104,7 @@ options: -v verbose mode
          -i tag alternate server/account, see: $fexsend -h
          -P use Proxy for connection to the F*EX server
          -H show hints and examples
          -i tag alternate server/account, see: $fexsend -h
          -P use Proxy for connection to the F*EX server
          -H show hints and examples
+         -V show version and ask for upgrade
 argument: F*EX-URL may be file number (see: $0 -l)
 EOD
 
 argument: F*EX-URL may be file number (see: $0 -l)
 EOD
 
@@ -167,10 +170,15 @@ if ($opt_V) {
     $_ = <STDIN>||'';
     if (/^y/i) {
       my $new = `wget -nv -O- http://fex.belwue.de/download/fexget`;
     $_ = <STDIN>||'';
     if (/^y/i) {
       my $new = `wget -nv -O- http://fex.belwue.de/download/fexget`;
-      if ($new !~ /upgrade fexget/) {
+      my $newversion = $1 if $new =~ /version = (\d+)/;
+      if ($new !~ /upgrade fexget/ or not $newversion) {
         die "$0: bad update\n";
       }
         die "$0: bad update\n";
       }
-      system qw'cp -a',$_0,$_0.'_old';
+      if ($newversion <= $version) {
+        die "$0: no newer version\n";
+      }
+      $_0 = abs_path($_0);
+      system qw'rsync -a',$_0,$_0.'_old';
       exit $? if $?;
       open $_0,'>',$_0 or die "$0: cannot write $_0. - $!\n";
       print {$_0} $new;
       exit $? if $?;
       open $_0,'>',$_0 or die "$0: cannot write $_0. - $!\n";
       print {$_0} $new;
@@ -178,6 +186,7 @@ if ($opt_V) {
       exec $_0,qw'-V .';
     }
   }
       exec $_0,qw'-V .';
     }
   }
+  exit;
   exit if "@ARGV" eq '.';
 }
 
   exit if "@ARGV" eq '.';
 }
 
@@ -328,7 +337,7 @@ URL: foreach my $url (@ARGV) {
       ($file) = grep { $_ = $1 if /^X-File:\s+(.+)/ } @r;
       $file = $url unless $file;
       $file =~ s:.*/::;
       ($file) = grep { $_ = $1 if /^X-File:\s+(.+)/ } @r;
       $file = $url unless $file;
       $file =~ s:.*/::;
-      printf "%s deleted\n",urldecode($file);
+      printf "%s deleted\n",locale(decode_utf8(urldecode($file)));
     } else {
       s:HTTP/[\d\. ]+::;
       die "$0: server response: $_";
     } else {
       s:HTTP/[\d\. ]+::;
       die "$0: server response: $_";
index f47bed4cc3ac51705665a63ee0d07a5b8e2f353a..fae77e9b79e977a1819e98b9345ea3e6fa54de3f 100755 (executable)
@@ -17,10 +17,10 @@ use IO::Handle;
 use IO::Socket::INET;
 use Getopt::Std;
 use File::Basename;
 use IO::Socket::INET;
 use Getopt::Std;
 use File::Basename;
-use Cwd qw'abs_path';
+use Cwd 'abs_path';
 use Fcntl qw':flock :mode';
 use Fcntl qw':flock :mode';
-use Digest::MD5 qw'md5_hex';  # encrypted ID / SID
-use Time::HiRes qw'time';
+use Digest::MD5 'md5_hex';  # encrypted ID / SID
+use Time::HiRes 'time';
 # use Smart::Comments;
 use constant k => 2**10;
 use constant M => 2**20;
 # use Smart::Comments;
 use constant k => 2**10;
 use constant M => 2**20;
@@ -37,7 +37,7 @@ our ($tpid,$frecipient);
 our ($FEXID,$FEXXX,$HOME);
 our (%alias);
 our $chunksize = 0;
 our ($FEXID,$FEXXX,$HOME);
 our (%alias);
 our $chunksize = 0;
-our $version = 20160328;
+our $version = 20160919;
 our $_0 = $0;
 our $DEBUG = $ENV{DEBUG};
 
 our $_0 = $0;
 our $DEBUG = $ENV{DEBUG};
 
@@ -248,6 +248,14 @@ Partner program xx is an internet clipboard. See: xx -h
 
 Partner program fexget is for downloading. See: fexget -h
 
 
 Partner program fexget is for downloading. See: fexget -h
 
+fexsend stores the login data (server, user and auth-ID) in the file
+$HOME/.fex/id
+The format of this file is ([data] is optional):
+
+server-URL[!proxy[:port[:chunk-size]]
+e-mail-address
+auth-ID
+
 For temporary usage of a HTTP proxy use:
   $0 -P your_proxy:port:chunksize_in_MB file recipient
 Example:
 For temporary usage of a HTTP proxy use:
   $0 -P your_proxy:port:chunksize_in_MB file recipient
 Example:
@@ -361,10 +369,15 @@ if ($xx) {
       $_ = <STDIN>||'';
       if (/^y/i) {
         my $new = `wget -nv -O- http://fex.belwue.de/download/fexsend`;
       $_ = <STDIN>||'';
       if (/^y/i) {
         my $new = `wget -nv -O- http://fex.belwue.de/download/fexsend`;
-        if ($new !~ /upgrade fexsend/) {
+        my $newversion = $1 if $new =~ /version = (\d+)/;
+        if ($new !~ /upgrade fexsend/ or not $newversion) {
           die "$0: bad update\n";
         }
           die "$0: bad update\n";
         }
-        system qw'cp -aL',$_0,$_0.'_old';
+        if ($newversion <= $version) {
+          die "$0: no newer version\n";
+        }
+        $_0 = abs_path($_0);
+        system qw'rsync -a',$_0,$_0.'_old';
         exit $? if $?;
         open $_0,'>',$_0 or die "$0: cannot write $_0. - $!\n";
         print {$_0} $new;
         exit $? if $?;
         open $_0,'>',$_0 or die "$0: cannot write $_0. - $!\n";
         print {$_0} $new;
@@ -372,6 +385,7 @@ if ($xx) {
         exec $_0,qw'-V .';
       }
     }
         exec $_0,qw'-V .';
       }
     }
+    exit;
     exit if "@ARGV" eq '.';
   }
 
     exit if "@ARGV" eq '.';
   }
 
@@ -3206,9 +3220,10 @@ sub query_sid {
   $sid = $id;
 
   if ($port eq 443 or $proxy) {
   $sid = $id;
 
   if ($port eq 443 or $proxy) {
+    return if $opt_d;
     return if $features;    # early return if we know enough
     return if $features;    # early return if we know enough
-    $req = "OPTIONS /FEX HTTP/1.1";
-    $req = "HEAD /index.html HTTP/1.1";
+    $req = "OPTIONS /FEX HTTP/1.1"; # does not work with (some) proxies
+    $req = "GET /SID HTTP/1.1";     # needed as FEATURES query
   } else {
     $req = "GET /SID HTTP/1.1";
   }
   } else {
     $req = "GET /SID HTTP/1.1";
   }
@@ -3469,7 +3484,8 @@ sub readahead {
 
 sub fileid {
   my $file = shift;
 
 sub fileid {
   my $file = shift;
-  my @s = stat($file);
+  my $dirmode = shift;
+  my @s = $dirmode ? lstat($file) : stat($file);
 
   if (@s) {
     return md5_hex($file.$s[0].$s[1].$s[7].$s[9]);
 
   if (@s) {
     return md5_hex($file.$s[0].$s[1].$s[7].$s[9]);
@@ -3528,6 +3544,9 @@ sub fmd {
           next if $file eq '..';
           if ($file eq '.') {
             $fmd .= fileid($dir);
           next if $file eq '..';
           if ($file eq '.') {
             $fmd .= fileid($dir);
+          } elsif (-l "$dir/$file") {
+            # hack for dangling symlinks: do not raise an error
+            $fmd .= fileid("$dir/$file",'dirmode');
           } else {
             $fmd .= fmd("$dir/$file");
           }
           } else {
             $fmd .= fmd("$dir/$file");
           }
index 8bef7fc65fb91fa7dd7018f7f97a7fec586127f7..2843167ad78c4327b0806e8a9d626b71e667750b 100755 (executable)
@@ -15,6 +15,7 @@ BEGIN {
   # stunnel workaround
   $SIG{CHLD} = "DEFAULT";
   $ENV{PERLINIT} = q{
   # stunnel workaround
   $SIG{CHLD} = "DEFAULT";
   $ENV{PERLINIT} = q{
+    $ENV{LC_ALL} = 'en_US.UTF-8';
     unshift @INC,(getpwuid($<))[7].'/perl';
     # web error handler
     $SIG{__DIE__} = $SIG{__WARN__} = sub {
     unshift @INC,(getpwuid($<))[7].'/perl';
     # web error handler
     $SIG{__DIE__} = $SIG{__WARN__} = sub {
@@ -92,7 +93,7 @@ foreach my $lib (
 # import from fex.pp
 our ($hostname,$debug,$timeout,$max_error,$max_error_handler);
 our ($spooldir,@logdir,$docdir,$xkeydir,$akeydir,$lockdir);
 # import from fex.pp
 our ($hostname,$debug,$timeout,$max_error,$max_error_handler);
 our ($spooldir,@logdir,$docdir,$xkeydir,$akeydir,$lockdir);
-our ($force_https,$default_locale,$bs,$MB,$adlm);
+our ($force_https,$default_locale,$bs,$MB,$adlm,@forbidden_user_agents);
 our (@locales);
 
 # load common code (local config: $FEXHOME/lib/fex.ph)
 our (@locales);
 
 # load common code (local config: $FEXHOME/lib/fex.ph)
@@ -144,7 +145,7 @@ else {
   if ($ssl_ra) {
     $ENV{PROTO} = 'https';
     $ENV{REMOTE_ADDR} = $ra = $ssl_ra;
   if ($ssl_ra) {
     $ENV{PROTO} = 'https';
     $ENV{REMOTE_ADDR} = $ra = $ssl_ra;
-    if ($ssl_ra =~ /\w:\w/) {
+    if ($ssl_ra =~ /[\w:]:\w/) {
       # ($rh) = `host $ssl_ra 2>/dev/null` =~ /name pointer (.+)\.$/;
       $^W = 0; eval 'use Socket6'; $^W = 1;
       http_error(503) if $@;
       # ($rh) = `host $ssl_ra 2>/dev/null` =~ /name pointer (.+)\.$/;
       $^W = 0; eval 'use Socket6'; $^W = 1;
       http_error(503) if $@;
@@ -368,6 +369,8 @@ REQUEST: while (*STDIN) {
     if ($uri =~ /\\|%5c/i) { badchar("\\") }
   }
 
     if ($uri =~ /\\|%5c/i) { badchar("\\") }
   }
 
+  my $fua = join('|',@forbidden_user_agents);
+
   while ($_ = shift @header) {
 
     # header inquisition!
   while ($_ = shift @header) {
 
     # header inquisition!
@@ -381,12 +384,8 @@ REQUEST: while (*STDIN) {
       exit;
     }
 
       exit;
     }
 
-    if ($header =~ /\nRange:/ and /^User-Agent: (FDM)/) {
-      disconnect($1,"499 Download Manager $1 Not Supported",30);
-    }
-
-    if (/^User-Agent: (Java\/[\d\.]+)/) {
-      disconnect($1,"499 User-Agent $1 Not Supported",30);
+    if ($fua and /^User-Agent: ($fua)/) {
+      disconnect($1,"499 User Agent $1 Not Supported",30);
     }
 
     if (/^Range:.*,/) {
     }
 
     if (/^Range:.*,/) {
@@ -436,7 +435,7 @@ REQUEST: while (*STDIN) {
     }
 
     # HTTP header ==> environment variables
     }
 
     # HTTP header ==> environment variables
-    if (/^([\w\-]+):\s*(.+)/s) {
+    if (/^([\w\-_]+):\s*(.+)/s) {
       $http_var = $1;
       $http_val = $2;
       $http_var =~ s/-/_/g;
       $http_var = $1;
       $http_val = $2;
       $http_var =~ s/-/_/g;
@@ -448,7 +447,10 @@ REQUEST: while (*STDIN) {
       } else {
         $http_val =~ s/\s+/ /g;
         if ($http_var =~ /^HTTP_(HOST|VERSION)$/) {
       } else {
         $http_val =~ s/\s+/ /g;
         if ($http_var =~ /^HTTP_(HOST|VERSION)$/) {
-          $http_var = 'X-'.$http_var;
+          $http_var = 'HTTP_X_'.$1;
+        } elsif ($http_var =~ /^PROXY/) {
+          # http://cert.at/warnings/all/20160718.html
+          $http_var = 'HTTP_X_'.$http_var;
         } elsif ($http_var !~ /^CONTENT_/) {
           $http_var = 'HTTP_'.$http_var;
         }
         } elsif ($http_var !~ /^CONTENT_/) {
           $http_var = 'HTTP_'.$http_var;
         }
diff --git a/bin/fpg b/bin/fpg
index 5f2f7511734dce91bb76771ac19448539778be3e..7e616bd6288f330323e9c057dfacd8ea44642e5c 100755 (executable)
--- a/bin/fpg
+++ b/bin/fpg
@@ -2,7 +2,7 @@
 #
 # Programname:                 fpg - Frams' Perl grep
 # Author:                      framstag@rus.uni-stuttgart.de
 #
 # Programname:                 fpg - Frams' Perl grep
 # Author:                      framstag@rus.uni-stuttgart.de
-# Copyright:                   GPL
+# Licence:                     Perl Artistic
 #
 # History:
 #   2003-02-27 Framstag                initial version
 #
 # History:
 #   2003-02-27 Framstag                initial version
 #                               -n ==> -S, new -n option
 #   2008-10-14 Framstag                added option -M
 #   2008-11-23 Framstag                added option -~
 #                               -n ==> -S, new -n option
 #   2008-10-14 Framstag                added option -M
 #   2008-11-23 Framstag                added option -~
+#   2016-06-12 Framstag                option -o respects (match)
 
 use Getopt::Std;
 use Term::ReadLine;
 use locale;
 
 
 use Getopt::Std;
 use Term::ReadLine;
 use locale;
 
-sub usage {
-  die <<EOD
+$0 =~ s:.*/::;
+$| = 1;
+
+$usage  = <<EOD;
 usage: $0 [options] 'EXP' [file...]
    or: $0 [options] -Q file...
 options: -r        recursively scan through directories
 usage: $0 [options] 'EXP' [file...]
    or: $0 [options] -Q file...
 options: -r        recursively scan through directories
@@ -35,7 +38,7 @@ options: -r        recursively scan through directories
         -l        list filenames only
         -L        list filenames only that do NOT match
         -p        show paragraphs, not lines (multiline record separator)
         -l        list filenames only
         -L        list filenames only that do NOT match
         -p        show paragraphs, not lines (multiline record separator)
-        -o        show only matched strings, not whole lines
+        -o        show only matched strings (in parenthesis), not whole lines
         -M        mail-mode: search and show complete mails from mbox files
         -c        print (count) only number of matches (NOT LINES!)
         -F        EXP is a string, not a Perl regular expression
         -M        mail-mode: search and show complete mails from mbox files
         -c        print (count) only number of matches (NOT LINES!)
         -F        EXP is a string, not a Perl regular expression
@@ -53,10 +56,7 @@ EOD
 #examples: $0 -r 'from.*STDIN' *
 #          $0 -e 'length>30 and not /\\w/' script
 #See "perldoc perlre" for help on regular expressions.
 #examples: $0 -r 'from.*STDIN' *
 #          $0 -e 'length>30 and not /\\w/' script
 #See "perldoc perlre" for help on regular expressions.
-}
 
 
-$0 =~ s:.*/::;
-$| = 1;
 
 $maxlen = 0;
 
 
 $maxlen = 0;
 
@@ -67,10 +67,15 @@ $opt_S = 4;
 $opt_x = $opt_X = '';
 $opt_R = "\n";
 
 $opt_x = $opt_X = '';
 $opt_R = "\n";
 
-usage() if !getopts('hirvlLFMopscQen~S:R:C:x:X:') or $opt_h and not @ARGV;
+getopts('hirvlLFMopscQen~S:R:C:x:X:') or die $usage;
+
+if ($opt_h) {
+  print $usage;
+  exit;
+}
 
 unless ($opt_Q) {
 
 unless ($opt_Q) {
-  $exp = shift or usage();
+  $exp = shift or die $usage;
 }
 
 if ($opt_C and ($opt_l or $opt_L or $opt_s or $opt_v or $opt_p or $opt_M)) {
 }
 
 if ($opt_C and ($opt_l or $opt_L or $opt_s or $opt_v or $opt_p or $opt_M)) {
@@ -129,7 +134,7 @@ sub scan {
   } else {
     $exp =~ s/([\@\$\%\^\&\*\(\)\+\[\]\{\}\\\|\.\?])/\\$1/g if $opt_F;
     $exp = '(?i)'.$exp if $opt_i;
   } else {
     $exp =~ s/([\@\$\%\^\&\*\(\)\+\[\]\{\}\\\|\.\?])/\\$1/g if $opt_F;
     $exp = '(?i)'.$exp if $opt_i;
-    $exp = '(?s)'.$exp if $opt_p or $opt_R;
+    $exp = '(?s)'.$exp if $opt_p or $opt_R ne "\n";
     #? $exp =~ s/\.\*\*/[.\n]*/g;
   }
 
     #? $exp =~ s/\.\*\*/[.\n]*/g;
   }
 
@@ -277,12 +282,19 @@ sub grepf {
           else       { $n++ while /$exp/omg }
         } else {
           if ($opt_o) {
           else       { $n++ while /$exp/omg }
         } else {
           if ($opt_o) {
-            my $m = '';
-            while (s/($exp)//) {
-              $n++;
-              $m .= "$1\n";
+            if ($exp =~ /\([^?]+\)/) {
+              if (/$exp/) {
+                $n++;
+                $_ = "$1\n";
+              }
+            } else {
+              my $m = '';
+              while (s/($exp)//) {
+                $n++;
+                $m .= "$1\n";
+              }
+              $_ = $m;
             }
             }
-            $_ = $m;
           } elsif ($opt_Q) {
             $n += s/($exp)/$B$1$N/mg;
           } else {
           } elsif ($opt_Q) {
             $n += s/($exp)/$B$1$N/mg;
           } else {
diff --git a/bin/l b/bin/l
index affd4a21f93475d1a0a24e24c4aaf7016bce703e..203e3101069f1976ca9261f8a180ba2bfdaa28c2 100755 (executable)
--- a/bin/l
+++ b/bin/l
@@ -13,7 +13,7 @@ use Getopt::Std;
 # the name of the game
 $0 =~ s:.*/::;
 
 # the name of the game
 $0 =~ s:.*/::;
 
-$ENV{LC_CTYPE} = 'C';
+$ENV{LC_ALL} = 'C';
 
 # unshift @ARGV,split /\s+/,$ENV{'l_opt'} if $ENV{'l_opt'};
 
 
 # unshift @ARGV,split /\s+/,$ENV{'l_opt'} if $ENV{'l_opt'};
 
@@ -32,9 +32,20 @@ $opt_l = 1                            if $0 eq 'll';
 $opt_l = $opt_i = $opt_a = $opt_S = 1 if $0 eq 'lll';
 &examples if $opt_E;
 if ($0 eq 'lf' or $0 eq 'llf') {
 $opt_l = $opt_i = $opt_a = $opt_S = 1 if $0 eq 'lll';
 &examples if $opt_E;
 if ($0 eq 'lf' or $0 eq 'llf') {
-  $opt_F ||= shift or usage(1);
-  $opt_R ||= scalar(@ARGV) || ($opt_F eq '.');
-  $opt_l ||= $0 eq 'llf';
+  $opt_l = $0 eq 'llf';
+  if (scalar(@ARGV) == 0) {
+    die usage(1);
+  } elsif (scalar(@ARGV) == 1) {
+    $opt_F = shift;
+    $opt_R = $opt_F if $opt_F eq '.';
+  } elsif (-d $ARGV[-1]) {
+    $opt_R = pop(@ARGV);
+    $opt_F = join('|',@ARGV);
+  } else {
+    $opt_F = join('|',@ARGV);
+  }
+  @ARGV = ();
+  @ARGV = ($opt_R) if -d $opt_R;
 }
 
 $postsort = $opt_t||$opt_s;
 }
 
 $postsort = $opt_t||$opt_s;
@@ -138,6 +149,8 @@ sub collect {
   my @files = @_;
   my $f;
 
   my @files = @_;
   my $f;
 
+  getacl(@files) if $opt_l and not $opt_n;
+
   # loop over all argument files/directories
   foreach $f (@files) {
 
   # loop over all argument files/directories
   foreach $f (@files) {
 
@@ -175,8 +188,8 @@ sub collect {
       $f =~ s:/$:: if $opt_d;
 
       # on trailing / list subdirs, too
       $f =~ s:/$:: if $opt_d;
 
       # on trailing / list subdirs, too
-      if ($f =~ m:/$:) { &list(&getfiles($f)) }
-      elsif ($f eq '') { &list('/') }
+      if ($f =~ m:/$:) { list(getfiles($f)) }
+      elsif ($f eq '') { list('/') }
       else {
         if ($opt_L) {
           unless (-e $f) {
       else {
         if ($opt_L) {
           unless (-e $f) {
@@ -262,6 +275,8 @@ sub list {
            elsif ($i eq 'a') { $line .= sprintf '%10s %10s %10s ',
                                         $dates{'a'},$dates{'m'},$dates{'c'} }
          } else {
            elsif ($i eq 'a') { $line .= sprintf '%10s %10s %10s ',
                                         $dates{'a'},$dates{'m'},$dates{'c'} }
          } else {
+            # $mode =~ s/(....)(...)/sprintf($1.uc($2))/e if $ACL{$file};
+            substr($mode,4,3) = uc(substr($mode,4,3)) if $ACL{$file};
            if    ($i eq 'm') { $line .= $mode.' ' }
            elsif ($i eq 'u') { $line .= sprintf '%-8s ',  $uid }
            elsif ($i eq 'g') { $line .= sprintf '%-8s ',  $gid }
            if    ($i eq 'm') { $line .= $mode.' ' }
            elsif ($i eq 'u') { $line .= sprintf '%-8s ',  $uid }
            elsif ($i eq 'g') { $line .= sprintf '%-8s ',  $gid }
@@ -283,15 +298,22 @@ sub list {
       } else {
 
        if ($opt_n) {
       } else {
 
        if ($opt_n) {
-          if ($opt_l) { $line .= sprintf "%06o %6d %6d $z%15s %10d ",
-                                        $mode,$uid,$gid,$size,$date }
-          else        { $line .= sprintf "%06o $z%15s %10d ",
-                                        $mode,$size,$date }
+          if ($opt_l) {
+            $line .= sprintf "%06o %6d %6d $z%15s %10d ",
+                            $mode,$uid,$gid,$size,$date;
+          } else {
+            $line .= sprintf "%06o $z%15s %10d ",$mode,$size,$date;
+          }
        } else {
        } else {
-          if ($opt_l) { $line .= sprintf "%s %-8s %-8s $z%19s %s ",
-                                        $mode,$uid,$gid,$size,$date }
-          else        { $line .= sprintf "%s $z%19s %s ",
-                                        $mode,$size,substr($date,0,-3) }
+          if ($opt_l) {
+            # $mode .= $ACL{$file} ? '+' : ' ';
+            # $mode =~ s/(....)(...)/sprintf($1.uc($2))/e if $ACL{$file};
+            substr($mode,4,3) = uc(substr($mode,4,3)) if $ACL{$file};
+            $line .= sprintf "%s %-8s %-8s $z%19s %s ",
+                             $mode,$uid,$gid,$size,$date;
+          } else {
+            $line .= sprintf "%s $z%19s %s ",$mode,$size,substr($date,0,-3);
+          }
         }
 
        if ($opt_i)   { $line .= sprintf '%3s %10s ',$links,$inode }
         }
 
        if ($opt_i)   { $line .= sprintf '%3s %10s ',$links,$inode }
@@ -375,13 +397,14 @@ sub info {
         substr($mode,8,1) =~ tr/-x/Tt/ if -k _;
         $mode = $type.$mode;
       } else {
         substr($mode,8,1) =~ tr/-x/Tt/ if -k _;
         $mode = $type.$mode;
       } else {
-        # with short list display only effektive file access modes
+        # with short list display only effective file access modes
+        use filetest 'access'; # respect ACLs ==> cannot use pseudofile _
         $mode = $type
         $mode = $type
-               . (-r _ ? 'R' : '-')
-                . (-w _ ? 'W' : '-')
-                . (-x _ ? 'X' : '-');
-        substr($mode,2,1) =~ tr/-x/Ss/ if -u _ or -g _;
-        substr($mode,3,1) =~ tr/-x/Tt/ if -k _;
+               . (-r $file ? 'R' : '-')
+                . (-w $file ? 'W' : '-')
+                . (-x $file ? 'X' : '-');
+        substr($mode,2,1) =~ tr/-x/Ss/ if -u $file or -g $file;
+        substr($mode,3,1) =~ tr/-x/Tt/ if -k $file;
       }
     }
 
       }
     }
 
@@ -425,6 +448,25 @@ sub info {
   return ($linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates);
 }
 
   return ($linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates);
 }
 
+# get ACLs
+#
+# INPUT: filenames
+#
+# GLOBAL: @ACL
+sub getacl {
+  my @files;
+
+  $getfacl ||= pathsearch('getfacl') or return;
+  # warn "### @_\n";
+  foreach my $file (@_) { push @files,$file if -e $file }
+  if (@files and open my $acl,'-|',$getfacl,'-ps',@files) {
+    while (<$acl>) {
+      $ACL{$1} = $1 if /^# file: (.+)/;
+    }
+    close $acl;
+  }
+}
+
 
 # reformat integer into 3-digit doted format
 # (when non-numerical mode is set)
 
 # reformat integer into 3-digit doted format
 # (when non-numerical mode is set)
@@ -482,6 +524,7 @@ sub getfiles {
     warn "$0: cannot read $dir : $!\n";
   }
 
     warn "$0: cannot read $dir : $!\n";
   }
 
+  getacl(@dirs,@files) if $opt_l and not $opt_n;
   return (@dirs,@files);
 }
 
   return (@dirs,@files);
 }
 
@@ -497,6 +540,15 @@ sub nodes {
 }
 
 
 }
 
 
+sub pathsearch {
+  my $prg = shift;
+
+  foreach my $dir (split(':',$ENV{PATH})) {
+    return "$dir/$prg" if -x "$dir/$prg";
+  }
+}
+
+
 # reformat timetick to ISO date string
 #
 # INPUT: timetick
 # reformat timetick to ISO date string
 #
 # INPUT: timetick
@@ -552,7 +604,7 @@ sub usage {
     print OUT "usage: $0 $opts [-F regexp] [file...]\n";
   }
   $opts =~ s/R//;
     print OUT "usage: $0 $opts [-F regexp] [file...]\n";
   }
   $opts =~ s/R//;
-  print OUT "usage: lf $opts regexp [directory...]\n";
+  print OUT "usage: lf $opts regexp [regexp...] [directory]\n";
   print OUT <<EOD;
 options: -l  long list (implicit if called 'll')
          -a  list also .* files
   print OUT <<EOD;
 options: -l  long list (implicit if called 'll')
          -a  list also .* files
@@ -566,7 +618,7 @@ options: -l  long list (implicit if called 'll')
          -n  numerical output
          -r  reverse list
          -z  squeeze size field (slows down output)
          -n  numerical output
          -r  reverse list
          -z  squeeze size field (slows down output)
-         -L  derefernce symbolic links
+         -L  show absolute real path (dereference symbolic links)
          -R  recursive into subdirs
          -x  do not cross filesystem boundaries with -R
          -F  find files matching case insensitive regexp
          -R  recursive into subdirs
          -x  do not cross filesystem boundaries with -R
          -F  find files matching case insensitive regexp
index fdc2f2554993a9db754b1f917b8fd7bf4a754a03..3aafafbc0cf7ab041e3833d0bb2183d3246b0d1f 100755 (executable)
@@ -120,7 +120,11 @@ for (;;) {
     }
     $post = /\nPOST\s/;
     if (/^\n*(CONNECT|CONTINUE).*\s\[([\d_]+)\]/i) { $pid = $2 }
     }
     $post = /\nPOST\s/;
     if (/^\n*(CONNECT|CONTINUE).*\s\[([\d_]+)\]/i) { $pid = $2 }
-    if (/\n(POST|GET)\s+\/(\w+)/i)                 { $cgi = $2 }
+    if (/\n(POST|GET)\s+(\S+)/i) {
+      $cgi = $2;
+      $cgi =~ s:.*/::;
+      $cgi =~ s:\?.*::;
+    }
     if (/Content-Length: (\d+)/i) {
       $d = $1;
       while ($d =~ s/(\d)(\d\d\d\b)/$1,$2/) {};
     if (/Content-Length: (\d+)/i) {
       $d = $1;
       while ($d =~ s/(\d)(\d\d\d\b)/$1,$2/) {};
@@ -180,6 +184,7 @@ sub read_debug_log {
       binmode($log,":utf8");
       while (<$log>) {
         s/\r//;
       binmode($log,":utf8");
       while (<$log>) {
         s/\r//;
+        s/[^\x09\x20-\xFF]/_/g;
         if (/^Content-Disposition:.*name="FILE".*filename="(.+)"/i) {
           print "  FILE=\"$1\"\n";
         } elsif (/^Content-Disposition:.*name="(\w+)"/i) {
         if (/^Content-Disposition:.*name="FILE".*filename="(.+)"/i) {
           print "  FILE=\"$1\"\n";
         } elsif (/^Content-Disposition:.*name="(\w+)"/i) {
index 9a7d48b3e9872e6985e6d5b3e568f11476d8c9b3..8b9e1d1e94c981225b266e4a4f74256ada87ce0e 100755 (executable)
@@ -19,7 +19,7 @@ use constant M => 2**20;
 
 eval 'use Net::INET6Glue::INET_is_INET6';
 
 
 eval 'use Net::INET6Glue::INET_is_INET6';
 
-our $version = 20160328;
+our $version = 20160919;
 our $DEBUG = $ENV{DEBUG};
 
 my %SSL = (SSL_version => 'TLSv1');
 our $DEBUG = $ENV{DEBUG};
 
 my %SSL = (SSL_version => 'TLSv1');
diff --git a/bin/zz b/bin/zz
index 03174122fb547f785df6feb15df63653809469fb..39dc91e318edc4c1f208177baeeff7c30f67e35a 100755 (executable)
--- a/bin/zz
+++ b/bin/zz
-#!/bin/sh
+#!/usr/bin/perl -w
+#
+# vv : visual versioning
+# zz : generic shell clip board
+# ezz : clip board editor
+#
+# http://fex.rus.uni-stuttgart.de/fstools/vv.html
+# http://fex.rus.uni-stuttgart.de/fstools/zz.html
+#
+# by Ulli Horlacher <framstag@rus.uni-stuttgart.de>
+#
+# Perl Artistic Licence
+#
+# vv is a script to handle file versions:
+# list, view, recover, diff, purge, migrate, save, delete
+#
+# vv is an extension to emacs idea of backup~ files
+#
+# File versions are stored in local subdirectory .versions/
+#
+# To use vv with jed, install to your jed library path:
+#
+#   http://fex.rus.uni-stuttgart.de/sw/share/jedlib/vv.sl
+#
+# To use vv with vim, add to your .vimrc:
+#
+#   autocmd BufWritePre  * execute '! vv -s ' . shellescape(@%)
+#   autocmd BufWritePost * execute '! vv -b ' . shellescape(@%)
+#
+# To use vv with emacs, add to your .emacs:
+#
+#   (add-hook 'before-save-hook (lambda () (shell-command (
+#    concat "vv -s " (shell-quote-argument (buffer-file-name))))))
+#   (add-hook 'after-save-hook  (lambda () (shell-command (
+#    concat "vv -b " (shell-quote-argument (buffer-file-name))))))
+#   (setq make-backup-files nil)
+#
+# To use vv with ANY editor, first set:
+#
+#   export EDITOR=your_favourite_editor
+#   alias ve='vv -e'
+#
+# and then edit your file with:
+#
+#   ve file
+#
+# $HOME/.vvrc is the config file for vv
+
+# 2013-04-15 initial version
+# 2013-04-16 added options -m and -v
+# 2013-04-18 added option -s
+# 2013-04-22 realfilename() fixes symlink problematics
+# 2013-04-22 use rsync instead of cp
+# 2013-04-23 added option -I
+# 2013-04-23 renamed from jedv to vv
+# 2013-04-24 added options -e -0
+# 2013-05-09 added option -R
+# 2013-05-22 modified option -d to double argument
+# 2013-05-22 added vvrc with $exclude and @diff
+# 2013-07-05 fixed bug potential endless loop in rotate()
+# 2014-04-16 added change-file-test for opt_s (needs .versions/$file)
+# 2014-04-18 added option -b : save backup
+# 2014-05-02 fixed bug wrong file ownership when using as root
+# 2014-06-18 options -r -d -v : parameter is optional, default is 1
+# 2014-06-18 fixed (stupid!) bug option -s does only sometimes saving
+# 2014-06-20 options -d -v : argument is optional, default is last file
+# 2014-07-22 fixed bug no (new) backup version 0 on option -r
+# 2014-11-14 added option -D : delete last saved version
+# 2014-11-14 make .versions/ mode 777 if parent directory is world writable
+# 2015-03-19 allow write access by root even if file and .versions/ have different owners
+# 2015-03-20 better error formating for jed
+# 2015-06-02 added option -r . to restore last saved backup
+# 2016-03-07 added options -M -L
+# 2016-03-08 renamed option -I to -H
+# 2016-05-02 added -A option to preserve ACLs with rsync
+# 2016-06-07 option -v : use PAGER=cat if STDOUT is not a tty
+# 2016-06-08 added zz, ezz and installer vvzz
+# 2016-07-06 avoid empty $ZZ versioning
+# 2016-09-12 added option -q quiet mode
+
+use Getopt::Std;
+use File::Basename;
+use Digest::MD5 'md5_hex';
+use Cwd 'abs_path';
+
+$prg = abs_path($0);
+$0 =~ s:.*/::;
+
+$ZZ = $ENV{ZZ} || "$ENV{HOME}/.zz";
+
+&install if $0 eq 'vvzz';
+&zz      if $0 eq 'zz';
+&ezz     if $0 eq 'ezz';
+
+# vv
+$usage = <<EOD;
+usage: $0 [-l] [file]
+       $0 -r . file
+       $0 -r version-number file [new-file]
+       $0 -d version-number[:version-number] file
+       $0 -v version-number file
+       $0 -s file
+       $0 -D file
+       $0 -e file
+       $0 -M file|.
+       $0 -L file|.
+       $0 -m [-R]
+       $0 -p
+       $0 -q
+       $0 -H
+options: -l   list available versions
+         -v   view version
+         -r   recover file (. is last saved backup)
+         -d   show diff
+         -s   save file to new version
+         -D   delete last saved version
+         -e   edit file with \$EDITOR (with versioning)
+         -p   purge orphaned versions (without current file)
+         -q   quiet mode
+         -m   migrate backup files to version files (-R all recursive)
+         -M   migrate to more versions (upto 100)
+         -L   migrate to less versions (upto 10)
+         -H   show more information
+examples: $0 project.pl
+          $0 -d 2 project.pl
+          $0 -r 2 project.pl project_2.pl
+EOD
+
+$vvrc = $ENV{HOME} . '/.vvrc';
+
+$opt_l = 1;
+$opt_h = $opt_p = $opt_m = $opt_s = $opt_0 = $opt_e = $opt_H = $opt_b = 0;
+$opt_q = $opt_D = $opt_R = 0;
+$opt_r = $opt_d = $opt_v = $opt_M = $opt_L = '';
+${'opt_+'} = 0;
+getopts('hHls0bepqmRDrdv+M:L:') or die $usage;
+
+if ($opt_h) {
+  print $usage;
+  exit;
+}
+
+if ($opt_H) {
+  open $prg,$prg or die "$0: $prg - $!\n";
+  $_ = <$prg>;
+  $_ = <$prg>;
+  while (<$prg>) {
+    last if /^\s*$/ or /^#\s*\d\d\d\d-\d\d-\d\d/;
+    print;
+  }
+  exit;
+}
+
+if ($opt_r) {
+  die "usage: $0 -r version-number file\n" unless @ARGV;
+  if ($ARGV[0] =~ /^(\d\d?|\.)$/) { $opt_r = shift }
+  else                            { $opt_r = 1 }
+  die "usage: $0 -r version-number file\n" if scalar @ARGV != 1;
+}
+
+if ($opt_d) {
+  if (@ARGV and $ARGV[0] =~ /^\d\d?(:\d\d?)?$/) { $opt_d = shift }
+  else                                          { $opt_d = 1 }
+  &check_ARGV;
+  die "usage: $0 -d version-number file\n" unless @ARGV;
+}
+
+if ($opt_v) {
+  if (@ARGV and $ARGV[0] =~ /^\d\d?$/) { $opt_v = shift }
+  else                                 { $opt_v = 1 }
+  &check_ARGV;
+  die "usage: $0 -v version-number file\n" unless @ARGV;
+}
+
+if ($0 eq 've' or $opt_e) {
+  $a = pop @ARGV or die $usage;
+  $opt_e = 1;
+} else {
+  $a = shift @ARGV;
+  die $usage if not $opt_r and @ARGV;
+}
+
+unless (-e $vvrc) {
+  open $vvrc,'>',$vvrc or die "$0: cannot write $vvrc - $!\n";
+  print {$vvrc} q{
+$exclude = q(
+  \.tmp$
+  ^mutt-.+-\d+
+  ^#.*#$
+);
+
+@diff = qw'diff -u';
+
+};
+  close $vvrc;
+}
+
+require $vvrc;
+
+if ($a) {
+
+  $file = realfilename($a);
+  $ofile = "$file~";
+  $bfile = basename($file);
+  $dir = dirname($file);
+  $vdir = "$dir/.versions";
+  $vfile = "$vdir/$bfile";
+  $vfile0 = "$vfile~0~";
+  $vfile1 = "$vfile~1~";
+  $vfile01 = "$vfile~01~";
+
+  # change eugid if root and version directory belongs user
+  my @s = stat($vdir);
+  if ($> == 0 and (not @s or $s[4])) {
+    if (my @s = stat($a)) {
+      $) = $s[5];
+      $> = $s[4];
+    }
+  }
+
+  if ($opt_r ne '.' and not ($opt_M or $opt_L)) {
+    if (not -e $file and -s $vfile) {
+      warn "$0: $a does not exist any more\n";
+      print "found $vfile - recover it? ";
+      $_ = <STDIN>;
+      copy($vfile,$file,'.') if /^y/i;
+      exit 0;
+    }
+    die "$0: $a does not exist\n" unless -e $file;
+    die "$0: $a is not a regular file\n" if -l $file or not -f $file;
+  }
+} else {
+  $file = '*';
+  $vdir = ".versions";
+}
+
+if ($opt_M) {
+  if (-d $opt_M and not -l $opt_M) {
+    my $vvv = "$opt_M/.versions";
+    mkdir $vvv;
+    die "$0: cannot mkdir $vvv - $!\n" unless -d $vvv;
+    opendir $vvv,$vvv or die "$0: cannot opendir $vvv - $!\n";
+    while (my $v = readdir($vvv)) {
+      mv100("$opt_M/$1") if -f "$vvv/$v" and $v =~ /(.+)~1~$/;
+    }
+    close $vvv;
+    $vvv .= "/.versions";
+    unless (-d $vvv) {
+      mkdir $vvv or die "$0: cannot mkdir $vvv - $!\n";
+    }
+    $vvv .= "/n";
+    unlink $vvv;
+    symlink 100,$vvv or die "$0: cannot create $vvv - $!\n";
+  } else {
+    die "usage: $0 -M file\n" if @ARGV or $opt_r;
+    mv100($opt_M);
+  }
+  exit;
+}
+
+if ($opt_L) {
+  if (-d $opt_L and not -l $opt_L) {
+    my $vvv = "$opt_L/.versions";
+    mkdir $vvv;
+    die "$0: cannot mkdir $vvv - $!\n" unless -d $vvv;
+    opendir $vvv,$vvv or die "$0: cannot opendir $vvv - $!\n";
+    while (my $v = readdir($vvv)) {
+      mv10("$opt_L/$1") if -f "$vvv/$v" and $v =~ /(.+)~01~$/;
+    }
+    closedir $vvv;
+    $vvv .= "/.versions";
+    unless (-d $vvv) {
+      mkdir $vvv or die "$0: cannot mkdir $vvv - $!\n";
+    }
+    $vvv .= "/n";
+    unlink $vvv;
+    symlink 10,$vvv or die "$0: cannot create $vvv - $!\n";
+  } else {
+    die "usage: $0 -L file\n" if @ARGV or $opt_r;
+    mv10($opt_L);
+  }
+  exit;
+}
+
+if ($opt_e) {
+  die $usage unless $a;
+  $editor = $ENV{EDITOR} or die "$0: environment variable EDITOR not set\n";
+  system(qw'vv -s',$file) if -f $file; # save current version
+  system($editor,@ARGV,$file); exit $? if $?;
+  unlink $ofile;                       # delete new file~ created by editor
+  system(qw'vv -0',$file);             # post rotating
+  system(qw'vv -b',$file);             # save backup
+  exit;
+}
+
+if ($opt_v) {
+  die "$0: no such file $bfile\n" unless $bfile;
+  if (-f "$vfile~0$opt_v~") { $vfile .= "~0$opt_v~" }
+  else                      { $vfile .= "~$opt_v~" }
+  if (-f $vfile) {
+    if (-t STDOUT) {
+      if (($ENV{EDITOR}||$0) =~ /jed/) {
+        $ENV{JEDINIT} = "SAVE_STATE=0";
+        exec 'jed',$vfile,qw'-tmp -f set_readonly(1)';
+      } elsif ($ENV{PAGER}) {
+        exec $ENV{PAGER},$vfile;
+      } else {
+        exec 'view',$vfile;
+      }
+    } else {
+      exec 'cat',$vfile;
+    }
+  } else {
+    die "$0: no $vfile\n";
+  }
+  exit;
+}
+
+if ($opt_p) {
+  opendir $vdir,$vdir or die "$0: no $vdir\n";
+  while ($vfile = readdir($vdir)) {
+    next unless -f "$vdir/$vfile";
+    $bfile = $vfile;
+    $bfile =~ s/~\d\d?~$//;
+    if (not -f $bfile or -l $bfile) {
+      unlink "$vdir/$vfile";
+      $purge{$bfile}++;
+    }
+  }
+  if (@purge = keys %purge) {
+    foreach $p (@purge) {
+      printf "%2d %s~ purged\n",$purge{$p},$p;
+    }
+  }
+  exit;
+}
+
+if ($opt_m) {
+  migrate('.');
+  exit;
+}
+
+if (length($opt_r)) {
+  die "$0: no such file $bfile\n" unless $bfile;
+  if ($opt_r eq '.') {
+    die "$0: no $vfile\n" unless -f $vfile;
+    copy($vfile,$file,$opt_r);
+  } else {
+    if ($opt_r =~ /^\d$/ and -f "$vfile~0$opt_r~") {
+      $vfile .= "~0$opt_r~"
+    } else {
+      $vfile .= "~$opt_r~"
+    }
+    die "$0: no version $opt_r for $file\n" unless -f $vfile;
+    if ($nfile = shift @ARGV) {
+      copy($vfile,$nfile);
+    } else {
+      copy($file,$vfile0) if mtime($file) > mtime($vfile0);
+      copy($vfile,$file);
+    }
+  }
+  exit;
+}
+
+if (length($opt_d)) {
+  die "$0: no such file $bfile\n" unless $bfile;
+  @diff = qw'diff -u' unless @diff;
+  if ($opt_d =~ /^(\d\d?):(\d\d?)$/) {
+    if (-f "$vdir/$bfile~0$1~" and -f "$vdir/$bfile~0$2~") {
+      exec @diff,"$vdir/$bfile~0$2~","$vdir/$bfile~0$1~"
+    } else {
+      exec @diff,"$vdir/$bfile~$2~","$vdir/$bfile~$1~"
+    }
+  } else {
+    if (-f "$vdir/$bfile~0$opt_d~") {
+      exec @diff,"$vdir/$bfile~0$opt_d~",$file;
+    } else {
+      exec @diff,"$vdir/$bfile~$opt_d~",$file;
+    }
+  }
+  exit $!;
+}
+
+if ($opt_s) {
+  die $usage unless $file;
+  if ($exclude) {
+    $exclude =~ s/^\s+//;
+    $exclude =~ s/\s+$//;
+    $exclude =~ s/\s+/|/g;
+    if ($bfile =~ /$exclude/) {
+      warn "\r\n$0: ignoring $bfile\n";
+      exit;
+    }
+  }
+  unless (-d $vdir) {
+    mkdir $vdir or die "$0: cannot mkdir $vdir - $!\n";
+  }
+  chmod 0777,$vdir if (stat $dir)[2] & 00002;
+
+  # migrate old file~ to versions
+  if (-f $ofile and not -l $ofile and -r $ofile) {
+    $vfn = rotate($vfile);
+    rename($ofile,$vfn);
+  }
+
+  # rotate and save if file has changed
+  if (-f $vfile1) {
+    if (md5f($vfile1) ne md5f($file)) {
+      $vfn = rotate($vfile);
+      copy($file,$vfn);
+    }
+    exit;
+  }
+  # rotate and save if file has changed
+  if (-f $vfile01) {
+    if (md5f($vfile01) ne md5f($file)) {
+      $vfn = rotate($vfile);
+      copy($file,$vfn);
+    }
+    exit;
+  }
+  # save new file
+  if ((readlink("$vdir/.versions/n")||10) == 100) {
+    copy($file,$vfile01);
+  } else {
+    copy($file,$vfile1);
+  }
+  exit;
+}
+
+# backup version
+if ($opt_b) {
+  die $usage unless $file;
+  unless (-d $vdir) {
+    mkdir $vdir or die "\r\n$0: cannot mkdir $vdir - $!\n";
+  }
+  copy($file,$vfile);
+  if ($ENV{VIMRUNTIME}) {
+    print "\n";
+  } else {
+    warn "$file --> $vfile\n" unless $opt_q;
+  }
+  exit;
+}
+
+# special post rotating from -e
+if ($opt_0) {
+  my @sb = stat $file or die "$0: $file - $!\n";
+  if (-f $vfile1) {
+    while (my @sv = stat $vfile1) {
+      # no version change?
+      if ($sb[7] == $sv[7] and $sb[9] == $sv[9]) {
+        # rotate back
+        rb10($vfile);
+      } else {
+        last;
+      }
+    }
+  }
+  if (-f $vfile01) {
+    while (my @sv = stat $vfile01) {
+      # no version change?
+      if ($sb[7] == $sv[7] and $sb[9] == $sv[9]) {
+        # rotate back
+        rb10($vfile);
+      } else {
+        last;
+      }
+    }
+  }
+  exit;
+}
+
+# delete last version, roll back
+if ($opt_D) {
+  die "usage: $0 -D file\n" unless $vfile1 or $vfile01;
+  stat $file or die "$0: $file - $!\n";
+  # 0 version?
+  if (-f $vfile0) {
+    unlink $vfile0;
+  } else {
+    # rotate back
+    rb10($vfile) if -f $vfile1;
+    rb100($vfile) if -f $vfile01;
+  }
+  exec $0,'-l',$file;
+  exit;
+}
+
+# default!
+if ($opt_l) {
+  `stty -a` =~ /columns (\d+)/;
+  $tw = ($1 || 80)-36;
+  if (opendir $vdir,$vdir) {
+    while ($vfile = readdir($vdir)) {
+      if (-f "$vdir/$vfile") {
+        if ($bfile) {
+          if ($vfile =~ /^\Q$bfile\E~(\d\d?)~$/) {
+            push @{$v{$file}},$1;
+          }
+        } else {
+          if ($vfile =~ /^(.+)~(\d\d?)~$/) {
+            push @{$v{$1}},$2;
+          } else {
+            push @{$v{$vfile}},0;
+          }
+        }
+      }
+    }
+    closedir $vdir;
+    $ct = '';
+    foreach $file (sort keys %v) {
+      if (not -f $file or -l $file) {
+        warn "$0: orphaned $file~\n";
+        next;
+      }
+      @v = sort @{$v{$file}};
+      if ($bfile) {
+        @stat = stat $file or die "$0: $file - $!\n";
+        print "version bytes        date time";
+        if (${'opt_+'}) {
+          print "     content";
+          $ct = content($file);
+          $ct =~ s/(.{$tw}).+/$1*/;
+        }
+        print "\n";
+        if (length($v[0]) == 1) { $lf = "%s  %10s  %s %s\n" }
+        else                    { $lf = "%2s %10s  %s %s\n" }
+        printf $lf,'.',size($stat[7]),isodate($stat[9]),$ct;
+        foreach $v (@v) {
+          $vfile = "$vdir/$bfile~$v~";
+          @stat = stat $vfile or next;
+          if (${'opt_+'}) {
+            $ct = content($vfile);
+            $ct =~ s/(.{$tw}).+/$1*/;
+          }
+          printf $lf,int($v),size($stat[7]),isodate($stat[9]),$ct;
+        }
+      } else {
+        my $n = scalar(@v);
+        $n-- if $v[0] == 0; # do not count zero version
+        printf "%d %s\n",$n,$file;
+      }
+    }
+  }
+  exit;
+}
+
+
+sub size {
+  my $s = shift;
+  if    ($s > 9999999999) { $s = int($s/2**30).'G' }
+  elsif ($s > 9999999)    { $s = int($s/2**20).'M' }
+  elsif ($s > 9999)       { $s = int($s/2**10).'k' }
+  return $s;
+}
+
+
+sub content {
+  my $file = shift;
+  my $ct;
+  local $_;
+
+  chomp ($ct = `file $file`);
+  $ct =~ s/.*?: //;
+  $ct =~ s/,.*//;
+
+  if ($ct =~ /text/ and open $file,$file) {
+    read $file,$_,1024;
+    close $file;
+    s/[\x00-\x20]+/ /g;
+    s/^ //;
+    s/ $//;
+    $ct = '"'.$_.'"';
+  }
+
+  return $ct;
+}
 
 
+
+sub isodate {
+  my @d = localtime shift;
+  return sprintf('%d-%02d-%02d %02d:%02d:%02d',
+                 $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
+}
+
+sub rotate {
+  my $vf = shift; # version base file
+  my $vf1 = "$vf~1~";
+  my $vf01 = "$vf~01~";
+  my ($vfi,$vfn);
+
+  if (-f $vf1) {
+    for (my $i = 8; $i >= 0; $i--) {
+      $vfi = sprintf("%s~%d~",$vf,$i);
+      $vfn = sprintf("%s~%d~",$vf,$i+1);
+      if (-e $vfi) {
+        rename $vfi,$vfn or die "$0: $vfi --> $vfn : $!\n";
+      }
+    }
+    # was there a version 0?
+    if (-e $vf1) {
+      my $bf = $vf;
+      $bf =~ s:/\.versions/:/:;
+      my @sb = stat $bf;
+      my @sv = stat $vf1;
+      # version change? (other size or mtime)
+      if (@sb and @sv and $sb[7] == $sv[7] and $sb[9] == $sv[9]) {
+        # same version
+        unlink $vf1;
+      } else {
+        # other version
+        rotate($vf);
+      }
+    }
+    return "$vf~1~";
+  } elsif (-f $vf01) {
+    for (my $i = 98; $i >= 0; $i--) {
+      $vfi = sprintf("%s~%02d~",$vf,$i);
+      $vfn = sprintf("%s~%02d~",$vf,$i+1);
+      if (-e $vfi) {
+        rename $vfi,$vfn or die "$0: $vfi --> $vfn : $!\n";
+      }
+    }
+    # was there a version 0?
+    if (-e $vf01) {
+      my $bf = $vf;
+      $bf =~ s:/\.versions/:/:;
+      my @sb = stat $bf;
+      my @sv = stat $vf01;
+      # version change? (other size or mtime)
+      if (@sb and @sv and $sb[7] == $sv[7] and $sb[9] == $sv[9]) {
+        # same version
+        unlink $vf01;
+      } else {
+        # other version
+        rotate($vf);
+      }
+    }
+    return "$vf~01~";
+  }
+
+  return "$vf~1~";
+}
+
+sub copy {
+  my ($from,$to,$restore) = @_;
+
+  unless ($restore) {
+    if (-l $file or not -f $file) {
+      die "$0: $file is not a regular file\n";
+    }
+  }
+
+  if (open $to,'>>',$to) {
+    close $to;
+    if (system(qw'rsync -aA',$from,$to) == 0) {
+      if ($ENV{VIMRUNTIME}) {
+        print "\n";
+      } else {
+        warn "$from --> $to\n" unless $opt_q;
+      }
+    } else {
+      exit $?;
+    }
+  } else {
+    die "\r\n$0: cannot write $to - $!\n";
+  }
+}
+
+sub realfilename {
+  my $file = shift;
+
+  return $file unless -e $file;
+
+  if (-l $file) {
+    my $link = readlink($file);
+    if ($link !~ /^\// and $file =~ m:(.*/).:) {
+      $link = $1 . $link;
+    }
+    return realfilename($link);
+  } else {
+    return $file;
+  }
+}
+
+sub migrate {
+  my $dir = shift;
+  my $vdir = "$dir/.versions";
+  my $dfile;
+
+  opendir $dir,$dir or die "$0: cannot read directory $dir - $!\n";
+  while ($file = readdir($dir)) {
+    $dfile = "$dir/$file";
+    next if -l $dfile or $file eq '.' or $file eq '..';
+    if (-d $dfile and $opt_R and $file ne '.versions') {
+      migrate($dfile);
+    } elsif (-f $dfile and $file =~ /~$/) {
+      if (-d $vdir) {
+        for ($i = 8; $i > 0; $i--) {
+          $n = $i+1;
+          rename "$vdir/$file$i~","$vdir/$file$n~";
+        }
+      } else {
+        mkdir $vdir or die "$0: cannot mkdir $vdir - $!\n";
+      }
+      $nfile = sprintf("%s/%s1~",$vdir,$file);
+      rename $dfile,$nfile or die "$0: cannot move $dfile to $nfile - $!\n";
+      warn "$dfile --> $nfile\n" unless $opt_q;
+    }
+  }
+  closedir $dir;
+}
+
+sub mtime {
+  my @s = stat shift;
+  return @s ? $s[9] : 0;
+}
+
+sub md5f {
+  my $file = shift;
+  my $md5 = 0;
+  local $/;
+
+  if (open $file,$file) {
+    $md5 = md5_hex(<$file>);
+    close $file;
+  }
+  return $md5;
+}
+
+
+# if ARGV is empty use last saved file as default file argument
+sub check_ARGV {
+  local $_;
+  local *V;
+
+  if (not @ARGV) {
+    if (-d '.versions' and open V,'ls -at .versions|') {
+      while (<V>) {
+        chomp;
+        if (-f) {
+          close V;
+          s/~\d+~$//;
+          @ARGV = ($_);
+          return;
+        }
+      }
+    }
+  }
+
+}
+
+
+sub mv10 {
+  my $file = shift;
+  my $vfile = dirname($file).'/.versions/'.basename($file);
+
+  die "$0: $file has no extended versions\n" unless -f "$vfile~01~";
+  for (my $i=1; $i<10; $i++) {
+    my $vfile1 = "$vfile~$i~";
+    my $vfile2 = "$vfile~0$i~";
+    if (-f $vfile2) {
+      warn "$vfile2 --> $vfile1\n" unless $opt_q;
+      rename $vfile2,$vfile1 or die "$0: $!\n";
+    }
+  }
+  for (my $i=10; $i<100; $i++) {
+    unlink "$vfile~$i~";
+  }
+}
+
+sub mv100 {
+  my $file = shift;
+  my $vfile = dirname($file).'/.versions/'.basename($file);
+
+  die "$0: $file has already extended versions\n" if -f "$vfile~01~";
+  die "$0: $file has no versions\n" unless -f "$vfile~1~";
+  for (my $i=1; $i<10; $i++) {
+    my $vfile1 = "$vfile~$i~";
+    my $vfile2 = "$vfile~0$i~";
+    if (-f $vfile1) {
+      warn "$vfile1 --> $vfile2\n" unless $opt_q;
+      rename $vfile1,$vfile2 or die "$0: $!\n";
+    }
+  }
+}
+
+
+# rotate back
+sub rb10 {
+  my $vfile = shift;
+
+  for (my $i = 1; $i <= 8; $i++) {
+    my $vfi = sprintf("%s~%d~",$vfile,$i);
+    my $vfn = sprintf("%s~%d~",$vfile,$i+1);
+    if (-f $vfn) {
+      rename $vfn,$vfi;
+    } else {
+      unlink $vfi if $i == 1;
+      last;
+    }
+  }
+}
+
+
+# rotate back
+sub rb100 {
+  my $vfile = shift;
+
+  for (my $i = 1; $i <= 98; $i++) {
+    my $vfi = sprintf("%s~%02d~",$vfile,$i);
+    my $vfn = sprintf("%s~%02d~",$vfile,$i+1);
+    if (-f $vfn) {
+      rename $vfn,$vfi;
+    } else {
+      unlink $vfi if $i == 1;
+      last;
+    }
+  }
+}
+
+
+
+sub pathsearch {
+  my $prg = shift;
+
+  foreach my $dir (split(':',$ENV{PATH})) {
+    return "$dir/$prg" if -x "$dir/$prg";
+  }
+}
+
+
+# zz is the generic clip board program
+#
 # to use zz with vim, write to your .vimrc:
 #
 # noremap <silent> zz> :w !zz<CR><CR>
 # to use zz with vim, write to your .vimrc:
 #
 # noremap <silent> zz> :w !zz<CR><CR>
-# noremap <silent> zz< :r !zz<CR>
+# noremap <silent> zz< :r !zz --<CR>
+sub zz {
+  my $bs = 2**16;
+  my $wm = '>';
+  my ($file,$tee,$x);
 
 
-ZZ=${ZZ:-$HOME/.zz}
+  if ("@ARGV" =~ /^(-h|--help)$/) {
+    print <<'EOD';
+zz is the generic clip board program. It can hold any data, ASCII or binary.
+The clip board itself is $ZZ (default: $HOME/.zz).
+See also the clip board editor "ezz".
+Limitation: zz does not work across accounts or hosts! Use xx instead.
 
 
-if [ "$*" = -h -o "$*" = --help ]; then
-  exec cat<<EOD
-zz is the generic clip board program. See also the edit helper program ezz.
-The clip board is \$ZZ (default: \$HOME/.zz). Options and modes are:
+Options and modes are:
 
 
-"zz"            write \$ZZ to STDOUT
-"zz file(s)"    copy file(s) into \$ZZ
-"zz -"          write STDIN (keyboard, mouse buffer) to \$ZZ
-"zz +"          add STDIN (keyboard, mouse buffer) to \$ZZ
-"... | zz"      write STDIN from pipe to \$ZZ
-"... | zz +"    add STDIN from pipe to \$ZZ
-"zz | ..."      write \$ZZ to pipe
-"zz .."         write previous \$ZZ to STDOUT
+  "zz"              show content of $ZZ
+  "zz file(s)"      copy file(s) content into $ZZ
+  "zz -"            write STDIN (keyboard, mouse buffer) to $ZZ
+  "zz +"            add STDIN (keyboard, mouse buffer) to $ZZ
+  "... | zz"        write STDIN from pipe to $ZZ
+  "... | zz +"      add STDIN from pipe to $ZZ
+  "... | zz -"      write STDIN from pipe to $ZZ and STDOUT
+  "zz | ..."        write $ZZ to pipe
+  "... | zz | ..."  save pipe data to $ZZ (like tee)
+  "zz --"           write $ZZ to STDOUT
+  "zz -v"           show clip board versions (history)
+  "zz -1"           write $ZZ version 1 to STDOUT
+  "zz -9"           write $ZZ version 9 to STDOUT
 
 Examples:
 
   zz *.txt
   ls -l | zz
   zz | wc -l
 
 Examples:
 
   zz *.txt
   ls -l | zz
   zz | wc -l
-  (within mutt:) |zz
-  (within tin:)  |azz
-  (within vi:)   :w !zz
-  (within vi:)   :r !zz
+  (within vi)   :w !zz
+  (within vi)   :r !zz
+  (within mutt) |zz
+EOD
+    exit;
+  }
+
+  if ("@ARGV" eq '-v') {
+    exec qw'vv -+l',$ZZ;
+  }
+
+  if ("@ARGV" =~ /^-(\d)$/) {
+    exec "vv -v $1 '$ZZ' | cat";
+  }
+
+  # read mode
+  if (-t STDIN and not @ARGV or "@ARGV" eq '--') {
+    exec 'cat',$ZZ;
+  }
+
+  # write mode
+  system "vv -s '$ZZ' >/dev/null 2>&1" if -s $ZZ;
+
+  if (@ARGV and $ARGV[0] eq '+') {
+    shift @ARGV;
+    $wm = '>>';
+  }
+
+  if ("@ARGV" eq '-') {
+    @ARGV = ();
+    $tee = 1 unless -t STDIN;
+  }
+
+ $tee = 1 unless @ARGV or -t STDIN or -t STDOUT;
+ $bs = 2**12 if $tee;
+
+  open $ZZ,$wm,$ZZ or die "$0: cannot write $ZZ - $!\n";
+
+  if (@ARGV) {
+    while ($file = shift @ARGV) {
+      if (-f $file) {
+        if (open $file,$file) {
+          while (read($file,$x,$bs)) {
+            my $s = syswrite $ZZ,$x;
+            defined($s) or die "$0: cannot write to $ZZ - $!\n";
+          }
+          close $file;
+        } else {
+          warn "$0: cannot read $file - $!\n";
+        }
+      } elsif (-e $file) {
+        warn "$0: $file is not a regular file\n";
+      } else {
+        warn "$0: $file does not exist\n";
+      }
+    }
+    close $ZZ;
+    $ZZ1 = $ZZ.'~1~';
+    $ZZ1 =~ s:(.*)/(.*):$1/.versions/$2:;
+    if (-e $ZZ and not -s $ZZ and -s $ZZ1 ) {
+      system qw'rsync -aA',$ZZ1,$ZZ;
+    }
+  } else {
+    while (read(STDIN,$x,$bs)) {
+      syswrite $ZZ,$x;
+      syswrite STDOUT,$x if $tee;
+    }
+  }
 
 
-Limitation: zz does not work across different accounts or hosts! Use xx instead.
+  exit;
+}
+
+
+sub ezz {
+  my $bs = 2**16;
+  my $wm = '>';
+  my $editor = $ENV{EDITOR} || 'vi';
+  my ($out,$file,$x);
+
+  $ENV{JEDINIT} = "SAVE_STATE=0";
+
+  if ("@ARGV" =~ /^(-h|--help)$/) {
+    print <<'EOD';
+ezz is the edit helper for the zz clip board program.
+The clip board itself is $ZZ (default: $HOME/.zz).
+
+Options and modes are:
+
+  "ezz"                    edit $ZZ with $EDITOR
+  "... | ezz"              write STDIN from pipe to $ZZ and call $EDITOR
+  "... | ezz +"            add STDIN from pipe to $ZZ and call $EDITOR
+  "ezz 'perl commands'"    execute perl commands on $ZZ
+  "ezz - 'perl commands'"  execute perl commands on $ZZ and show result
+  "ezz filter [args]"      run filter [with args] on $ZZ
+  "ezz - filter [args]"    run filter [with args] on $ZZ and show result
+
+Examples:
+
+  ls -l | ezz
+  ezz 's/ /_/g'
+  ezz head -3
+  ezz - head -3
 EOD
 EOD
-fi
-
-if [ "$1" = + ]; then
-  shift
-  exec cat -- "$@" >>$ZZ
-fi
-
-if [ -t 0 ]; then
-    if [ -z "$1" ]; then
-        exec cat -- $ZZ
-    elif [ "$1" = .. ]; then
-        exec cat -- $ZZ~
-    else
-        test -f $ZZ && mv $ZZ $ZZ~
-        exec cat -- "$@" >$ZZ
-    fi
-else
-    test -f $ZZ && mv $ZZ $ZZ~
-    exec cat >$ZZ
-fi
+    exit;
+  }
+
+  system "vv -s '$ZZ' >/dev/null 2>&1" if -s $ZZ;
+
+  unless (-t STDIN) {
+    if ("@ARGV" eq '+') {
+      @ARGV = ();
+      $wm = '>>';
+    }
+    open $ZZ,$wm,$ZZ or die "$0: cannot write $ZZ - $!\n";
+    syswrite $ZZ,$x while read(STDIN,$x,$bs);
+    close $ZZ;
+  }
+
+  if (@ARGV) {
+    $out = shift @ARGV if $ARGV[0] eq '-';
+    $cmd = shift @ARGV or exec 'cat',$ZZ;
+    rename $ZZ,"$ZZ~" or die "$0: cannot move $ZZ to $ZZ~ - $!\n";
+    $cmd = quotemeta $cmd;
+    @ARGV = map { quotemeta } @ARGV;
+    if (pathsearch($cmd)) {
+      system "$cmd @ARGV <'$ZZ~'>'$ZZ'";
+    } else {
+      system "perl -pe $cmd @ARGV <'$ZZ~'>'$ZZ'";
+    }
+    if ($? == 0) { unlink "$ZZ~" }
+    else         { rename "$ZZ~",$ZZ }
+    exec 'cat',$ZZ if $out;
+  } else {
+    exec $editor,$ZZ;
+  }
+  exit;
+}
+
+
+sub install {
+  my ($dir);
+  local $| = 1;
+
+  print "Installation directory: ";
+  $dir = <STDIN>||'';
+  chomp $dir;
+  $dir =~ s:/+$::;
+  $dir ||= '.';
+  if ($dir eq '.') {
+    unlink qw'zz ezz vv';
+    link $prg,'zz'   or die "$0: cannot create zz - $!\n";
+    link $prg,'ezz'  or die "$0: cannot create ezz - $!\n";
+    rename $prg,'vv' or die "$0: cannot create vv - $!\n";
+  } else {
+    die "$0: $dir does not exist\n"     unless -e $dir;
+    die "$0: $dir is not a directory\n" unless -d $dir;
+    die "$0: $dir is not writable\n"    unless -w $dir;
+    chdir $dir or die "$0: cannot cd $dir - $!\n";
+    unlink qw'zz ezz vv';
+    system qw'rsync -a',$prg,'vv';
+    exit $? if $?;
+    link 'vv','zz'  or die "$0: cannot create $dir/zz - $!\n";
+    link 'vv','ezz' or die "$0: cannot create $dir/ezz - $!\n";
+  }
+  print "Installation completed. See:\n";
+  print "\t$dir/vv -h\n";
+  print "\t$dir/zz -h\n";
+  print "\t$dir/ezz -h\n";
+  exit;
+}
index 262975d65912dce9f929fcbc471206560d185526..a6a00120cdfdee1eb22e2861fc36ca8c2605c5ac 100755 (executable)
@@ -205,13 +205,13 @@ if (defined $PARAM{"createUser"}) {
   if ($PARAM{"editUser"} =~ /^#.*/) {
     &editRestrictionsForm;
   } else {
   if ($PARAM{"editUser"} =~ /^#.*/) {
     &editRestrictionsForm;
   } else {
+    $user = normalize_user($PARAM{"editUser"});
     if (defined $PARAM{"delete file"}) {
     if (defined $PARAM{"delete file"}) {
-      $user = normalize_user($PARAM{"editUser"});
       unlink "$user/\@ALLOWED_RECIPIENTS";
       print "upload restrictions for $user have been deleted\n";
       &end_html;
     } else {
       unlink "$user/\@ALLOWED_RECIPIENTS";
       print "upload restrictions for $user have been deleted\n";
       &end_html;
     } else {
-      editUser($PARAM{"editUser"});
+      editUser($user);
     }
   }
 } elsif ($PARAM{"contentBox"} and $PARAM{"ar"}) {
     }
   }
 } elsif ($PARAM{"contentBox"} and $PARAM{"ar"}) {
@@ -564,8 +564,9 @@ sub saveFile {
       &end_html;
     }
   } else {
       &end_html;
     }
   } else {
-    system qw'cp -a',$ar,"$ar~";
+    system 'mv',$ar,"$ar~";
   }
   }
+  $rf =~ s/^\s+$//;
   open $ar,'>',$ar or http_die("cannot write $ar - $!");
   print {$ar} $rf;
   close $ar or http_die("cannot write $ar - $!");;
   open $ar,'>',$ar or http_die("cannot write $ar - $!");
   print {$ar} $rf;
   close $ar or http_die("cannot write $ar - $!");;
index 2a799acd3293d2d2cf7768dbfdc2762ae4664f04..9ba0ef27ecc8118654520e4072b6ff655778f9bd 100755 (executable)
@@ -1613,7 +1613,10 @@ sub parse_request {
 
     &check_space($cl) if $cl > 0;
 
 
     &check_space($cl) if $cl > 0;
 
-    $SIG{ALRM} = sub { die "TIMEOUT\n" };
+    $SIG{ALRM} = sub {
+      $SIG{__DIE__} = 'DEFAULT';
+      die "TIMEOUT\n";
+    };
     alarm($timeout);
     binmode(STDIN,':raw');
 
     alarm($timeout);
     binmode(STDIN,':raw');
 
@@ -1942,7 +1945,10 @@ sub showstatus {
     exit;
   }
 
     exit;
   }
 
-  $SIG{ALRM} = sub { die "TIMEOUT in showstatus: no (more) data received\n" };
+  $SIG{ALRM} = sub {
+    $SIG{__DIE__} = 'DEFAULT';
+    die "TIMEOUT in showstatus: no (more) data received\n";
+  };
   alarm($timeout*2);
 
   $t0 = $t1 = time;
   alarm($timeout*2);
 
   $t0 = $t1 = time;
index bca85af84ea2f66292ef7d8ff98d693ffa953f4a..0ab7be9158057199d56d1e711e65491df656e65a 100755 (executable)
@@ -48,7 +48,8 @@ unless (@local_domains or @local_rdomains) {
 }
 
 unless (@local_hosts and ipin($ra,@local_hosts) or
 }
 
 unless (@local_hosts and ipin($ra,@local_hosts) or
-        @local_rhosts and ipin($ra,@local_rhosts)) {
+        @local_rdomains and @local_rhosts and
+        (not @registration_hosts or ipin($ra,@registration_hosts))) {
   html_error($error,
     "Registrations from your host ($ra) are not allowed.",
     "Contact $ENV{SERVER_ADMIN} for details."
   html_error($error,
     "Registrations from your host ($ra) are not allowed.",
     "Contact $ENV{SERVER_ADMIN} for details."
index cdc834f71a1163f220c80784b047f936e6cd5080..2457b74936c24bcc2b9e30e113e5eafcaec0589d 100644 (file)
@@ -1,3 +1,14 @@
+2016-09-19 dop: do not show return value of <<perl-code;>> in dynamic html
+                file if this code ends with a ";"
+2016-09-07 new fex.ph config variable $purge
+2016-09-01 dop: removed (forgotten) CGI::Carp
+2016-08-29 fexsend,fexget: update function aborts if new version is not newer
+2016-08-03 added timeout to error output, fixes hanging fup
+2016-08-03 fexsend: fixed bug dangling symlinks raise an error in archive mode
+2016-07-21 fexsrv: map http client headers HTTP-HOST HTTP-VERSION PROXY* to
+                   HTTP_X_HOST HTTP_X_VERSION HTTP_X_PROXY*
+2016-07-11 added missing fex.png fexit.png to distribution
+2016-05-31 fur: fixed bug no external user registration possible
 2016-03-11 fuc: added MIME headers to notification e-mail
 2016-03-08 fexsend: added support for recipient:options
 2016-03-07 fexsend,fexget: added update function to option -V
 2016-03-11 fuc: added MIME headers to notification e-mail
 2016-03-08 fexsend: added support for recipient:options
 2016-03-07 fexsend,fexget: added update function to option -V
diff --git a/doc/SSL b/doc/SSL
index 6eb73bf60c1c9dbf8d349e33b1ec41d88901619f..90e01efd57f9685ba02dfef6c71df080a37a8852 100644 (file)
--- a/doc/SSL
+++ b/doc/SSL
@@ -2,14 +2,27 @@
 
 # execute this as root!
 
 
 # execute this as root!
 
-# Redhat : stunnel-4 does not work! you need to install stunnel-5
-# Debian : stunnel-5.06 does not work! you need to install stunnel-5.18
+# Redhat+CentOS : stunnel does not work! you need to install stunnel-4
+#
+# Debian+Ubuntu : stunnel-5 does not work! you need to install stunnel-4
+#
+# apt-get install gcc make libssl-dev
+# yum install gcc make openssl-devel
+# cd /tmp
+# wget ftp://ftp.nluug.nl/pub/networking/stunnel/archive/4.x/stunnel-4.57.tar.gz
+# tar xvzf stunnel-4.57.tar.gz
+# cd stunnel-4.57
+# ./configure --prefix /opt/stunnel-4.57
+# make
+# make install
+# ln -s /opt/stunnel-4.57/bin/stunnel /usr/local/bin/stunnel4
 
 mkdir /home/fex/etc
 cd /home/fex/etc/
 
 
 mkdir /home/fex/etc
 cd /home/fex/etc/
 
-openssl req -new -x509 -days 9999 -nodes -out stunnel.pem -keyout stunnel.pem
+# create self-signed certificate
 # see http://www.infodrom.org/Debian/tips/stunnel.html
 # see http://www.infodrom.org/Debian/tips/stunnel.html
+openssl req -new -x509 -days 9999 -nodes -out stunnel.pem -keyout stunnel.pem
 dd if=/dev/urandom count=2 | openssl dhparam -rand - 1024 >> stunnel.pem
 openssl x509 -text -in stunnel.pem
 chmod 600 stunnel.pem
 dd if=/dev/urandom count=2 | openssl dhparam -rand - 1024 >> stunnel.pem
 openssl x509 -text -in stunnel.pem
 chmod 600 stunnel.pem
@@ -19,23 +32,26 @@ debug = warning
 output = /home/fex/spool/stunnel.log
 cert = /home/fex/etc/stunnel.pem
 sslVersion = all
 output = /home/fex/spool/stunnel.log
 cert = /home/fex/etc/stunnel.pem
 sslVersion = all
+fips = no
 TIMEOUTclose = 1
 TIMEOUTclose = 1
-exec = perl
-execargs = perl -T /home/fex/bin/fexsrv stunnel
+exec = /home/fex/bin/fexsrv
+execargs = fexsrv stunnel
 EOD
 
 EOD
 
-case $(lsb_release -a 2>/dev/null) in
-  *CentOS*) echo 'fips = no' >>stunnel.conf;;
-esac
+## https://www.stunnel.org/pipermail/stunnel-users/2013-October/004414.html
+#case $(lsb_release -a 2>/dev/null) in
+#  *CentOS*) echo 'fips = no' >>stunnel.conf;;
+#esac
 
 chown -R fex .
 
 stunnel=$(which stunnel4)
 if [ -z "$stunnel" ]; then
 
 chown -R fex .
 
 stunnel=$(which stunnel4)
 if [ -z "$stunnel" ]; then
-  echo "no stunnel found" >&2
-else
+  echo "no stunnel4 found" >&2
+  exit
+fi
 
 
-  cat <<EOD>/etc/xinetd.d/fexs
+cat <<EOD>/etc/xinetd.d/fexs
 # default: on
 # description: fex web server with SSL
 # note: only possible on port 443!
 # default: on
 # description: fex web server with SSL
 # note: only possible on port 443!
@@ -56,11 +72,9 @@ service fexs
 }
 EOD
 
 }
 EOD
 
-  /etc/init.d/xinetd restart
-  echo 'To enforce https, add to fex.ph:'
-  echo '$force_https = 1;'
-
-fi
+/etc/init.d/xinetd restart
+echo 'To enforce https, add to fex.ph:'
+echo '$force_https = 1;'
 
 # Hint: on some systems stunnel works not well with xinetd
 #       you can also run stunnel without xinetd, in server daemon mode
 
 # Hint: on some systems stunnel works not well with xinetd
 #       you can also run stunnel without xinetd, in server daemon mode
index fde990246e95755f6588e603401afad80be72658..6203c4321cf8d104ceec62cd7aee4879af6edb10 100644 (file)
@@ -51,7 +51,7 @@ program "fac" (F*EX admin control) or http://YOURFEXSERVER/fac
 
 Alternativly the users can register theirselves with http://YOURFEXSERVER/fur
 (F*EX user registration), if the admin allows them to do so. This is done by
 
 Alternativly the users can register theirselves with http://YOURFEXSERVER/fur
 (F*EX user registration), if the admin allows them to do so. This is done by
-setting the variables @local_domains and @local_hosts in FEXHOME/lib/fex.ph
+setting the variables @local_domains and @local_hosts in $FEXHOME/lib/fex.ph
 Example:
 
        @local_hosts = qw(127.0.0.1 10.10.100.0-10.10.255.255);
 Example:
 
        @local_hosts = qw(127.0.0.1 10.10.100.0-10.10.255.255);
@@ -146,7 +146,7 @@ and more than once (until expiration date).
 If you want "delay autodelete" to be the default behaviour for all users
 and each transfer then set
        $autodelete = 'DELAY'; # or 'NO' for no autodelete
 If you want "delay autodelete" to be the default behaviour for all users
 and each transfer then set
        $autodelete = 'DELAY'; # or 'NO' for no autodelete
-in FEXHOME/lib/fex.ph
+in $FEXHOME/lib/fex.ph
 
 In addition, you can add to the "Recipient(s)" field of the fup CGI:
 ":autodelete=delay" or ":autodelete=no" or ":keep=x" (where x is the number
 
 In addition, you can add to the "Recipient(s)" field of the fup CGI:
 ":autodelete=delay" or ":autodelete=no" or ":keep=x" (where x is the number
@@ -193,18 +193,18 @@ The administrator can also forbid a user to fex to any recipient address,
 but the allowed ones with: fac -r USER
 
 
 but the allowed ones with: fac -r USER
 
 
-By standard installation the base directory FEXHOME is the same as the
-login HOME of user fex, but you can move it if you want. FEXHOME is
+By standard installation the base directory $FEXHOME is the same as the
+login HOME of user fex, but you can move it if you want. $FEXHOME is
 determined by the full path of fexsrv as configured in
 determined by the full path of fexsrv as configured in
-/etc/xinetd.d/fex . Change this when you move FEXHOME!
+/etc/xinetd.d/fex . Change this when you move $FEXHOME!
 
 You can also add (name based) virtual hosts with fac.
 
 
 You can also add (name based) virtual hosts with fac.
 
-Do not give write permission to any other user to any file in FEXHOME or
+Do not give write permission to any other user to any file in $FEXHOME or
 below!
 
 
 below!
 
 
-FEXHOME contains:
+$FEXHOME contains:
 
        spool/                          spool directory and user data
         htdocs/                                directory for generic download files
 
        spool/                          spool directory and user data
         htdocs/                                directory for generic download files
@@ -273,7 +273,7 @@ A registered full F*EX user is identified by the file $spooldir/$from/@
 Only if this file contains his auth-ID this user is able to send files to
 others. Otherwise he is just an unpriviledged recipient.
 
 Only if this file contains his auth-ID this user is able to send files to
 others. Otherwise he is just an unpriviledged recipient.
 
-You can customize the upload CGI fup by editing FEXHOME/lib/fup.pl
+You can customize the upload CGI fup by editing $FEXHOME/lib/fup.pl
 
 Additional directories in spool:
 
 
 Additional directories in spool:
 
@@ -362,13 +362,13 @@ For streaming receiving you can use "fexget -s-" or "wget -O-".
 
 
 fexsrv also can do generic document output (via dop) like a normal web
 
 
 fexsrv also can do generic document output (via dop) like a normal web
-server. For this, your files must be under FEXHOME/htdocs and they must
-not have the same name as the CGIs under FEXHOME/cgi-bin, because the CGIs
+server. For this, your files must be under $FEXHOME/htdocs and they must
+not have the same name as the CGIs under $FEXHOME/cgi-bin, because the CGIs
 have priority.
 
 For security reasons, documents to be delivered by dop:
 - the file must be readable by group or world
 have priority.
 
 For security reasons, documents to be delivered by dop:
 - the file must be readable by group or world
-- the file must be in FEXHOME/htdocs or a directory specified by @doc_dirs
+- the file must be in $FEXHOME/htdocs or a directory specified by @doc_dirs
 - the filename must not start with a "."
 - the filename must not contain a "@"
 - the filename must not end with "~"
 - the filename must not start with a "."
 - the filename must not contain a "@"
 - the filename must not end with "~"
@@ -387,15 +387,23 @@ fexsrv.
 
 *.html files may contain $VARIABLES$ which will be substituted with the
 value of the corresponding environment variable. See example
 
 *.html files may contain $VARIABLES$ which will be substituted with the
 value of the corresponding environment variable. See example
-$SERVER_ADMIN$ in FEXHOME/htdocs/index.html
+$SERVER_ADMIN$ in $FEXHOME/htdocs/index.html
 
 *.html files may contain <<perl-code>> (even multiline) which will be
 
 *.html files may contain <<perl-code>> (even multiline) which will be
-evaluated and its output will be placed in. Same goes for <<<perl-code>>>
-but without output catching.
-See example FEXHOME/htdocs/dynamic.html
-This perl-code must not contain '>>' strings itself!
+evaluated. The output from print and printf statements will be placed
+in. If the perl-code does not end with a ";" then its return value is also
+added to the output.
+
+Same goes for <<<perl-code>>> but without output catching.
+
+This perl-code must not contain ">>" strings itself!
+
+See example $FEXHOME/htdocs/dynamic.html
+
+To chainload external perl-code do not use "require" but "do" statement.
 Pay attention: do not place security relevant data inside << >> because it
 Pay attention: do not place security relevant data inside << >> because it
-will be delivered to the client if the URL ends with '!'! See example:
+will be delivered to the client if the URL ends with a "!" character, see
+example:
 http://fex.rus.uni-stuttgart.de/index.html
 http://fex.rus.uni-stuttgart.de/index.html!
 
 http://fex.rus.uni-stuttgart.de/index.html
 http://fex.rus.uni-stuttgart.de/index.html!
 
diff --git a/doc/new b/doc/new
index badf3223b8e7ff6a7e43b8aaf02aeb41bf19069b..bcd8be89ff30a8a4e6a31871ea0562397c660189 100644 (file)
--- a/doc/new
+++ b/doc/new
@@ -2,11 +2,6 @@ New release on http://fex.belwue.de/fex.html
 
 Important changes:
 
 
 Important changes:
 
-- recipient address can have attached :options (keep,autodelete,locale)
-
-- added config variable @extra_header with default HTTP security headers,
-  see: https://securityheaders.io/?q=http%3A%2F%2Ffex.belwue.de
-
-- dynamic HTML runs in own Perl namespace (DOP)
+- new fex.ph config variable $purge
 
 - fixed various bugs
 
 - fixed various bugs
index 7b735e5e5fc7a8bb7b26e20ebaec6a21d3e6e735..d9e31cbb8bfd3af585d001e66e4819a721f92582 100644 (file)
@@ -1 +1 @@
-fex-20160328
+fex-20160919
index 61691fcbddbaa96fdf4f645641af6240e6607a3c..1f7c4048283c8dc3a9c2f4208967d37d250b0f6d 100644 (file)
@@ -2,7 +2,7 @@ Q: I cannot install a web server like fexsrv, because I have no root permissions
 A: F*EX is hard bound to fexsrv for several reasons (performance, file size limit, session concept, etc) and cannot be run as CGI under apache. But you might have a look at
 
    * https://github.com/FileZ/FileZ
 A: F*EX is hard bound to fexsrv for several reasons (performance, file size limit, session concept, etc) and cannot be run as CGI under apache. But you might have a look at
 
    * https://github.com/FileZ/FileZ
-   * http://freshmeat.net/projects/eventh/
+   * https://github.com/jlmeeker/evh2
    * http://www.schaarwaechter.de/sp/projekte/dateiaustausch.html (German only!)
 
    which implement a file exchange as pure CGIs, but with a 2 GB file size limit, which F*EX does not have.
    * http://www.schaarwaechter.de/sp/projekte/dateiaustausch.html (German only!)
 
    which implement a file exchange as pure CGIs, but with a 2 GB file size limit, which F*EX does not have.
index a0966457f9f3c8217371e44dca51636c0e3900ef..9585c6998968fc383a7549d7565c99183bb85f5a 100644 (file)
@@ -2,11 +2,14 @@
 <head><title>F*EX FAQ</title></head>
 <body>
 
 <head><title>F*EX FAQ</title></head>
 <body>
 
+## << do "./xx.pl" or print $! >>
+## << $_ = `pwd` >>
+
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
-<< require "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
 
 </body>
 </html>
 
 </body>
 </html>
index a0966457f9f3c8217371e44dca51636c0e3900ef..9585c6998968fc383a7549d7565c99183bb85f5a 100644 (file)
@@ -2,11 +2,14 @@
 <head><title>F*EX FAQ</title></head>
 <body>
 
 <head><title>F*EX FAQ</title></head>
 <body>
 
+## << do "./xx.pl" or print $! >>
+## << $_ = `pwd` >>
+
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
-<< require "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
 
 </body>
 </html>
 
 </body>
 </html>
index 3a2fcff4d4c894ea64c38e8547efcc229202807a..0e484b9364f7f65ef693ae54cd9ff1386ffe393e 100644 (file)
@@ -140,3 +140,5 @@ sub anchor {
   s/_+$//;
   return $_;
 }
   s/_+$//;
   return $_;
 }
+
+' ';
index a0966457f9f3c8217371e44dca51636c0e3900ef..9585c6998968fc383a7549d7565c99183bb85f5a 100644 (file)
@@ -2,11 +2,14 @@
 <head><title>F*EX FAQ</title></head>
 <body>
 
 <head><title>F*EX FAQ</title></head>
 <body>
 
+## << do "./xx.pl" or print $! >>
+## << $_ = `pwd` >>
+
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
-<< require "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
 
 </body>
 </html>
 
 </body>
 </html>
index f91062103100257828696b1d6e6854902f26e6e3..09fe46f8b2d09494c05e65875f95f58dfb510141 100644 (file)
@@ -70,7 +70,7 @@ A: For example:
    * European Commission Institute for Energy and Transport http://fex.jrc.nl
    * High Performance Computing Center Stuttgart http://fex.hlrs.de
    * Swiss National Supercomputing Centre http://fex.cscs.ch
    * European Commission Institute for Energy and Transport http://fex.jrc.nl
    * High Performance Computing Center Stuttgart http://fex.hlrs.de
    * Swiss National Supercomputing Centre http://fex.cscs.ch
-   * Centre National de la Recherche Scientifique (French National Center for Scientific Research) http://bigfiles.cnrs-gif.fr
+   * Centre National de la Recherche Scientifique http://bigfiles.cnrs-gif.fr
    * Institut Pasteur http://dl.pasteur.fr
    * Justus Liebig University http://fex.hrz.uni-giessen.de
    * Fiat Chrysler https://fex.fiatitem.com/
    * Institut Pasteur http://dl.pasteur.fr
    * Justus Liebig University http://fex.hrz.uni-giessen.de
    * Fiat Chrysler https://fex.fiatitem.com/
index a0966457f9f3c8217371e44dca51636c0e3900ef..9585c6998968fc383a7549d7565c99183bb85f5a 100644 (file)
@@ -2,11 +2,14 @@
 <head><title>F*EX FAQ</title></head>
 <body>
 
 <head><title>F*EX FAQ</title></head>
 <body>
 
+## << do "./xx.pl" or print $! >>
+## << $_ = `pwd` >>
+
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
-<< require "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
 
 </body>
 </html>
 
 </body>
 </html>
index a0966457f9f3c8217371e44dca51636c0e3900ef..9585c6998968fc383a7549d7565c99183bb85f5a 100644 (file)
@@ -2,11 +2,14 @@
 <head><title>F*EX FAQ</title></head>
 <body>
 
 <head><title>F*EX FAQ</title></head>
 <body>
 
+## << do "./xx.pl" or print $! >>
+## << $_ = `pwd` >>
+
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
-<< require "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
 
 </body>
 </html>
 
 </body>
 </html>
index a0966457f9f3c8217371e44dca51636c0e3900ef..9585c6998968fc383a7549d7565c99183bb85f5a 100644 (file)
@@ -2,11 +2,14 @@
 <head><title>F*EX FAQ</title></head>
 <body>
 
 <head><title>F*EX FAQ</title></head>
 <body>
 
+## << do "./xx.pl" or print $! >>
+## << $_ = `pwd` >>
+
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
-<< require "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
 
 </body>
 </html>
 
 </body>
 </html>
diff --git a/htdocs/FAQ/xx.html b/htdocs/FAQ/xx.html
new file mode 100644 (file)
index 0000000..3c8eb43
--- /dev/null
@@ -0,0 +1,15 @@
+<html>
+<head><title>F*EX FAQ</title></head>
+<body>
+
+## << do "./xx.pl" or print $! >>
+## << $_ = `pwd` >>
+
+## <pre>
+## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
+## </pre>
+
+<< require "./xx.pl"; >>
+
+</body>
+</html>
diff --git a/htdocs/FAQ/xx.pl b/htdocs/FAQ/xx.pl
new file mode 100755 (executable)
index 0000000..68e45b4
--- /dev/null
@@ -0,0 +1,6 @@
+package FAQ;
+
+print "abc\n";
+printf "1 2 3\n";
+print "___\n";
+1;
diff --git a/htdocs/FAQ/zz.pl b/htdocs/FAQ/zz.pl
new file mode 100644 (file)
index 0000000..0f57817
--- /dev/null
@@ -0,0 +1 @@
+0;
index b0616a16fe5653e4d7830bb24116f34b6d2e30c6..3ac605f51f571676dad713d63bb88a2b7d74751e 100755 (executable)
@@ -13,6 +13,7 @@ use strict qw'vars subs';
 use Config;
 use POSIX;
 use Encode;
 use Config;
 use POSIX;
 use Encode;
+use Cwd 'abs_path';
 use Getopt::Std;
 use File::Basename;
 use Socket;
 use Getopt::Std;
 use File::Basename;
 use Socket;
@@ -30,7 +31,7 @@ our $SH;
 our ($fexhome,$idf,$tmpdir,$windoof,$useragent);
 our ($xv,%autoview);
 our $bs = 2**16; # blocksize for tcp-reading and writing file
 our ($fexhome,$idf,$tmpdir,$windoof,$useragent);
 our ($xv,%autoview);
 our $bs = 2**16; # blocksize for tcp-reading and writing file
-our $version = 20160328;
+our $version = 20160919;
 our $CTYPE = 'ISO-8859-1';
 our $fexsend = $ENV{FEXSEND} || 'fexsend';
 our $DEBUG = $ENV{DEBUG};
 our $CTYPE = 'ISO-8859-1';
 our $fexsend = $ENV{FEXSEND} || 'fexsend';
 our $DEBUG = $ENV{DEBUG};
@@ -89,6 +90,7 @@ usage: $0 [-v] [-m limit] [-s filename] [-o] [-k] [-X] [-P proxy:port] F*EX-URL(
    or: $0 [-v] -a
    or: $0 -l [-i tag]
    or: $0 -H
    or: $0 [-v] -a
    or: $0 -l [-i tag]
    or: $0 -H
+   or: $0 -V
 options: -v verbose mode
          -m limit kB/s
          -s save to filename (-s- means: write to STDOUT/pipe)
 options: -v verbose mode
          -m limit kB/s
          -s save to filename (-s- means: write to STDOUT/pipe)
@@ -102,6 +104,7 @@ options: -v verbose mode
          -i tag alternate server/account, see: $fexsend -h
          -P use Proxy for connection to the F*EX server
          -H show hints and examples
          -i tag alternate server/account, see: $fexsend -h
          -P use Proxy for connection to the F*EX server
          -H show hints and examples
+         -V show version and ask for upgrade
 argument: F*EX-URL may be file number (see: $0 -l)
 EOD
 
 argument: F*EX-URL may be file number (see: $0 -l)
 EOD
 
@@ -167,10 +170,15 @@ if ($opt_V) {
     $_ = <STDIN>||'';
     if (/^y/i) {
       my $new = `wget -nv -O- http://fex.belwue.de/download/fexget`;
     $_ = <STDIN>||'';
     if (/^y/i) {
       my $new = `wget -nv -O- http://fex.belwue.de/download/fexget`;
-      if ($new !~ /upgrade fexget/) {
+      my $newversion = $1 if $new =~ /version = (\d+)/;
+      if ($new !~ /upgrade fexget/ or not $newversion) {
         die "$0: bad update\n";
       }
         die "$0: bad update\n";
       }
-      system qw'cp -a',$_0,$_0.'_old';
+      if ($newversion <= $version) {
+        die "$0: no newer version\n";
+      }
+      $_0 = abs_path($_0);
+      system qw'rsync -a',$_0,$_0.'_old';
       exit $? if $?;
       open $_0,'>',$_0 or die "$0: cannot write $_0. - $!\n";
       print {$_0} $new;
       exit $? if $?;
       open $_0,'>',$_0 or die "$0: cannot write $_0. - $!\n";
       print {$_0} $new;
@@ -178,6 +186,7 @@ if ($opt_V) {
       exec $_0,qw'-V .';
     }
   }
       exec $_0,qw'-V .';
     }
   }
+  exit;
   exit if "@ARGV" eq '.';
 }
 
   exit if "@ARGV" eq '.';
 }
 
@@ -328,7 +337,7 @@ URL: foreach my $url (@ARGV) {
       ($file) = grep { $_ = $1 if /^X-File:\s+(.+)/ } @r;
       $file = $url unless $file;
       $file =~ s:.*/::;
       ($file) = grep { $_ = $1 if /^X-File:\s+(.+)/ } @r;
       $file = $url unless $file;
       $file =~ s:.*/::;
-      printf "%s deleted\n",urldecode($file);
+      printf "%s deleted\n",locale(decode_utf8(urldecode($file)));
     } else {
       s:HTTP/[\d\. ]+::;
       die "$0: server response: $_";
     } else {
       s:HTTP/[\d\. ]+::;
       die "$0: server response: $_";
index f47bed4cc3ac51705665a63ee0d07a5b8e2f353a..fae77e9b79e977a1819e98b9345ea3e6fa54de3f 100755 (executable)
@@ -17,10 +17,10 @@ use IO::Handle;
 use IO::Socket::INET;
 use Getopt::Std;
 use File::Basename;
 use IO::Socket::INET;
 use Getopt::Std;
 use File::Basename;
-use Cwd qw'abs_path';
+use Cwd 'abs_path';
 use Fcntl qw':flock :mode';
 use Fcntl qw':flock :mode';
-use Digest::MD5 qw'md5_hex';  # encrypted ID / SID
-use Time::HiRes qw'time';
+use Digest::MD5 'md5_hex';  # encrypted ID / SID
+use Time::HiRes 'time';
 # use Smart::Comments;
 use constant k => 2**10;
 use constant M => 2**20;
 # use Smart::Comments;
 use constant k => 2**10;
 use constant M => 2**20;
@@ -37,7 +37,7 @@ our ($tpid,$frecipient);
 our ($FEXID,$FEXXX,$HOME);
 our (%alias);
 our $chunksize = 0;
 our ($FEXID,$FEXXX,$HOME);
 our (%alias);
 our $chunksize = 0;
-our $version = 20160328;
+our $version = 20160919;
 our $_0 = $0;
 our $DEBUG = $ENV{DEBUG};
 
 our $_0 = $0;
 our $DEBUG = $ENV{DEBUG};
 
@@ -248,6 +248,14 @@ Partner program xx is an internet clipboard. See: xx -h
 
 Partner program fexget is for downloading. See: fexget -h
 
 
 Partner program fexget is for downloading. See: fexget -h
 
+fexsend stores the login data (server, user and auth-ID) in the file
+$HOME/.fex/id
+The format of this file is ([data] is optional):
+
+server-URL[!proxy[:port[:chunk-size]]
+e-mail-address
+auth-ID
+
 For temporary usage of a HTTP proxy use:
   $0 -P your_proxy:port:chunksize_in_MB file recipient
 Example:
 For temporary usage of a HTTP proxy use:
   $0 -P your_proxy:port:chunksize_in_MB file recipient
 Example:
@@ -361,10 +369,15 @@ if ($xx) {
       $_ = <STDIN>||'';
       if (/^y/i) {
         my $new = `wget -nv -O- http://fex.belwue.de/download/fexsend`;
       $_ = <STDIN>||'';
       if (/^y/i) {
         my $new = `wget -nv -O- http://fex.belwue.de/download/fexsend`;
-        if ($new !~ /upgrade fexsend/) {
+        my $newversion = $1 if $new =~ /version = (\d+)/;
+        if ($new !~ /upgrade fexsend/ or not $newversion) {
           die "$0: bad update\n";
         }
           die "$0: bad update\n";
         }
-        system qw'cp -aL',$_0,$_0.'_old';
+        if ($newversion <= $version) {
+          die "$0: no newer version\n";
+        }
+        $_0 = abs_path($_0);
+        system qw'rsync -a',$_0,$_0.'_old';
         exit $? if $?;
         open $_0,'>',$_0 or die "$0: cannot write $_0. - $!\n";
         print {$_0} $new;
         exit $? if $?;
         open $_0,'>',$_0 or die "$0: cannot write $_0. - $!\n";
         print {$_0} $new;
@@ -372,6 +385,7 @@ if ($xx) {
         exec $_0,qw'-V .';
       }
     }
         exec $_0,qw'-V .';
       }
     }
+    exit;
     exit if "@ARGV" eq '.';
   }
 
     exit if "@ARGV" eq '.';
   }
 
@@ -3206,9 +3220,10 @@ sub query_sid {
   $sid = $id;
 
   if ($port eq 443 or $proxy) {
   $sid = $id;
 
   if ($port eq 443 or $proxy) {
+    return if $opt_d;
     return if $features;    # early return if we know enough
     return if $features;    # early return if we know enough
-    $req = "OPTIONS /FEX HTTP/1.1";
-    $req = "HEAD /index.html HTTP/1.1";
+    $req = "OPTIONS /FEX HTTP/1.1"; # does not work with (some) proxies
+    $req = "GET /SID HTTP/1.1";     # needed as FEATURES query
   } else {
     $req = "GET /SID HTTP/1.1";
   }
   } else {
     $req = "GET /SID HTTP/1.1";
   }
@@ -3469,7 +3484,8 @@ sub readahead {
 
 sub fileid {
   my $file = shift;
 
 sub fileid {
   my $file = shift;
-  my @s = stat($file);
+  my $dirmode = shift;
+  my @s = $dirmode ? lstat($file) : stat($file);
 
   if (@s) {
     return md5_hex($file.$s[0].$s[1].$s[7].$s[9]);
 
   if (@s) {
     return md5_hex($file.$s[0].$s[1].$s[7].$s[9]);
@@ -3528,6 +3544,9 @@ sub fmd {
           next if $file eq '..';
           if ($file eq '.') {
             $fmd .= fileid($dir);
           next if $file eq '..';
           if ($file eq '.') {
             $fmd .= fileid($dir);
+          } elsif (-l "$dir/$file") {
+            # hack for dangling symlinks: do not raise an error
+            $fmd .= fileid("$dir/$file",'dirmode');
           } else {
             $fmd .= fmd("$dir/$file");
           }
           } else {
             $fmd .= fmd("$dir/$file");
           }
index 9a7d48b3e9872e6985e6d5b3e568f11476d8c9b3..8b9e1d1e94c981225b266e4a4f74256ada87ce0e 100755 (executable)
@@ -19,7 +19,7 @@ use constant M => 2**20;
 
 eval 'use Net::INET6Glue::INET_is_INET6';
 
 
 eval 'use Net::INET6Glue::INET_is_INET6';
 
-our $version = 20160328;
+our $version = 20160919;
 our $DEBUG = $ENV{DEBUG};
 
 my %SSL = (SSL_version => 'TLSv1');
 our $DEBUG = $ENV{DEBUG};
 
 my %SSL = (SSL_version => 'TLSv1');
diff --git a/htdocs/fex.png b/htdocs/fex.png
new file mode 100644 (file)
index 0000000..a9ac834
Binary files /dev/null and b/htdocs/fex.png differ
index ce281d3f9ddeb81a9f8d5f2a0e5bae46fe534440..f825d30dec6baaee4fbb9c43ecffcfe122d5ea69 100644 (file)
@@ -35,8 +35,9 @@ You can also drag files or directories to the fexit icon with the Windows
 explorer.
 <p>
 With <a href="$FEXIT$">fexit</a> you also have access to the
 explorer.
 <p>
 With <a href="$FEXIT$">fexit</a> you also have access to the
-<a href="/usecases/xx.html">F*EX internet clipboard</a> to exchange files
-between your Windows or UNIX accounts.
+<a href="http://fex.rus.uni-stuttgart.de/usecases/xx.html">
+F*EX internet clipboard</a>
+to exchange files between your Windows or UNIX accounts.
 <p>
 <a href="$FEXIT$"><img src='fexit.png'></a>
 <p>
 <p>
 <a href="$FEXIT$"><img src='fexit.png'></a>
 <p>
diff --git a/htdocs/fexit.png b/htdocs/fexit.png
new file mode 100644 (file)
index 0000000..585afae
Binary files /dev/null and b/htdocs/fexit.png differ
index 7b735e5e5fc7a8bb7b26e20ebaec6a21d3e6e735..d9e31cbb8bfd3af585d001e66e4819a721f92582 100644 (file)
@@ -1 +1 @@
-fex-20160328
+fex-20160919
diff --git a/install b/install
index 7019bee3826e22a1bd46dc855e4d09a9722f40e2..c300815685cafff88ce63e82f0cd9ca5b3dd18d1 100755 (executable)
--- a/install
+++ b/install
@@ -163,6 +163,12 @@ if ($FEXHOME !~ /fex/) {
   exit unless /^y/i;
 }
 
   exit unless /^y/i;
 }
 
+# old bug fix
+if (-d "$FEXHOME/htdocs/locale") {
+  chmod 0755,"$FEXHOME/htdocs/locale";
+  chmod 0755,grep { -d $_ } glob("$FEXHOME/locale/*/htdocs");
+}
+
 print "Installing:\n";
 
 $pecl = "$FEXHOME/perl/Encode/ConfigLocal.pm";
 print "Installing:\n";
 
 $pecl = "$FEXHOME/perl/Encode/ConfigLocal.pm";
@@ -175,7 +181,7 @@ unless (-f $pecl) {
     "1;\n";
   close $pecl;
   print $pecl,"\n";
     "1;\n";
   close $pecl;
   print $pecl,"\n";
-  chownr('fex:root',"$FEXHOME/perl");
+  chownr('fex:0',"$FEXHOME/perl");
 }
 
 @save = (
 }
 
 @save = (
@@ -388,7 +394,7 @@ unless (-f $xinetd) {
     system qw'crontab -u fex fex.cron';
   }
 
     system qw'crontab -u fex fex.cron';
   }
 
-  chownr('fex:root',$FEXHOME,"$FEXHOME/spool/.","$FEXHOME/htdocs/.");
+  chownr('fex:0',$FEXHOME,"$FEXHOME/spool/.","$FEXHOME/htdocs/.");
   chmodr('go-r',"$FEXHOME/lib","$FEXHOME/cgi-bin","$FEXHOME/spool/.");
 
   print "\n";
   chmodr('go-r',"$FEXHOME/lib","$FEXHOME/cgi-bin","$FEXHOME/spool/.");
 
   print "\n";
@@ -406,9 +412,6 @@ unless (-f $xinetd) {
         "< $FEXHOME/doc/newfeatures\n";
 }
 
         "< $FEXHOME/doc/newfeatures\n";
 }
 
-chmod 0755,"$FEXHOME/htdocs/locale";
-chmod 0755,glob("$FEXHOME/locale/*/htdocs");
-  
 if (@local_rdomains and not @local_rhosts) {
   print "\nWARNING:\n";
   print "In $fph you have \@local_rdomains but not \@local_rhosts!\n";
 if (@local_rdomains and not @local_rhosts) {
   print "\nWARNING:\n";
   print "In $fph you have \@local_rdomains but not \@local_rhosts!\n";
diff --git a/lib/dop b/lib/dop
index dc92d7008fdd07f6a2fb43080ccb06f0a513689b..4a6ece03ec5552468e6ec68fbb2d4e33a290f868 100755 (executable)
--- a/lib/dop
+++ b/lib/dop
@@ -8,11 +8,11 @@
 #
 
 use File::Basename;
 #
 
 use File::Basename;
-use CGI::Carp  qw(fatalsToBrowser);
 use Fcntl      qw(:flock :seek :mode);
 use POSIX      qw(strftime locale_h);
 use Cwd        qw(getcwd abs_path);
 use utf8;
 use Fcntl      qw(:flock :seek :mode);
 use POSIX      qw(strftime locale_h);
 use Cwd        qw(getcwd abs_path);
 use utf8;
+# use CGI::Carp        qw(fatalsToBrowser);
 
 # import from fex.pp
 our ($bs,$tmpdir,@doc_dirs);
 
 # import from fex.pp
 our ($bs,$tmpdir,@doc_dirs);
@@ -126,10 +126,16 @@ sub http_output {
     foreach (@files) {
       if (/^\// or /\.\.\//) {
         # absolute path or relative path with parent directory is not allowed
     foreach (@files) {
       if (/^\// or /\.\.\//) {
         # absolute path or relative path with parent directory is not allowed
+        errorlog("$streamfile: $_ is not allowed for streaming");
+        http_error(403);
+      }
+      unless (-e $_) {
+        errorlog("$streamfile: $_ does not exist");
         http_error(403);
       }
       if (@s = stat($_) and not($s[2] & S_IRGRP) or not -r $_) {
         # file must be readable by user and group
         http_error(403);
       }
       if (@s = stat($_) and not($s[2] & S_IRGRP) or not -r $_) {
         # file must be readable by user and group
+        errorlog("$streamfile: $_ is not readable by user and group");
         http_error(403);
       }
     }
         http_error(403);
       }
     }
@@ -238,8 +244,10 @@ sub http_output {
         } else {
           # eval code with output substitution
           local $__ = '';
         } else {
           # eval code with output substitution
           local $__ = '';
+          local $^W = 0;
           tie *STDOUT => "Buffer",\$__;
           tie *STDOUT => "Buffer",\$__;
-          $__ .= eval('package DOP;' . $pc);
+          my $r .= eval('package DOP;' . $pc);
+          $__ .= $r if $pc !~ /;\s*$/;
           untie *STDOUT;
           last if $timeout;
           $dynamic = $htmldoc =~ s/<<(.+?)>>/$__/s;
           untie *STDOUT;
           last if $timeout;
           $dynamic = $htmldoc =~ s/<<(.+?)>>/$__/s;
@@ -603,7 +611,7 @@ sub out {
   return '';
 }
 
   return '';
 }
 
-# tie STDOUT to buffer variable (redefining print)
+# tie STDOUT to buffer variable (redefining print and printf)
 package Buffer;
 
 sub TIEHANDLE {
 package Buffer;
 
 sub TIEHANDLE {
index c69943d31ecf87fb977140e6d35062c55278e8b9..d1596e248c2c7962cc0373d967405b9cc531d6de 100644 (file)
@@ -85,6 +85,10 @@ $keep_max = 99;
 ##     NO      ==> keep until expiration date (see $keep)
 $autodelete = 'YES';
 
 ##     NO      ==> keep until expiration date (see $keep)
 $autodelete = 'YES';
 
+## purge: purge files after that number of days after their deletion
+##        (purge deletes file meta-information)
+$purge = '3*$keep';
+
 ## if the file has been already downloaded then subsequentials
 ## downloads are only allowed from the same client (uses cookies)
 ## to prevent unwanted file sharing
 ## if the file has been already downloaded then subsequentials
 ## downloads are only allowed from the same client (uses cookies)
 ## to prevent unwanted file sharing
@@ -137,6 +141,13 @@ $mail_authid = 'YES';
 ## optional: forbidden ip addresses for CGIs
 # @forbidden_hosts = qw(64.124.0.0-64.125.255.255);
 
 ## optional: forbidden ip addresses for CGIs
 # @forbidden_hosts = qw(64.124.0.0-64.125.255.255);
 
+# forbidden user agents (sucking "download manager", etc)
+@forbidden_user_agents = qw(
+  FDM
+  Download.Master
+  Java/[\d\.]+
+);
+
 ## optional: restrict upload to these IP ranges
 # @upload_hosts = qw(127.0.0.1 ::1 10.10.100.0-10.10.200.255 129.69.1.129);
 
 ## optional: restrict upload to these IP ranges
 # @upload_hosts = qw(127.0.0.1 ::1 10.10.100.0-10.10.200.255 129.69.1.129);
 
index 8bfddbf550276afad07c019c7c35b6820cd168f5..177babac657e927a0cb175aa3d5785bb6363beae 100644 (file)
@@ -62,6 +62,7 @@ $fop_auth = 0;
 $mail_authid = 'yes';
 $force_https = 0;
 $debug = 0;
 $mail_authid = 'yes';
 $force_https = 0;
 $debug = 0;
+@forbidden_user_agents = ('FDM');
 
 # https://securityheaders.io/
 # https://scotthelme.co.uk/hardening-your-http-response-headers/
 
 # https://securityheaders.io/
 # https://scotthelme.co.uk/hardening-your-http-response-headers/
@@ -124,6 +125,7 @@ http_die("cannot determine the server hostname") unless $hostname;
 
 $ENV{PROTO} = 'http' unless $ENV{PROTO};
 $keep = $keep_default ||= $keep || 5;
 
 $ENV{PROTO} = 'http' unless $ENV{PROTO};
 $keep = $keep_default ||= $keep || 5;
+$purge ||= 3*$keep;
 $fra = $ENV{REMOTE_ADDR} || '';
 $sid = $ENV{SID} || '';
 
 $fra = $ENV{REMOTE_ADDR} || '';
 $sid = $ENV{SID} || '';
 
@@ -320,6 +322,8 @@ sub html_header {
   my $header = 'header.html';
   my $head;
 
   my $header = 'header.html';
   my $head;
 
+  binmode(STDOUT,':utf8'); # for text/html !
+
   # http://www.w3.org/TR/html401/struct/global.html
   # http://www.w3.org/International/O-charset
   $head = qqq(qq(
   # http://www.w3.org/TR/html401/struct/global.html
   # http://www.w3.org/International/O-charset
   $head = qqq(qq(
@@ -370,6 +374,12 @@ sub html_error {
 
   errorlog($msg);
 
 
   errorlog($msg);
 
+  $SIG{ALRM} = sub {
+    $SIG{__DIE__} = 'DEFAULT';
+    die "TIMEOUT\n";
+  };
+  alarm($timeout);
+
   # cannot send standard HTTP Status-Code 400, because stupid
   # Internet Explorer then refuses to display HTML body!
   http_header("666 Bad Request - $msg");
   # cannot send standard HTTP Status-Code 400, because stupid
   # Internet Explorer then refuses to display HTML body!
   http_header("666 Bad Request - $msg");
index a0966457f9f3c8217371e44dca51636c0e3900ef..9585c6998968fc383a7549d7565c99183bb85f5a 100644 (file)
@@ -2,11 +2,14 @@
 <head><title>F*EX FAQ</title></head>
 <body>
 
 <head><title>F*EX FAQ</title></head>
 <body>
 
+## << do "./xx.pl" or print $! >>
+## << $_ = `pwd` >>
+
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
-<< require "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
 
 </body>
 </html>
 
 </body>
 </html>
index a0966457f9f3c8217371e44dca51636c0e3900ef..9585c6998968fc383a7549d7565c99183bb85f5a 100644 (file)
@@ -2,11 +2,14 @@
 <head><title>F*EX FAQ</title></head>
 <body>
 
 <head><title>F*EX FAQ</title></head>
 <body>
 
+## << do "./xx.pl" or print $! >>
+## << $_ = `pwd` >>
+
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
-<< require "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
 
 </body>
 </html>
 
 </body>
 </html>
index a0966457f9f3c8217371e44dca51636c0e3900ef..9585c6998968fc383a7549d7565c99183bb85f5a 100644 (file)
@@ -2,11 +2,14 @@
 <head><title>F*EX FAQ</title></head>
 <body>
 
 <head><title>F*EX FAQ</title></head>
 <body>
 
+## << do "./xx.pl" or print $! >>
+## << $_ = `pwd` >>
+
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
-<< require "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
 
 </body>
 </html>
 
 </body>
 </html>
index a0966457f9f3c8217371e44dca51636c0e3900ef..9585c6998968fc383a7549d7565c99183bb85f5a 100644 (file)
@@ -2,11 +2,14 @@
 <head><title>F*EX FAQ</title></head>
 <body>
 
 <head><title>F*EX FAQ</title></head>
 <body>
 
+## << do "./xx.pl" or print $! >>
+## << $_ = `pwd` >>
+
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
-<< require "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
 
 </body>
 </html>
 
 </body>
 </html>
index a0966457f9f3c8217371e44dca51636c0e3900ef..9585c6998968fc383a7549d7565c99183bb85f5a 100644 (file)
@@ -2,11 +2,14 @@
 <head><title>F*EX FAQ</title></head>
 <body>
 
 <head><title>F*EX FAQ</title></head>
 <body>
 
+## << do "./xx.pl" or print $! >>
+## << $_ = `pwd` >>
+
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
-<< require "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
 
 </body>
 </html>
 
 </body>
 </html>
index a0966457f9f3c8217371e44dca51636c0e3900ef..9585c6998968fc383a7549d7565c99183bb85f5a 100644 (file)
@@ -2,11 +2,14 @@
 <head><title>F*EX FAQ</title></head>
 <body>
 
 <head><title>F*EX FAQ</title></head>
 <body>
 
+## << do "./xx.pl" or print $! >>
+## << $_ = `pwd` >>
+
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
 ## <pre>
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ## </pre>
 
-<< require "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
 
 </body>
 </html>
 
 </body>
 </html>
index 25f104412c90d024edb47952bc4fa5b7d040fc8d..e36d3ab2f4926ad0b77f50c636d3e7fc454ded76 100644 (file)
@@ -2729,7 +2729,7 @@ Your F*EX account has been inactive for $expire days
 Ihr F*EX Account ist seit $expire Tagen inaktiv
 Du hosch dei F*EX Konto seit $expire Tag nemme bnutzt
 Su cuenta de F*EX ha estado inactivo $expire dias
 Ihr F*EX Account ist seit $expire Tagen inaktiv
 Du hosch dei F*EX Konto seit $expire Tag nemme bnutzt
 Su cuenta de F*EX ha estado inactivo $expire dias
-A súa conta F*EX estivo inactiva durante $expire día
+A súa conta F*EX estivo inactiva durante $expire día
 Il tuo account F*EX è stato inattivo per $expire giorni
 Váš F*EX účet byl neaktivní $expire dnů
 Votre compte F*EX a été inactif pendant $expire days
 Il tuo account F*EX è stato inattivo per $expire giorni
 Váš F*EX účet byl neaktivní $expire dnů
 Votre compte F*EX a été inactif pendant $expire days