# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1448400026 -3600
# Node ID 8de14266312f9b4dad8b6f28559fa3af8c50aec2
# Parent  308c7edbfda5e4209dc96bb17df58c6e273d34e7
[perltidy]

diff -r 308c7edbfda5 -r 8de14266312f upload.pl
--- a/upload.pl	Tue Nov 24 22:03:40 2015 +0100
+++ b/upload.pl	Tue Nov 24 22:20:26 2015 +0100
@@ -25,6 +25,7 @@
 #
 
 # STATUS: Proof of Concept!
+# NEEDS: Security review!
 
 use 5.014;
 use strict;
@@ -41,11 +42,10 @@
 use Digest::MD5 qw(md5_hex);
 use OSSP::uuid;
 
-
-sub human;      # convert numbers to human readable format
-sub deletedir;  # safely delete directories
-sub confirm;    # ask for user confirmation (HTML)
-sub deslash; # cleanup a path name
+sub human;        # convert numbers to human readable format
+sub deletedir;    # safely delete directories
+sub confirm;      # ask for user confirmation (HTML)
+sub deslash;      # cleanup a path name
 
 my $uuid = qr/[[:xdigit:]-]{36}/;
 my $hash = qr/[[:xdigit:]]{32}/;
@@ -58,11 +58,10 @@
 my $ONCE_VAR = do {
     $ENV{ONCE_VAR} =~ /^(\/\S+)/;
     die "Please define (correct) env ONCE_VAR\n"
-        if not defined $1;
+      if not defined $1;
     $1;
 };
 
-
 my @footer = (hr,
     div(
         { -align => "right" },
@@ -82,11 +81,13 @@
 MAIN: {
 
     # Download?
-    if ($ENV{PATH_INFO} =~ m{(?<path>(?<store>(?<view>/$hash|$uuid)/$uuid-\d+-.)/(?<base>.*))}) {
-        my $view = deslash realpath catfile $ONCE_VAR, $+{view};
+    if ($ENV{PATH_INFO} =~
+        m{(?<path>(?<store>(?<view>/$hash|$uuid)/$uuid-\d+-.)/(?<base>.*))})
+    {
+        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};
+        my $file  = deslash realpath catfile $ONCE_VAR, $+{path};
+        my $base  = $+{base};
 
         unless (-f $file) {
             print header('text/plain', '404 Not found'), 'Not found';
@@ -94,7 +95,8 @@
         }
 
         my $mimetype = mimetype($file);
-        confirm $base, $mimetype if $store =~ /-d$/ and not defined param('confirmed');
+        confirm $base, $mimetype
+          if $store =~ /-d$/ and not defined param('confirmed');
 
         open my $f, '<', $file or die "Can't open <`$file`: $!\n";
         remove_tree $1 if $store =~ m(^(/.*-d)$);
@@ -102,7 +104,7 @@
 
         print header(-type => $mimetype, -charset => 'UTF-8');
         if (request_method() ~~ [qw(GET POST)]) {
-            local $/ = \do{1 * 2**20};  # 1 MB Buffer
+            local $/ = \do { 1 * 2**20 };    # 1 MB Buffer
             print while <$f>;
         }
         exit 0;
@@ -113,11 +115,12 @@
     # per view (user) we have an own directory
 
     # pre condition checks
-    -d $ONCE_VAR or mkdir $ONCE_VAR => 0777
-    or die "Can't mkdir $ONCE_VAR: $! (your admin should have created it)\n";
+    -d $ONCE_VAR
+      or mkdir $ONCE_VAR => 0777
+      or die "Can't mkdir $ONCE_VAR: $! (your admin should have created it)\n";
 
-    -x -w $ONCE_VAR or
-        die "Can't write to $ONCE_VAR: $!\n";
+    -x -w $ONCE_VAR
+      or die "Can't write to $ONCE_VAR: $!\n";
 
     my ($view, $user_dir) = do {
         my ($v, $d);
@@ -133,9 +136,10 @@
     };
 
     if (param('delete') =~ m{(?<store>(?<view>$uuid|$hash)/$uuid-\d+-./?)}) {
+
         # FIXME: sanitization
         my $store = deslash catfile $ONCE_VAR, $+{store};
-        my $view = deslash catfile $ONCE_VAR, $+{view};
+        my $view  = deslash catfile $ONCE_VAR, $+{view};
         remove_tree $1 if $store =~ m(^(/.*));
         rmdir $1 if $view =~ m(^(/.*));
         print redirect(-uri => url(-path_info => 1));
@@ -206,7 +210,8 @@
 
         foreach (map { /(.*)/ } sort { -M $a <=> -M $b } @files) {
             my ($file, $dir) = fileparse($_);
-            $dir = substr $dir, length $ONCE_VAR;   # make it relative to $ONCE_VAR
+            $dir = substr $dir,
+              length $ONCE_VAR;    # make it relative to $ONCE_VAR
 
             $dir =~ /(\S+)-(\d+)-(.)\/?$/ or next;
             my ($hash, $expires, $delete) = ($1, $2, $3);
@@ -258,8 +263,8 @@
 
 sub deletedir {
     remove_tree
-        map { /^(\/.*)/ }
-        grep { /^\Q$ONCE_VAR\E/ } @_;
+      map  { /^(\/.*)/ }
+      grep { /^\Q$ONCE_VAR\E/ } @_;
 }
 
 sub human {