2016-09-19: dop: do not show return value of <<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
-#!/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
- ezz "s/ /_/g"
+ ezz 's/ /_/g'
ezz head -3
ezz - head -3
-
-Limitation: zz does not work across different accounts!
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;
+}
our ($SH,$windoof,$sigpipe,$useragent);
our ($FEXSERVER);
-our $version = 20160328;
+our $version = 20160919;
# server defaults
my $server = 'fex.rus.uni-stuttgart.de';
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";
sub cleanup {
my ($to,$from,$file) = @_;
my ($data,$download,$notify,$mtime,$warn,$dir,$filename,$dkey,$delay);
- my $comment = '';
my $keep = $keep_default;
+ my $purge = $::purge || 3*$keep;
+ my $comment = '';
my $kf = "$to/$from/$file/keep";
my $ef = "$to/$from/$file/error";
local $_;
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 {
use Config;
use POSIX;
use Encode;
+use Cwd 'abs_path';
use Getopt::Std;
use File::Basename;
use Socket;
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};
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)
-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
$_ = <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";
}
- 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;
exec $_0,qw'-V .';
}
}
+ exit;
exit if "@ARGV" eq '.';
}
($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: $_";
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 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;
our ($FEXID,$FEXXX,$HOME);
our (%alias);
our $chunksize = 0;
-our $version = 20160328;
+our $version = 20160919;
our $_0 = $0;
our $DEBUG = $ENV{DEBUG};
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:
$_ = <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";
}
- 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;
exec $_0,qw'-V .';
}
}
+ exit;
exit if "@ARGV" eq '.';
}
$sid = $id;
if ($port eq 443 or $proxy) {
+ return if $opt_d;
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";
}
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]);
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");
}
# 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 {
# 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)
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 $@;
if ($uri =~ /\\|%5c/i) { badchar("\\") }
}
+ my $fua = join('|',@forbidden_user_agents);
+
while ($_ = shift @header) {
# header inquisition!
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:.*,/) {
}
# HTTP header ==> environment variables
- if (/^([\w\-]+):\s*(.+)/s) {
+ if (/^([\w\-_]+):\s*(.+)/s) {
$http_var = $1;
$http_val = $2;
$http_var =~ s/-/_/g;
} 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;
}
#
# Programname: fpg - Frams' Perl grep
# Author: framstag@rus.uni-stuttgart.de
-# Copyright: GPL
+# Licence: Perl Artistic
#
# 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 -~
+# 2016-06-12 Framstag option -o respects (match)
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
-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
#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;
$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) {
- $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)) {
} 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;
}
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 {
# 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'};
$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;
my @files = @_;
my $f;
+ getacl(@files) if $opt_l and not $opt_n;
+
# loop over all argument files/directories
foreach $f (@files) {
$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) {
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 }
} 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 {
- 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 }
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
- . (-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;
}
}
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)
warn "$0: cannot read $dir : $!\n";
}
+ getacl(@dirs,@files) if $opt_l and not $opt_n;
return (@dirs,@files);
}
}
+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
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
-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
}
$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/) {};
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) {
eval 'use Net::INET6Glue::INET_is_INET6';
-our $version = 20160328;
+our $version = 20160919;
our $DEBUG = $ENV{DEBUG};
my %SSL = (SSL_version => 'TLSv1');
-#!/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>
-# 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
- (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
-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;
+}
if ($PARAM{"editUser"} =~ /^#.*/) {
&editRestrictionsForm;
} else {
+ $user = normalize_user($PARAM{"editUser"});
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 {
- editUser($PARAM{"editUser"});
+ editUser($user);
}
}
} elsif ($PARAM{"contentBox"} and $PARAM{"ar"}) {
&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 - $!");;
&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');
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;
}
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."
+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
# 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/
-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
+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
output = /home/fex/spool/stunnel.log
cert = /home/fex/etc/stunnel.pem
sslVersion = all
+fips = no
TIMEOUTclose = 1
-exec = perl
-execargs = perl -T /home/fex/bin/fexsrv stunnel
+exec = /home/fex/bin/fexsrv
+execargs = fexsrv stunnel
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
- 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!
}
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
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);
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
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
-/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.
-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!
-FEXHOME contains:
+$FEXHOME contains:
spool/ spool directory and user data
htdocs/ directory for generic download files
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:
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
-- 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 "~"
*.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
-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
-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!
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
-fex-20160328
+fex-20160919
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.
<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 "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
</body>
</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 "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
</body>
</html>
s/_+$//;
return $_;
}
+
+' ';
<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 "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
</body>
</html>
* 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/
<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 "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
</body>
</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 "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
</body>
</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 "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
</body>
</html>
--- /dev/null
+<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>
--- /dev/null
+package FAQ;
+
+print "abc\n";
+printf "1 2 3\n";
+print "___\n";
+1;
use Config;
use POSIX;
use Encode;
+use Cwd 'abs_path';
use Getopt::Std;
use File::Basename;
use Socket;
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};
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)
-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
$_ = <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";
}
- 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;
exec $_0,qw'-V .';
}
}
+ exit;
exit if "@ARGV" eq '.';
}
($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: $_";
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 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;
our ($FEXID,$FEXXX,$HOME);
our (%alias);
our $chunksize = 0;
-our $version = 20160328;
+our $version = 20160919;
our $_0 = $0;
our $DEBUG = $ENV{DEBUG};
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:
$_ = <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";
}
- 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;
exec $_0,qw'-V .';
}
}
+ exit;
exit if "@ARGV" eq '.';
}
$sid = $id;
if ($port eq 443 or $proxy) {
+ return if $opt_d;
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";
}
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]);
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");
}
eval 'use Net::INET6Glue::INET_is_INET6';
-our $version = 20160328;
+our $version = 20160919;
our $DEBUG = $ENV{DEBUG};
my %SSL = (SSL_version => 'TLSv1');
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>
-fex-20160328
+fex-20160919
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";
"1;\n";
close $pecl;
print $pecl,"\n";
- chownr('fex:root',"$FEXHOME/perl");
+ chownr('fex:0',"$FEXHOME/perl");
}
@save = (
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";
"< $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";
#
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 CGI::Carp qw(fatalsToBrowser);
# import from fex.pp
our ($bs,$tmpdir,@doc_dirs);
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
+ errorlog("$streamfile: $_ is not readable by user and group");
http_error(403);
}
}
} else {
# eval code with output substitution
local $__ = '';
+ local $^W = 0;
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;
return '';
}
-# tie STDOUT to buffer variable (redefining print)
+# tie STDOUT to buffer variable (redefining print and printf)
package Buffer;
sub TIEHANDLE {
## 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
## 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);
$mail_authid = 'yes';
$force_https = 0;
$debug = 0;
+@forbidden_user_agents = ('FDM');
# https://securityheaders.io/
# https://scotthelme.co.uk/hardening-your-http-response-headers/
$ENV{PROTO} = 'http' unless $ENV{PROTO};
$keep = $keep_default ||= $keep || 5;
+$purge ||= 3*$keep;
$fra = $ENV{REMOTE_ADDR} || '';
$sid = $ENV{SID} || '';
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(
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");
<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 "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
</body>
</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 "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
</body>
</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 "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
</body>
</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 "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
</body>
</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 "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
</body>
</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 "./faq.pl" or print $! >>
+<< do "./faq.pl" or print $! >>
</body>
</html>
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
projects / fex.git / commitdiff
