once: comparison once.pl

equal deleted inserted replaced

-:39c4a5f4ac33
+:4edd34dee93d
 #       |-STORE----------------------------|
 # …     |-PATH--------------------------------------|
 if ($ENV{PATH_INFO} =~
 m{/(?<path>(?<store>(?<view>$rxVIEW)/$rxFILE)/(?<base>.*))})
 {
 #        use Data::Dumper;
 #        die Dumper \%+;
 my $view  = deslash realpath catfile $ONCE_VAR, $+{view};
 my $store = deslash realpath catfile $ONCE_VAR, $+{store};
 my $file  = deslash realpath catfile $ONCE_VAR, $+{path};
 my $base  = $+{base};
 -x -w $ONCE_VAR
 or die "Can't write to $ONCE_VAR: $!\n";
 my ($view, $user_dir) = do {
 # view: display name
 #       anonymous | hans | …
 # user_dir: the directory name, becomes part of the
 #           link, later
 #       /var/lib/once/1AaIF9-1KF
 # to adapt the patterns $rxVIEW and $rxFILE at the beginning of
 # the script.
 #
 my ($v, $d);
 if ($ENV{REMOTE_USER} =~ /^\s*(.+)\s*$/) {
 # Known users get a directory name based user name.
 # Yes, if somebody can guess the user names, they can guess
 # the directory names too. But they can't guess the
 # completly randomly named files in there.
 $d = join '-' => base62(time), md5_base62($1);
 if (length(my $file = param('upload'))) {
 my $uuid = gen_uuid();
 my ($delete, $expires, $days) = do {
 my ($d, $e);
 my $days = param('expires');
 # sanitize expires
 $days =~ /.*?([+-]?\d+).*/;
 $days = $1 // 10;
 $e = base62 time + $days * 86400;
-if ($days == 0) { $d = 'd' }       # at first [d]ownload
+if    ($days == 0) { $d = 'd' }    # at first [d]ownload
-elsif ($days < 0) { $d = 'm' }     # only [m]anually
+elsif ($days < 0)  { $d = 'm' }    # only [m]anually
-else { $d = 'e' }                  # if expired
+else               { $d = 'e' }    # if expired
 ($d, $e, $days);
 };
 # sanitize the filename
 my $filename = do {
 my ($file, $dir) = fileparse($_);
 $dir = substr $dir,
 length $ONCE_VAR;    # make it relative to $ONCE_VAR
 # FIXME: use the rx* patterns from above
-$dir =~ m{/(?<expires>[a-z\d]{6})-(?<hash>[a-z\d]+)-(?<delete>.)}i or next;
+$dir =~ m{/(?<expires>[a-z\d]{6})-(?<hash>[a-z\d]+)-(?<delete>.)}i
+or next;
 my ($hash, $expires, $delete) = @{+}{qw/hash expires delete/};
 if (${expires} <= time and $delete eq 'e') {
 /(.*)/;
 unlink $_  or die "Can't unlik $_: $!\n";
 rmdir $dir or die "Can't rmdir $dir: $!\n";
 end_table,
 end_multipart_form,
 @footer,
 end_html;
 return 0;
 }
 sub deletedir {
 remove_tree
 map  { /^(\/.*)/ }
 }
 sub base62 {
 my $n = shift // $_;
 die 'input is >MAXINT' if $n == $n - 1 or $n == $n + 1;
-state $digits = [0..9, 'a'..'z', 'A'..'Z'];
+state $digits = [0 .. 9, 'a' .. 'z', 'A' .. 'Z'];
 state $base = @$digits;
 my @result;
-for (;$n >= $base; $n = int($n/$base)) {
+for (; $n >= $base ; $n = int($n / $base)) {
 my $mod = $n % $base;
 unshift @result, $digits->[$mod];
 }
 unshift @result, $digits->[$n];
 join '', @result;
 }
 sub gen_uuid {
 #open my $f, '/dev/urandom' or croak;
 #read $f, my($_), 128/8;
 #/^(.*)$/;
 #die join '-', map { base62 $_ } unpack 'Q*', $1;
 return base62 int rand(2**64);

changeset 57	4edd34dee93d
parent 56	39c4a5f4ac33
child 58	adf016ea4348