upload.pl
changeset 12 79baa14a3b9c
parent 10 1e7562ad30da
child 13 0996f1a07114
equal deleted inserted replaced
11:189e63c5b36f 12:79baa14a3b9c
    26 use CGI qw(:all *table);
    26 use CGI qw(:all *table);
    27 use CGI::Carp qw(fatalsToBrowser);
    27 use CGI::Carp qw(fatalsToBrowser);
    28 use CGI::Pretty;
    28 use CGI::Pretty;
    29 use IO::File;
    29 use IO::File;
    30 use File::Basename;
    30 use File::Basename;
    31 use Digest::SHA1 qw(sha1_hex);
       
    32 use Digest::MD5 qw(md5_hex);
    31 use Digest::MD5 qw(md5_hex);
       
    32 use OSSP::uuid;
    33 
    33 
    34 my $DIR      = "d/{view}";
    34 my $DIR      = "d/{view}";
    35 my $DIR_URI = "/$DIR";
    35 my $DIR_URI = "/$DIR";
    36 
    36 
    37 sub human($);
    37 sub human($);
    54     -d $DIR
    54     -d $DIR
    55 	or mkdir $DIR => 0750
    55 	or mkdir $DIR => 0750
    56 	or die "Can't mkdir $DIR: $!\n";
    56 	or die "Can't mkdir $DIR: $!\n";
    57     
    57     
    58 
    58 
    59     if (param("delete") =~ /([a-z\d]+-\d+)/i) {
    59     if (param("delete") =~ /([-a-z\d]+-\d+)/i) {
    60         my $dir = $1;
    60         my $dir = $1;
    61         if (-d "$DIR/$dir") {
    61         if (-d "$DIR/$dir") {
    62             unlink map { /(.*)/ && $1 } glob("$DIR/$dir/*")
    62             unlink map { /(.*)/ && $1 } glob("$DIR/$dir/*")
    63               or die "Can't unlink $DIR/$dir/*: $!\n";
    63               or die "Can't unlink $DIR/$dir/*: $!\n";
    64             rmdir "$DIR/$dir" or die "Can't rmdir $DIR/$dir: $!\n";
    64             rmdir "$DIR/$dir" or die "Can't rmdir $DIR/$dir: $!\n";
    76 
    76 
    77 
    77 
    78     if (length(my $file = param("upload"))) {
    78     if (length(my $file = param("upload"))) {
    79 	my $days = param("expires");
    79 	my $days = param("expires");
    80         my $expires;
    80         my $expires;
       
    81 	tie my $uuid => "OSSP::uuid::tie", "v4";
    81 
    82 
    82         # sanitize expires
    83         # sanitize expires
    83         $days =~ /.*?(\d+).*/;
    84         $days =~ /.*?(\d+).*/;
    84 	$days = defined $1 ? $1 : 10;
    85 	$days = defined $1 ? $1 : 10;
    85         $expires = time + $days * 86400;
    86         $expires = time + $days * 86400;
    88         # sanitizing the filename
    89         # sanitizing the filename
    89         (my $filename = $file) =~ tr /\\/\//;
    90         (my $filename = $file) =~ tr /\\/\//;
    90         $filename =~ /(.*)/;
    91         $filename =~ /(.*)/;
    91         $filename = $1;
    92         $filename = $1;
    92 
    93 
    93         my $dir = "$DIR/" . sha1_hex(time + rand(10_000)) . "-$expires";
    94         my $dir = "$DIR/$uuid-$expires";
    94         mkdir $dir, 0750 or die "Can't mkdir $dir: $!\n";
    95         mkdir $dir, 0750 or die "Can't mkdir $dir: $!\n";
    95         my $outfh = new IO::File ">$dir/$filename"
    96         my $outfh = new IO::File ">$dir/$filename"
    96           or die "Can't create $dir/$filename: $!\n";
    97           or die "Can't create $dir/$filename: $!\n";
    97         print {$outfh} <$file>;
    98         print {$outfh} <$file>;
    98 
    99