29 use IO::File; |
29 use IO::File; |
30 use File::Basename; |
30 use File::Basename; |
31 use Digest::MD5 qw(md5_hex); |
31 use Digest::MD5 qw(md5_hex); |
32 use OSSP::uuid; |
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($); |
38 |
38 |
39 delete @ENV{grep /PATH/, keys %ENV}; |
39 delete @ENV{ grep /PATH/, keys %ENV }; |
40 $ENV{PATH} = "/usr/local/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin"; |
40 $ENV{PATH} = "/usr/local/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin"; |
41 |
41 |
42 $_ = dirname $DIR; |
42 $_ = dirname $DIR; |
43 -d or mkdir $_ => 0750 |
43 -d or mkdir $_ => 0750 |
44 or die "Can't mkdir $_: $!\n"; |
44 or die "Can't mkdir $_: $!\n"; |
45 |
45 |
46 MAIN: { |
46 MAIN: { |
47 |
47 |
48 # per view we have an own directory |
48 # per view we have an own directory |
49 |
49 |
50 $ENV{REMOTE_USER} =~ /(.*)/; |
50 $ENV{REMOTE_USER} =~ /(.*)/; |
51 $_ = md5_hex($1); |
51 $_ = md5_hex($1); |
52 $DIR =~ s/{view}/$_/g; |
52 $DIR =~ s/{view}/$_/g; |
53 $DIR_URI =~ s/{view}/$_/g; |
53 $DIR_URI =~ s/{view}/$_/g; |
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 |
|
58 |
57 |
59 if (param("delete") =~ /([-a-z\d]+-\d+)/i) { |
58 if (param("delete") =~ /([-a-z\d]+-\d+)/i) { |
60 my $dir = $1; |
59 my $dir = $1; |
61 if (-d "$DIR/$dir") { |
60 if (-d "$DIR/$dir") { |
62 unlink map { /(.*)/ && $1 } glob("$DIR/$dir/*") |
61 unlink map { /(.*)/ && $1 } glob("$DIR/$dir/*") |
63 or die "Can't unlink $DIR/$dir/*: $!\n"; |
62 or die "Can't unlink $DIR/$dir/*: $!\n"; |
64 rmdir "$DIR/$dir" or die "Can't rmdir $DIR/$dir: $!\n"; |
63 rmdir "$DIR/$dir" or die "Can't rmdir $DIR/$dir: $!\n"; |
65 } |
64 } |
66 print redirect(-uri => url(-path_info => 1)); |
65 print redirect(-uri => url(-path_info => 1)); |
67 exit 0; |
66 exit 0; |
68 } |
67 } |
69 |
68 |
70 print header(-charset => "UTF-8"), |
69 print header(-charset => "UTF-8"), |
71 start_html(-title => "Up&Down"), |
70 start_html(-title => "Up&Down"), |
72 h1 "Ansicht: $ENV{REMOTE_USER}"; |
71 h1 "Ansicht: $ENV{REMOTE_USER}"; |
73 |
|
74 |
72 |
75 # print Dump; |
73 # print Dump; |
76 |
74 |
77 |
|
78 if (length(my $file = param("upload"))) { |
75 if (length(my $file = param("upload"))) { |
79 my $days = param("expires"); |
76 my $days = param("expires"); |
80 my $expires; |
77 my $expires; |
81 tie my $uuid => "OSSP::uuid::tie", "v4"; |
78 tie my $uuid => "OSSP::uuid::tie", "v4"; |
82 |
79 |
83 # sanitize expires |
80 # sanitize expires |
84 $days =~ /.*?(\d+).*/; |
81 $days =~ /.*?(\d+).*/; |
85 $days = defined $1 ? $1 : 10; |
82 $days = defined $1 ? $1 : 10; |
86 $expires = time + $days * 86400; |
83 $expires = time + $days * 86400; |
87 |
|
88 |
84 |
89 # sanitizing the filename |
85 # sanitizing the filename |
90 (my $filename = $file) =~ tr /\\/\//; |
86 (my $filename = $file) =~ tr /\\/\//; |
91 $filename =~ /(.*)/; |
87 $filename =~ /(.*)/; |
92 $filename = $1; |
88 $filename = $1; |
95 mkdir $dir, 0750 or die "Can't mkdir $dir: $!\n"; |
91 mkdir $dir, 0750 or die "Can't mkdir $dir: $!\n"; |
96 my $outfh = new IO::File ">$dir/$filename" |
92 my $outfh = new IO::File ">$dir/$filename" |
97 or die "Can't create $dir/$filename: $!\n"; |
93 or die "Can't create $dir/$filename: $!\n"; |
98 print {$outfh} <$file>; |
94 print {$outfh} <$file>; |
99 |
95 |
100 if (my $atfh = new IO::File("|at now + $days days")) { |
96 if (my $atfh = new IO::File("|at now + $days days")) { |
101 print {$atfh} |
97 print {$atfh} |
102 "rm -f \"$dir/$filename\"\n", |
98 "rm -f \"$dir/$filename\"\n", |
103 "rmdir \"$dir\"\n"; |
99 "rmdir \"$dir\"\n"; |
104 close $atfh; |
100 close $atfh; |
105 system("cat /tmp/log"); |
101 system("cat /tmp/log"); |
106 } |
102 } |
107 |
103 |
108 } |
104 } |
109 print hr; |
105 print hr; |
110 |
106 |
111 if (my @files = glob "$DIR/*-*/*") { |
107 if (my @files = glob "$DIR/*-*/*") { |
112 |
108 |
113 #print "<pre>", |
109 #print "<pre>", |
114 #(map { "$_: $ENV{$_}\n" } sort keys %ENV), |
110 #(map { "$_: $ENV{$_}\n" } sort keys %ENV), |
115 #"</pre>"; |
111 #"</pre>"; |
116 |
112 |
117 print p <<__; |
113 print p <<__; |
118 Der gültige Download-Link ist die Link-Adresse, die sich hinter |
114 Der gültige Download-Link ist die Link-Adresse, die sich hinter |
119 dem Datei-Namen verbirgt. (Firefox: Rechte Maustaste, Link-Location). |
115 dem Datei-Namen verbirgt. (Firefox: Rechte Maustaste, Link-Location). |
120 Nach Ablauf des <a href="http://de.wikipedia.org/wiki/Mindesthaltbarkeitsdatum">MHD</a> |
116 Nach Ablauf des <a href="http://de.wikipedia.org/wiki/Mindesthaltbarkeitsdatum">MHD</a> |
121 wird die Datei automatisch gelöscht. |
117 wird die Datei automatisch gelöscht. |
122 __ |
118 __ |
123 |
119 |
124 print start_table, Tr(th { align => "left" }, [qw/Name Größe Hochgeladen Löschung/]); |
120 print start_table, |
|
121 Tr(th { align => "left" }, [qw/Name Größe Hochgeladen Löschung/]); |
125 |
122 |
126 foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") { |
123 foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") { |
127 my ($file, $dir) = fileparse($_); |
124 my ($file, $dir) = fileparse($_); |
128 $dir = basename $dir; |
125 $dir = basename $dir; |
129 |
126 |
130 # $dir =~ /(?<hash>\S+)-(?<expires>\d+)$/ or next; |
127 # $dir =~ /(?<hash>\S+)-(?<expires>\d+)$/ or next; |
131 $dir =~ /(\S+)-(\d+)$/ or next; |
128 $dir =~ /(\S+)-(\d+)$/ or next; |
132 my $hash = $1; |
129 my $hash = $1; |
133 my $expires = $2; |
130 my $expires = $2; |
134 if (${expires} <= time) { |
131 if (${expires} <= time) { |
135 /(.*)/; |
132 /(.*)/; |
136 unlink $_ or die "Can't unlik $_: $!\n"; |
133 unlink $_ or die "Can't unlik $_: $!\n"; |
137 rmdir $dir or die "Can't rmdir $dir: $!\n"; |
134 rmdir $dir or die "Can't rmdir $dir: $!\n"; |
138 next; |
135 next; |
139 } |
136 } |
140 |
137 |
141 print Tr( |
138 print Tr( |
142 td(a { href => "$DIR_URI/$dir/$file" }, $file), |
139 td(a { href => "$DIR_URI/$dir/$file" }, $file), |
143 td({ align => "right" }, human((stat $_)[7])), |
140 td({ align => "right" }, human((stat $_)[7])), |
144 td(scalar localtime +(stat $_)[9]), |
141 td(scalar localtime +(stat $_)[9]), |
145 td(scalar localtime ${expires}), |
142 td(scalar localtime ${expires}), |
146 td(a({ href => "?delete=$dir" }, "remove")) |
143 td(a({ href => "?delete=$dir" }, "remove")) |
147 ); |
144 ); |
148 } |
145 } |
149 |
146 |
150 print end_table, hr; |
147 print end_table, hr; |
151 } |
148 } |
152 |
149 |
153 print start_multipart_form, start_table, |
150 print start_multipart_form, start_table, |
154 Tr(td("Dateiname: "), |
151 Tr(td("Dateiname: "), |
155 td(filefield(-name => "upload", -default => "nothing")), |
152 td(filefield(-name => "upload", -default => "nothing")), |
156 ), |
153 ), |
159 Tr(td(), td(submit(-value => "Hochladen")),), |
156 Tr(td(), td(submit(-value => "Hochladen")),), |
160 end_table, |
157 end_table, |
161 end_multipart_form; |
158 end_multipart_form; |
162 |
159 |
163 print hr, |
160 print hr, |
164 div({-align => "right"}, |
161 div( |
165 a({-href => "https://keller.schlittermann.de/hg/anon-upload/"} => "Scripting"), |
162 { -align => "right" }, |
166 " © 2010,2011 ", |
163 a( |
167 a({-href => "http://www.schlittermann.de/"} => "Heiko Schlittermann")), |
164 { -href => "https://keller.schlittermann.de/hg/anon-upload/" } => |
168 end_html; |
165 "Scripting" |
|
166 ), |
|
167 " © 2010,2011 ", |
|
168 a({ -href => "http://www.schlittermann.de/" } => "Heiko Schlittermann") |
|
169 ), |
|
170 end_html; |
169 } |
171 } |
170 |
172 |
171 sub human($) { |
173 sub human($) { |
172 my $_ = shift; |
174 my $_ = shift; |
173 my @units = qw(B K M G T); |
175 my @units = qw(B K M G T); |
174 while (length int > 3 and @units) { |
176 while (length int > 3 and @units) { |
175 $_ = sprintf "%.1f" => $_/1024; |
177 $_ = sprintf "%.1f" => $_ / 1024; |
176 shift @units; |
178 shift @units; |
177 } |
179 } |
178 croak "filesize is too big (can't convert to human readable number" |
180 croak "filesize is too big (can't convert to human readable number" |
179 if !@units; |
181 if !@units; |
180 return "$_$units[0]"; |
182 return "$_$units[0]"; |
181 } |
183 } |