--- 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;
--- a/templates/inventory.html Fri Dec 25 11:59:41 2015 +0100
+++ b/templates/inventory.html Fri Dec 25 22:29:36 2015 +0100
@@ -30,7 +30,7 @@
[% END # files %]
[%# Formular for upload %]
-<form enctype="multipart/form-data">
+<form method="post" enctype="multipart/form-data">
<table>
<tr><td>Dateiname: </td>
<td><input type="file" name="upload" value="nothing" /></td>