1 #! /usr/bin/perl -T

     2 # Example .htaccess

     3 # | <Files upload.pl>

     4 # | AuthType Basic

     5 # | AuthName upload

     6 # | Require valid-user

     7 # | AuthUserFile /home/heiko/public_html/.passwd

     8 # | </Files>

     9 

    10 use strict;

    11 use warnings;

    12 use CGI qw(:all *table);

    13 use CGI::Carp qw(fatalsToBrowser);

    14 use CGI::Pretty;

    15 use IO::File;

    16 use File::Basename;

    17 use Digest::SHA1 qw(sha1_hex);

    18 

    19 my $DIR = "upload.d";

    20 my $LINK_DIR = url(-base => 1) . dirname($ENV{SCRIPT_NAME}) . "/$DIR";

    21 

    22 -d $DIR

    23   or mkdir $DIR => 0750

    24   or die "Can't mkdir $DIR: $!\n";

    25 

    26 MAIN: {

    27     print header(-charset => "UTF-8"), start_html,

    28       h1 "View: $ENV{REMOTE_USER}";

    29 

    30     # print Dump;

    31 

    32     if (param("delete") =~ /([a-z\d]+-\d+)/i) {

    33         my $dir = $1;

    34         if (-d "$DIR/$dir") {

    35             unlink map { /(.*)/ && $1 } glob("$DIR/$dir/*")

    36               or die "Can't unlink $DIR/$dir/*: $!\n";

    37             rmdir "$DIR/$dir" or die "Can't rmdir $DIR/$dir: $!\n";

    38         }

    39     }

    40 

    41     if (length(my $file = param("upload"))) {

    42         my $expires = param("expires");

    43 

    44         # sanitize expires

    45         $expires =~ /.*?(\d+).*/;

    46         $expires = time + (defined $1 ? $1 : 10) * 86400;

    47 

    48         # sanitizing the filename

    49         (my $filename = $file) =~ tr /\\/\//;

    50         $filename =~ /(.*)/;

    51         $filename = $1;

    52 

    53         my $dir = "$DIR/" . sha1_hex(time + rand(10_000)) . "-$expires";

    54         mkdir $dir, 0750 or die "Can't mkdir $dir: $!\n";

    55         my $outfh = new IO::File ">$dir/$filename"

    56           or die "Can't create $dir/$filename: $!\n";

    57         print {$outfh} <$file>;

    58     }

    59     print hr;

    60 

    61     print start_table, Tr(th { align => "left" }, [qw/name size date expires/]);

    62 

    63     foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") {

    64         my ($file, $dir) = fileparse($_);

    65         $dir = basename $dir;

    66         $dir =~ /(?<hash>\S+)-(?<expires>\d+)$/ or next;

    67         if ($+{expires} <= time) {

    68             /(.*)/;

    69             unlink $_  or die "Can't unlik $_: $!\n";

    70             rmdir $dir or die "Can't rmdir $dir: $!\n";

    71             next;

    72         }

    73 

    74         print Tr(

    75             td(a { href => "$LINK_DIR/$dir/$file" }, $file),

    76             td({ align => "right" }, (stat $_)[7]),

    77             td(scalar localtime +(stat $_)[9]),

    78             td(scalar localtime $+{expires}),

    79             td(a({ href => "?delete=$dir" }, "remove"))

    80         );

    81     }

    82 

    83     print end_table, hr;

    84 

    85     print start_multipart_form, start_table,

    86       Tr(td("Dateiname: "),

    87         td(filefield(-name => "upload", -default => "nothing")),

    88       ),

    89       Tr(td("Löschen in: "), td(textfield(-name => "expires", -default => 10)),

    90         td("Tagen")),

    91       Tr(td(), td(submit(-value => "Hochladen")),),

    92       end_table,

    93       end_multipart_form;

    94 

    95     print end_html;

    96 }