diff -r eb0fb0878c89 -r 0ce1c1c38edd once.pl
--- a/once.pl	Fri Dec 25 11:59:41 2015 +0100
+++ b/once.pl	Fri Dec 25 22:29:36 2015 +0100
@@ -29,10 +29,9 @@
 use 5.018;
 use strict;
 use warnings;
-use CGI qw(:all *table);
+use IO::File;
+use CGI qw(param upload);
 use CGI::Carp qw(fatalsToBrowser);
-use CGI::Pretty;
-use IO::File;
 use FindBin qw($RealBin);
 use File::Basename;
 use File::Path qw(remove_tree make_path);
@@ -50,6 +49,7 @@
 sub gen_uuid;     # create a uniq identifier
 sub base62;
 sub md5_base62 { ... }
+sub untaint;
 
 my $rxVIEW = qr/[a-z\d]{6}-[a-z\d]+/i;      # date-userhash
 my $rxFILE = qr/[a-z\d]{6}-[a-z\d]+-./i;    # date-filehash-deletemode
@@ -63,17 +63,26 @@
 # The working (var) directory gets passed to us via ONCE_VAR environment
 # FIXME: Should we allow the current directory as an alternative?
 
-my $ONCE_VAR = do {
-    $ENV{ONCE_VAR} =~ /^(\/\S+)/;
-    die "Please define (correct) env ONCE_VAR\n"
-      if not defined $1;
-    $1;
-};
+die "Environment ONCE_VAR needs to be defined\n"
+    if not defined $ENV{ONCE_VAR};
+my $ONCE_VAR = untaint($ENV{ONCE_VAR}, qr((^/.*)));;
 
 exit main() if not caller;
 
 sub main {
 
+
+    # Handle the UPLOAD / VIEW request
+    # 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";
+
+    -x -w $ONCE_VAR
+      or die "Can't write to $ONCE_VAR: $!\n";
+
     # Download?
     # PATH_INFO is something like
     # /once/hDOPzMJMY0p/3fLjYmbYlGk-1450284310-d/boot.dot
@@ -112,17 +121,7 @@
 
     }
 
-    # Handle the UPLOAD / VIEW request
-    # 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";
-
-    -x -w $ONCE_VAR
-      or die "Can't write to $ONCE_VAR: $!\n";
-
+    # Setup the essentials: view and user_dir
     my ($view, $user_dir) = do {
 
         # view: display name
@@ -157,6 +156,7 @@
         $v, deslash catfile($ONCE_VAR, $d);
     };
 
+    # Handle the removal request and we're done
     if (param('delete') =~ m{(?<store>(?<view>$rxVIEW)/$rxFILE/?)}) {
 
         # FIXME: sanitization
@@ -171,10 +171,11 @@
     # save the uploaded file
 
     if (length(my $file = param('upload'))) {
+        my $upload_fh = upload('upload');
         my $uuid = gen_uuid();
         my ($delete, $expires, $days) = do {
             my ($d, $e);
-            my $days = param('expires');
+            my $days = param('expires') // 0;
 
             # sanitize expires
             $days =~ /.*?([+-]?\d+).*/;
@@ -196,9 +197,11 @@
 
         my $dir = catfile($user_dir, "$expires-$uuid-$delete");
         make_path($dir);
-        my $outfh = new IO::File "$dir/$filename", 'w'
-          or die "Can't create $dir/$filename: $!\n";
-        print {$outfh} <$file>;
+        {
+            my $outfh = new IO::File "$dir/$filename", 'w'
+                or die "Can't create $dir/$filename: $!\n";
+            print {$outfh} <$upload_fh>;
+        }
 
         if (not $delete ~~ [qw(d m)]
             and my $atfh = new IO::File("|at now + $days days"))
@@ -336,6 +339,14 @@
     join '', @result;
 }
 
+sub untaint {
+    my ($_, $rx) = (@_, qr((\w+)));
+    /$rx/;
+    die sprintf("%s:%s:%d: untaint('%s', %s): not defined\n",  caller, $_, $rx)
+        if not defined $1;
+    return $1;
+}
+
 sub gen_uuid {
 
     #open my $f, '/dev/urandom' or croak;