18 # Eventuell in der Apache-Config sowas wie |
18 # Eventuell in der Apache-Config sowas wie |
19 # ScriptAlias /ud /home/ud/XXX/upload.pl |
19 # ScriptAlias /ud /home/ud/XXX/upload.pl |
20 # Alias /d /home/ud/XXX/d/ |
20 # Alias /d /home/ud/XXX/d/ |
21 # gesetzt werden. |
21 # gesetzt werden. |
22 |
22 |
|
23 use 5.010; |
23 use strict; |
24 use strict; |
24 use warnings; |
25 use warnings; |
25 use CGI qw(:all *table); |
26 use CGI qw(:all *table); |
26 use CGI::Carp qw(fatalsToBrowser); |
27 use CGI::Carp qw(fatalsToBrowser); |
27 use CGI::Pretty; |
28 use CGI::Pretty; |
28 use IO::File; |
29 use IO::File; |
29 use File::Basename; |
30 use File::Basename; |
30 use Digest::SHA1 qw(sha1_hex); |
31 use Digest::SHA1 qw(sha1_hex); |
|
32 use Digest::MD5 qw(md5_hex); |
31 |
33 |
32 my $DIR = "d"; |
34 my $DIR = "d/{view}"; |
33 my $DIR_URI = "/$DIR"; |
35 my $DIR_URI = "/$DIR"; |
|
36 |
|
37 sub human($); |
34 |
38 |
35 delete @ENV{grep /PATH/, keys %ENV}; |
39 delete @ENV{grep /PATH/, keys %ENV}; |
36 $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"; |
37 |
41 |
38 -d $DIR |
42 $_ = dirname $DIR; |
39 or mkdir $DIR => 0750 |
43 -d or mkdir $_ => 0750 |
40 or die "Can't mkdir $DIR: $!\n"; |
44 or die "Can't mkdir $_: $!\n"; |
41 |
45 |
42 MAIN: { |
46 MAIN: { |
43 print header(-charset => "UTF-8"), start_html, h1 "View: $ENV{REMOTE_USER}"; |
|
44 |
47 |
45 # print Dump; |
48 # per view we have an own directory |
|
49 |
|
50 $ENV{REMOTE_USER} =~ /(.*)/; |
|
51 $_ = md5_hex($1); |
|
52 $DIR =~ s/{view}/$_/g; |
|
53 $DIR_URI =~ s/{view}/$_/g; |
|
54 -d $DIR |
|
55 or mkdir $DIR => 0750 |
|
56 or die "Can't mkdir $DIR: $!\n"; |
|
57 |
46 |
58 |
47 if (param("delete") =~ /([a-z\d]+-\d+)/i) { |
59 if (param("delete") =~ /([a-z\d]+-\d+)/i) { |
48 my $dir = $1; |
60 my $dir = $1; |
49 if (-d "$DIR/$dir") { |
61 if (-d "$DIR/$dir") { |
50 unlink map { /(.*)/ && $1 } glob("$DIR/$dir/*") |
62 unlink map { /(.*)/ && $1 } glob("$DIR/$dir/*") |
51 or die "Can't unlink $DIR/$dir/*: $!\n"; |
63 or die "Can't unlink $DIR/$dir/*: $!\n"; |
52 rmdir "$DIR/$dir" or die "Can't rmdir $DIR/$dir: $!\n"; |
64 rmdir "$DIR/$dir" or die "Can't rmdir $DIR/$dir: $!\n"; |
53 } |
65 } |
|
66 print redirect(-uri => url(-path_info => 1)); |
|
67 exit 0; |
54 } |
68 } |
|
69 |
|
70 print header(-charset => "UTF-8"), |
|
71 start_html(-title => "Up&Down"), |
|
72 h1 "Ansicht: $ENV{REMOTE_USER}"; |
|
73 |
|
74 |
|
75 # print Dump; |
|
76 |
55 |
77 |
56 if (length(my $file = param("upload"))) { |
78 if (length(my $file = param("upload"))) { |
57 my $days = param("expires"); |
79 my $days = param("expires"); |
58 my $expires; |
80 my $expires; |
59 |
81 |
92 #"</pre>"; |
114 #"</pre>"; |
93 |
115 |
94 print p <<__; |
116 print p <<__; |
95 Der gültige Download-Link ist die Link-Adresse, die sich hinter |
117 Der gültige Download-Link ist die Link-Adresse, die sich hinter |
96 dem Datei-Namen verbirgt. (Firefox: Rechte Maustaste, Link-Location). |
118 dem Datei-Namen verbirgt. (Firefox: Rechte Maustaste, Link-Location). |
|
119 Nach Ablauf des <a href="http://de.wikipedia.org/wiki/Mindesthaltbarkeitsdatum">MHD</a> |
|
120 wird die Datei automatisch gelöscht. |
97 __ |
121 __ |
98 |
122 |
99 print start_table, Tr(th { align => "left" }, [qw/name size date expires/]); |
123 print start_table, Tr(th { align => "left" }, [qw/Name Größe Hochgeladen Löschung/]); |
100 |
124 |
101 foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") { |
125 foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") { |
102 my ($file, $dir) = fileparse($_); |
126 my ($file, $dir) = fileparse($_); |
103 $dir = basename $dir; |
127 $dir = basename $dir; |
104 |
128 |
113 next; |
137 next; |
114 } |
138 } |
115 |
139 |
116 print Tr( |
140 print Tr( |
117 td(a { href => "$DIR_URI/$dir/$file" }, $file), |
141 td(a { href => "$DIR_URI/$dir/$file" }, $file), |
118 td({ align => "right" }, (stat $_)[7]), |
142 td({ align => "right" }, human((stat $_)[7])), |
119 td(scalar localtime +(stat $_)[9]), |
143 td(scalar localtime +(stat $_)[9]), |
120 td(scalar localtime ${expires}), |
144 td(scalar localtime ${expires}), |
121 td(a({ href => "?delete=$dir" }, "remove")) |
145 td(a({ href => "?delete=$dir" }, "remove")) |
122 ); |
146 ); |
123 } |
147 } |
133 td("Tagen")), |
157 td("Tagen")), |
134 Tr(td(), td(submit(-value => "Hochladen")),), |
158 Tr(td(), td(submit(-value => "Hochladen")),), |
135 end_table, |
159 end_table, |
136 end_multipart_form; |
160 end_multipart_form; |
137 |
161 |
138 print end_html; |
162 print hr, |
|
163 div({-align => "right"}, |
|
164 a({-href => "https://keller.schlittermann.de/hg/anon-upload/"} => "Scripting"), |
|
165 " © 2010,2011 ", |
|
166 a({-href => "http://www.schlittermann.de/"} => "Heiko Schlittermann")), |
|
167 end_html; |
139 } |
168 } |
|
169 |
|
170 sub human($) { |
|
171 my $_ = shift; |
|
172 my @units = qw(B K M G T); |
|
173 while (length int > 3 and @units) { |
|
174 $_ = sprintf "%.1f" => $_/1024; |
|
175 shift @units; |
|
176 } |
|
177 croak "filesize is too big (can't convert to human readable number" |
|
178 if !@units; |
|
179 return "$_$units[0]"; |
|
180 } |