--- 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 {