From: fextracker Date: Tue, 20 Sep 2016 02:00:06 +0000 (+0200) Subject: Original release 20160919 X-Git-Tag: 20160919 X-Git-Url: https://git.treefish.org/fex.git/commitdiff_plain/HEAD?ds=sidebyside;hp=cdeb354c4dbb11b683f9f8c5db2861f3dc572c61 Original release 20160919 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 --- diff --git a/bin/ezz b/bin/ezz index 523dc8c..39dc91e 100755 --- a/bin/ezz +++ b/bin/ezz @@ -1,56 +1,1042 @@ -#!/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 +# +# 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<; + $_ = <$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? "; + $_ = ; + 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 () { + 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 zz> :w !zz +# noremap zz< :r !zz -- +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 = ||''; + 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 1d9c10d..e6d81aa 100755 --- a/bin/fbm +++ b/bin/fbm @@ -20,7 +20,7 @@ use constant M => 2**20; our ($SH,$windoof,$sigpipe,$useragent); our ($FEXSERVER); -our $version = 20160328; +our $version = 20160919; # server defaults my $server = 'fex.rus.uni-stuttgart.de'; diff --git a/bin/fex_cleanup b/bin/fex_cleanup index 1d87dcf..1f38d6b 100755 --- a/bin/fex_cleanup +++ b/bin/fex_cleanup @@ -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); -$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"; @@ -418,8 +419,9 @@ exit; 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 $_; @@ -440,8 +442,9 @@ sub cleanup { 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 { diff --git a/bin/fexget b/bin/fexget index b0616a1..3ac605f 100755 --- a/bin/fexget +++ b/bin/fexget @@ -13,6 +13,7 @@ use strict qw'vars subs'; use Config; use POSIX; use Encode; +use Cwd 'abs_path'; 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 $version = 20160328; +our $version = 20160919; 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 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 + -V show version and ask for upgrade argument: F*EX-URL may be file number (see: $0 -l) EOD @@ -167,10 +170,15 @@ if ($opt_V) { $_ = ||''; 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; @@ -178,6 +186,7 @@ if ($opt_V) { exec $_0,qw'-V .'; } } + exit; 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:.*/::; - printf "%s deleted\n",urldecode($file); + printf "%s deleted\n",locale(decode_utf8(urldecode($file))); } else { s:HTTP/[\d\. ]+::; die "$0: server response: $_"; diff --git a/bin/fexsend b/bin/fexsend index f47bed4..fae77e9 100755 --- a/bin/fexsend +++ b/bin/fexsend @@ -17,10 +17,10 @@ use IO::Handle; 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; @@ -37,7 +37,7 @@ our ($tpid,$frecipient); our ($FEXID,$FEXXX,$HOME); our (%alias); our $chunksize = 0; -our $version = 20160328; +our $version = 20160919; 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 +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: @@ -361,10 +369,15 @@ if ($xx) { $_ = ||''; 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; @@ -372,6 +385,7 @@ if ($xx) { exec $_0,qw'-V .'; } } + exit; exit if "@ARGV" eq '.'; } @@ -3206,9 +3220,10 @@ sub query_sid { $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"; } @@ -3469,7 +3484,8 @@ sub readahead { 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]); @@ -3528,6 +3544,9 @@ sub fmd { 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"); } diff --git a/bin/fexsrv b/bin/fexsrv index 8bef7fc..2843167 100755 --- a/bin/fexsrv +++ b/bin/fexsrv @@ -15,6 +15,7 @@ BEGIN { # 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 { @@ -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); -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) @@ -144,7 +145,7 @@ else { 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 $@; @@ -368,6 +369,8 @@ REQUEST: while (*STDIN) { if ($uri =~ /\\|%5c/i) { badchar("\\") } } + my $fua = join('|',@forbidden_user_agents); + while ($_ = shift @header) { # header inquisition! @@ -381,12 +384,8 @@ REQUEST: while (*STDIN) { 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:.*,/) { @@ -436,7 +435,7 @@ REQUEST: while (*STDIN) { } # HTTP header ==> environment variables - if (/^([\w\-]+):\s*(.+)/s) { + if (/^([\w\-_]+):\s*(.+)/s) { $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)$/) { - $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; } diff --git a/bin/fpg b/bin/fpg index 5f2f751..7e616bd 100755 --- a/bin/fpg +++ b/bin/fpg @@ -2,7 +2,7 @@ # # Programname: fpg - Frams' Perl grep # Author: framstag@rus.uni-stuttgart.de -# Copyright: GPL +# Licence: Perl Artistic # # History: # 2003-02-27 Framstag initial version @@ -18,13 +18,16 @@ # -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 <30 and not /\\w/' script #See "perldoc perlre" for help on regular expressions. -} -$0 =~ s:.*/::; -$| = 1; $maxlen = 0; @@ -67,10 +67,15 @@ $opt_S = 4; $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)) { @@ -129,7 +134,7 @@ sub scan { } 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; } @@ -277,12 +282,19 @@ sub grepf { 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 { diff --git a/bin/l b/bin/l index affd4a2..203e310 100755 --- a/bin/l +++ b/bin/l @@ -13,7 +13,7 @@ use Getopt::Std; # 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'}; @@ -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_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; @@ -138,6 +149,8 @@ sub collect { my @files = @_; my $f; + getacl(@files) if $opt_l and not $opt_n; + # 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 - 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) { @@ -262,6 +275,8 @@ sub list { 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 } @@ -283,15 +298,22 @@ sub list { } 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 } @@ -375,13 +397,14 @@ sub info { 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; } } @@ -425,6 +448,25 @@ sub info { 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) @@ -482,6 +524,7 @@ sub getfiles { warn "$0: cannot read $dir : $!\n"; } + getacl(@dirs,@files) if $opt_l and not $opt_n; 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 @@ -552,7 +604,7 @@ sub usage { 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 <) { s/\r//; + s/[^\x09\x20-\xFF]/_/g; if (/^Content-Disposition:.*name="FILE".*filename="(.+)"/i) { print " FILE=\"$1\"\n"; } elsif (/^Content-Disposition:.*name="(\w+)"/i) { diff --git a/bin/sexsend b/bin/sexsend index 9a7d48b..8b9e1d1 100755 --- a/bin/sexsend +++ b/bin/sexsend @@ -19,7 +19,7 @@ use constant M => 2**20; eval 'use Net::INET6Glue::INET_is_INET6'; -our $version = 20160328; +our $version = 20160919; our $DEBUG = $ENV{DEBUG}; my %SSL = (SSL_version => 'TLSv1'); diff --git a/bin/zz b/bin/zz index 0317412..39dc91e 100755 --- a/bin/zz +++ b/bin/zz @@ -1,55 +1,1042 @@ -#!/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 +# +# 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 = <; + $_ = <$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? "; + $_ = ; + 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 () { + 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 zz> :w !zz -# noremap zz< :r !zz +# noremap zz< :r !zz -- +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</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 = ||''; + 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/cgi-bin/fac b/cgi-bin/fac index 262975d..a6a0012 100755 --- a/cgi-bin/fac +++ b/cgi-bin/fac @@ -205,13 +205,13 @@ if (defined $PARAM{"createUser"}) { 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"}) { @@ -564,8 +564,9 @@ sub saveFile { &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 - $!");; diff --git a/cgi-bin/fup b/cgi-bin/fup index 2a799ac..9ba0ef2 100755 --- a/cgi-bin/fup +++ b/cgi-bin/fup @@ -1613,7 +1613,10 @@ sub parse_request { &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'); @@ -1942,7 +1945,10 @@ sub showstatus { 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; diff --git a/cgi-bin/fur b/cgi-bin/fur index bca85af..0ab7be9 100755 --- a/cgi-bin/fur +++ b/cgi-bin/fur @@ -48,7 +48,8 @@ unless (@local_domains or @local_rdomains) { } 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." diff --git a/doc/Changes b/doc/Changes index cdc834f..2457b74 100644 --- a/doc/Changes +++ b/doc/Changes @@ -1,3 +1,14 @@ +2016-09-19 dop: do not show return value of <> 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 diff --git a/doc/SSL b/doc/SSL index 6eb73bf..90e01ef 100644 --- a/doc/SSL +++ b/doc/SSL @@ -2,14 +2,27 @@ # 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 @@ -19,23 +32,26 @@ debug = warning 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 </etc/xinetd.d/fexs +cat </etc/xinetd.d/fexs # default: on # description: fex web server with SSL # note: only possible on port 443! @@ -56,11 +72,9 @@ service fexs } 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 diff --git a/doc/concept b/doc/concept index fde9902..6203c43 100644 --- a/doc/concept +++ b/doc/concept @@ -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 -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); @@ -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 -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 @@ -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 -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 @@ -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. -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: @@ -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 -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 "~" @@ -387,15 +387,23 @@ fexsrv. *.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 <> (even multiline) which will be -evaluated and its output will be placed in. Same goes for <<>> -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 <<>> 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! diff --git a/doc/new b/doc/new index badf322..bcd8be8 100644 --- a/doc/new +++ b/doc/new @@ -2,11 +2,6 @@ New release on http://fex.belwue.de/fex.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 diff --git a/doc/version b/doc/version index 7b735e5..d9e31cb 100644 --- a/doc/version +++ b/doc/version @@ -1 +1 @@ -fex-20160328 +fex-20160919 diff --git a/htdocs/FAQ/admin.faq b/htdocs/FAQ/admin.faq index 61691fc..1f7c404 100644 --- a/htdocs/FAQ/admin.faq +++ b/htdocs/FAQ/admin.faq @@ -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 - * 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. diff --git a/htdocs/FAQ/admin.html b/htdocs/FAQ/admin.html index a096645..9585c69 100644 --- a/htdocs/FAQ/admin.html +++ b/htdocs/FAQ/admin.html @@ -2,11 +2,14 @@ F*EX FAQ +## << do "./xx.pl" or print $! >> +## << $_ = `pwd` >> + ## 
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ##
-<< require "./faq.pl" or print $! >> +<< do "./faq.pl" or print $! >> diff --git a/htdocs/FAQ/all.html b/htdocs/FAQ/all.html index a096645..9585c69 100644 --- a/htdocs/FAQ/all.html +++ b/htdocs/FAQ/all.html @@ -2,11 +2,14 @@ F*EX FAQ +## << do "./xx.pl" or print $! >> +## << $_ = `pwd` >> + ## 
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ##
-<< require "./faq.pl" or print $! >> +<< do "./faq.pl" or print $! >> diff --git a/htdocs/FAQ/faq.pl b/htdocs/FAQ/faq.pl index 3a2fcff..0e484b9 100644 --- a/htdocs/FAQ/faq.pl +++ b/htdocs/FAQ/faq.pl @@ -140,3 +140,5 @@ sub anchor { s/_+$//; return $_; } + +' '; diff --git a/htdocs/FAQ/local.html b/htdocs/FAQ/local.html index a096645..9585c69 100644 --- a/htdocs/FAQ/local.html +++ b/htdocs/FAQ/local.html @@ -2,11 +2,14 @@ F*EX FAQ +## << do "./xx.pl" or print $! >> +## << $_ = `pwd` >> + ## 
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ##
-<< require "./faq.pl" or print $! >> +<< do "./faq.pl" or print $! >> diff --git a/htdocs/FAQ/meta.faq b/htdocs/FAQ/meta.faq index f910621..09fe46f 100644 --- a/htdocs/FAQ/meta.faq +++ b/htdocs/FAQ/meta.faq @@ -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 - * 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/ diff --git a/htdocs/FAQ/meta.html b/htdocs/FAQ/meta.html index a096645..9585c69 100644 --- a/htdocs/FAQ/meta.html +++ b/htdocs/FAQ/meta.html @@ -2,11 +2,14 @@ F*EX FAQ +## << do "./xx.pl" or print $! >> +## << $_ = `pwd` >> + ## 
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ##
-<< require "./faq.pl" or print $! >> +<< do "./faq.pl" or print $! >> diff --git a/htdocs/FAQ/misc.html b/htdocs/FAQ/misc.html index a096645..9585c69 100644 --- a/htdocs/FAQ/misc.html +++ b/htdocs/FAQ/misc.html @@ -2,11 +2,14 @@ F*EX FAQ +## << do "./xx.pl" or print $! >> +## << $_ = `pwd` >> + ## 
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ##
-<< require "./faq.pl" or print $! >> +<< do "./faq.pl" or print $! >> diff --git a/htdocs/FAQ/user.html b/htdocs/FAQ/user.html index a096645..9585c69 100644 --- a/htdocs/FAQ/user.html +++ b/htdocs/FAQ/user.html @@ -2,11 +2,14 @@ F*EX FAQ +## << do "./xx.pl" or print $! >> +## << $_ = `pwd` >> + ## 
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ##
-<< require "./faq.pl" or print $! >> +<< do "./faq.pl" or print $! >> diff --git a/htdocs/FAQ/xx.html b/htdocs/FAQ/xx.html new file mode 100644 index 0000000..3c8eb43 --- /dev/null +++ b/htdocs/FAQ/xx.html @@ -0,0 +1,15 @@ + +F*EX FAQ + + +## << do "./xx.pl" or print $! >> +## << $_ = `pwd` >> + +## 
+## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
+##
+ +<< require "./xx.pl"; >> + + + diff --git a/htdocs/FAQ/xx.pl b/htdocs/FAQ/xx.pl new file mode 100755 index 0000000..68e45b4 --- /dev/null +++ b/htdocs/FAQ/xx.pl @@ -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 index 0000000..0f57817 --- /dev/null +++ b/htdocs/FAQ/zz.pl @@ -0,0 +1 @@ +0; diff --git a/htdocs/download/fexget b/htdocs/download/fexget index b0616a1..3ac605f 100755 --- a/htdocs/download/fexget +++ b/htdocs/download/fexget @@ -13,6 +13,7 @@ use strict qw'vars subs'; use Config; use POSIX; use Encode; +use Cwd 'abs_path'; 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 $version = 20160328; +our $version = 20160919; 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 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 + -V show version and ask for upgrade argument: F*EX-URL may be file number (see: $0 -l) EOD @@ -167,10 +170,15 @@ if ($opt_V) { $_ = ||''; 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; @@ -178,6 +186,7 @@ if ($opt_V) { exec $_0,qw'-V .'; } } + exit; 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:.*/::; - printf "%s deleted\n",urldecode($file); + printf "%s deleted\n",locale(decode_utf8(urldecode($file))); } else { s:HTTP/[\d\. ]+::; die "$0: server response: $_"; diff --git a/htdocs/download/fexsend b/htdocs/download/fexsend index f47bed4..fae77e9 100755 --- a/htdocs/download/fexsend +++ b/htdocs/download/fexsend @@ -17,10 +17,10 @@ use IO::Handle; 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; @@ -37,7 +37,7 @@ our ($tpid,$frecipient); our ($FEXID,$FEXXX,$HOME); our (%alias); our $chunksize = 0; -our $version = 20160328; +our $version = 20160919; 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 +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: @@ -361,10 +369,15 @@ if ($xx) { $_ = ||''; 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; @@ -372,6 +385,7 @@ if ($xx) { exec $_0,qw'-V .'; } } + exit; exit if "@ARGV" eq '.'; } @@ -3206,9 +3220,10 @@ sub query_sid { $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"; } @@ -3469,7 +3484,8 @@ sub readahead { 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]); @@ -3528,6 +3544,9 @@ sub fmd { 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"); } diff --git a/htdocs/download/sexsend b/htdocs/download/sexsend index 9a7d48b..8b9e1d1 100755 --- a/htdocs/download/sexsend +++ b/htdocs/download/sexsend @@ -19,7 +19,7 @@ use constant M => 2**20; eval 'use Net::INET6Glue::INET_is_INET6'; -our $version = 20160328; +our $version = 20160919; our $DEBUG = $ENV{DEBUG}; my %SSL = (SSL_version => 'TLSv1'); diff --git a/htdocs/fex.png b/htdocs/fex.png new file mode 100644 index 0000000..a9ac834 Binary files /dev/null and b/htdocs/fex.png differ diff --git a/htdocs/fexit.html b/htdocs/fexit.html index ce281d3..f825d30 100644 --- a/htdocs/fexit.html +++ b/htdocs/fexit.html @@ -35,8 +35,9 @@ You can also drag files or directories to the fexit icon with the Windows explorer.

With fexit you also have access to the -F*EX internet clipboard to exchange files -between your Windows or UNIX accounts. + +F*EX internet clipboard +to exchange files between your Windows or UNIX accounts.

diff --git a/htdocs/fexit.png b/htdocs/fexit.png new file mode 100644 index 0000000..585afae Binary files /dev/null and b/htdocs/fexit.png differ diff --git a/htdocs/version b/htdocs/version index 7b735e5..d9e31cb 100644 --- a/htdocs/version +++ b/htdocs/version @@ -1 +1 @@ -fex-20160328 +fex-20160919 diff --git a/install b/install index 7019bee..c300815 100755 --- a/install +++ b/install @@ -163,6 +163,12 @@ if ($FEXHOME !~ /fex/) { 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"; @@ -175,7 +181,7 @@ unless (-f $pecl) { "1;\n"; close $pecl; print $pecl,"\n"; - chownr('fex:root',"$FEXHOME/perl"); + chownr('fex:0',"$FEXHOME/perl"); } @save = ( @@ -388,7 +394,7 @@ unless (-f $xinetd) { 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"; @@ -406,9 +412,6 @@ unless (-f $xinetd) { "< $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"; diff --git a/lib/dop b/lib/dop index dc92d70..4a6ece0 100755 --- a/lib/dop +++ b/lib/dop @@ -8,11 +8,11 @@ # 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); @@ -126,10 +126,16 @@ sub http_output { 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); } } @@ -238,8 +244,10 @@ sub http_output { } 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; @@ -603,7 +611,7 @@ sub out { return ''; } -# tie STDOUT to buffer variable (redefining print) +# tie STDOUT to buffer variable (redefining print and printf) package Buffer; sub TIEHANDLE { diff --git a/lib/fex.ph b/lib/fex.ph index c69943d..d1596e2 100644 --- a/lib/fex.ph +++ b/lib/fex.ph @@ -85,6 +85,10 @@ $keep_max = 99; ## 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 @@ -137,6 +141,13 @@ $mail_authid = 'YES'; ## 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); diff --git a/lib/fex.pp b/lib/fex.pp index 8bfddbf..177baba 100644 --- a/lib/fex.pp +++ b/lib/fex.pp @@ -62,6 +62,7 @@ $fop_auth = 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/ @@ -124,6 +125,7 @@ http_die("cannot determine the server hostname") unless $hostname; $ENV{PROTO} = 'http' unless $ENV{PROTO}; $keep = $keep_default ||= $keep || 5; +$purge ||= 3*$keep; $fra = $ENV{REMOTE_ADDR} || ''; $sid = $ENV{SID} || ''; @@ -320,6 +322,8 @@ sub html_header { 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( @@ -370,6 +374,12 @@ sub html_error { 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"); diff --git a/locale/czech/htdocs/FAQ/FAQ.html b/locale/czech/htdocs/FAQ/FAQ.html index a096645..9585c69 100644 --- a/locale/czech/htdocs/FAQ/FAQ.html +++ b/locale/czech/htdocs/FAQ/FAQ.html @@ -2,11 +2,14 @@ F*EX FAQ +## << do "./xx.pl" or print $! >> +## << $_ = `pwd` >> + ## 

 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ##
-<< require "./faq.pl" or print $! >> +<< do "./faq.pl" or print $! >> diff --git a/locale/french/htdocs/FAQ/FAQ.html b/locale/french/htdocs/FAQ/FAQ.html index a096645..9585c69 100644 --- a/locale/french/htdocs/FAQ/FAQ.html +++ b/locale/french/htdocs/FAQ/FAQ.html @@ -2,11 +2,14 @@ F*EX FAQ +## << do "./xx.pl" or print $! >> +## << $_ = `pwd` >> + ## 
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ##
-<< require "./faq.pl" or print $! >> +<< do "./faq.pl" or print $! >> diff --git a/locale/galician/htdocs/FAQ/FAQ.html b/locale/galician/htdocs/FAQ/FAQ.html index a096645..9585c69 100644 --- a/locale/galician/htdocs/FAQ/FAQ.html +++ b/locale/galician/htdocs/FAQ/FAQ.html @@ -2,11 +2,14 @@ F*EX FAQ +## << do "./xx.pl" or print $! >> +## << $_ = `pwd` >> + ## 
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ##
-<< require "./faq.pl" or print $! >> +<< do "./faq.pl" or print $! >> diff --git a/locale/german/htdocs/FAQ/FAQ.html b/locale/german/htdocs/FAQ/FAQ.html index a096645..9585c69 100644 --- a/locale/german/htdocs/FAQ/FAQ.html +++ b/locale/german/htdocs/FAQ/FAQ.html @@ -2,11 +2,14 @@ F*EX FAQ +## << do "./xx.pl" or print $! >> +## << $_ = `pwd` >> + ## 
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ##
-<< require "./faq.pl" or print $! >> +<< do "./faq.pl" or print $! >> diff --git a/locale/italian/htdocs/FAQ/FAQ.html b/locale/italian/htdocs/FAQ/FAQ.html index a096645..9585c69 100644 --- a/locale/italian/htdocs/FAQ/FAQ.html +++ b/locale/italian/htdocs/FAQ/FAQ.html @@ -2,11 +2,14 @@ F*EX FAQ +## << do "./xx.pl" or print $! >> +## << $_ = `pwd` >> + ## 
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ##
-<< require "./faq.pl" or print $! >> +<< do "./faq.pl" or print $! >> diff --git a/locale/spanish/htdocs/FAQ/FAQ.html b/locale/spanish/htdocs/FAQ/FAQ.html index a096645..9585c69 100644 --- a/locale/spanish/htdocs/FAQ/FAQ.html +++ b/locale/spanish/htdocs/FAQ/FAQ.html @@ -2,11 +2,14 @@ F*EX FAQ +## << do "./xx.pl" or print $! >> +## << $_ = `pwd` >> + ## 
 ## << while (($v,$vv) = each %ENV) { print "$v = $vv\n" } >>
 ##
-<< require "./faq.pl" or print $! >> +<< do "./faq.pl" or print $! >> diff --git a/locale/translations b/locale/translations index 25f1044..e36d3ab 100644 --- a/locale/translations +++ b/locale/translations @@ -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 -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