21 # gesetzt werden. |
21 # gesetzt werden. |
22 |
22 |
23 use 5.010; |
23 use 5.010; |
24 use strict; |
24 use strict; |
25 use warnings; |
25 use warnings; |
|
26 use Cwd qw(abs_path); |
26 use CGI qw(:all *table); |
27 use CGI qw(:all *table); |
27 use CGI::Carp qw(fatalsToBrowser); |
28 use CGI::Carp qw(fatalsToBrowser); |
28 use CGI::Pretty; |
29 use CGI::Pretty; |
29 use File::Basename; |
30 use File::Basename; |
|
31 use FindBin qw($Bin); |
30 use Digest::MD5 qw(md5_hex); |
32 use Digest::MD5 qw(md5_hex); |
31 use OSSP::uuid; |
33 use OSSP::uuid; |
|
34 use Template; |
32 |
35 |
33 my $DIR = "d/{view}"; |
36 my $DIR = "d/{view}"; |
34 my $DIR_URI = "/$DIR"; |
37 my $DIR_URI = "./$DIR"; |
35 |
38 |
36 sub human($); |
39 sub human($); |
37 |
40 |
38 delete @ENV{ grep /PATH/, keys %ENV }; |
41 delete @ENV{ grep /PATH/, keys %ENV }; |
39 $ENV{PATH} = "/usr/local/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin"; |
42 $ENV{PATH} = "/usr/local/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin"; |
40 |
43 |
41 $_ = dirname $DIR; |
44 $_ = dirname $DIR; |
42 -d or mkdir $_ => 0750 |
45 -d or mkdir $_ => 0750 |
43 or die "Can't mkdir $_: $!\n"; |
46 or die "Can't mkdir $_: $!\n"; |
|
47 |
|
48 |
|
49 my %TT2_CONFIG = ( |
|
50 INCLUDE_PATH => ["$Bin/tt2", dirname(abs_path($0)) . "/tt2"], |
|
51 CONSTANTS => { |
|
52 source => "https://ssl.schlittermann.de/hg/anon-upload/", |
|
53 author => { name => "Heiko Schlittermann", |
|
54 link => "mailto:hs\@schlittermann.de" }, |
|
55 |
|
56 }, |
|
57 CONSTANTS_NAMESPACE => "const", |
|
58 ); |
44 |
59 |
45 MAIN: { |
60 MAIN: { |
46 |
61 |
47 # per view we have an own directory |
62 # per view we have an own directory |
48 |
63 |
52 $DIR_URI =~ s/{view}/$_/g; |
67 $DIR_URI =~ s/{view}/$_/g; |
53 -d $DIR |
68 -d $DIR |
54 or mkdir $DIR => 0750 |
69 or mkdir $DIR => 0750 |
55 or die "Can't mkdir $DIR: $!\n"; |
70 or die "Can't mkdir $DIR: $!\n"; |
56 |
71 |
57 if (param("delete") =~ /([-a-z\d]+-\d+)/i) { |
72 # |
|
73 # delete is simple |
|
74 # |
|
75 |
|
76 if (param("op") eq "rm") { |
|
77 param("id") =~ /([-a-z\d]+-\d+)/i; |
58 my $dir = $1; |
78 my $dir = $1; |
59 if (-d "$DIR/$dir") { |
79 if (-d "$DIR/$dir") { |
60 unlink map { /(.*)/ && $1 } glob("$DIR/$dir/*") |
80 unlink map { /(.*)/ && $1 } glob("$DIR/$dir/*") |
61 or die "Can't unlink $DIR/$dir/*: $!\n"; |
81 or die "Can't unlink $DIR/$dir/*: $!\n"; |
62 rmdir "$DIR/$dir" or die "Can't rmdir $DIR/$dir: $!\n"; |
82 rmdir "$DIR/$dir" or die "Can't rmdir $DIR/$dir: $!\n"; |
63 } |
83 } |
64 print redirect(-uri => url(-path_info => 1)); |
84 print redirect(-uri => url(-path_info => 1)); |
65 exit 0; |
85 exit 0; |
66 } |
86 } |
67 |
87 |
68 print header(-charset => "UTF-8"), |
88 # |
69 start_html(-title => "Up&Down"), |
89 # admin request |
70 h1 "Ansicht: $ENV{REMOTE_USER}"; |
90 # |
|
91 if (param("op") eq "admin") { |
|
92 my $tt = Template->new(%TT2_CONFIG) |
|
93 or die Template->error(); |
|
94 print header(-charset => "UTF-8"); |
|
95 $tt->process("admin" => { |
|
96 }) or die $tt->error; |
|
97 exit 0; |
|
98 } |
71 |
99 |
72 # print Dump; |
100 # |
|
101 # it is an upload |
|
102 # |
73 |
103 |
74 if (length(my $file = param("upload"))) { |
104 if (length(my $file = param("upload"))) { |
75 my $days = param("expires"); |
105 my $days = param("expires"); |
76 my $expires; |
106 my $expires; |
77 tie my $uuid => "OSSP::uuid::tie", "v4"; |
107 tie my $uuid => "OSSP::uuid::tie", "v4"; |
95 if (open(my $atfh, "|-" => "at now + $days days")) { |
125 if (open(my $atfh, "|-" => "at now + $days days")) { |
96 print {$atfh} |
126 print {$atfh} |
97 "rm -f \"$dir/$filename\"\n", |
127 "rm -f \"$dir/$filename\"\n", |
98 "rmdir \"$dir\"\n"; |
128 "rmdir \"$dir\"\n"; |
99 close $atfh; |
129 close $atfh; |
100 system("cat /tmp/log"); |
|
101 } |
130 } |
|
131 } |
|
132 |
|
133 # |
|
134 # now check for existing files |
|
135 # |
|
136 my @files; |
|
137 foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") { |
|
138 my ($file, $dir) = fileparse($_); |
|
139 $dir = basename $dir; |
|
140 |
|
141 # $dir =~ /(?<hash>\S+)-(?<expires>\d+)$/ or next; |
|
142 $dir =~ /(\S+)-(\d+)$/ or next; |
|
143 my $hash = $1; |
|
144 my $expires = $2; |
|
145 if ($expires <= time) { |
|
146 /(.*)/; |
|
147 unlink $_ or die "Can't unlik $_: $!\n"; |
|
148 rmdir $dir or die "Can't rmdir $dir: $!\n"; |
|
149 next; |
|
150 } |
|
151 |
|
152 push @files, { |
|
153 link => "$DIR_URI/$dir/$file", |
|
154 name => $file, |
|
155 size => human((stat $_)[7]), |
|
156 mtime => (stat $_)[9], |
|
157 dtime => $expires, |
|
158 dlink => "?op=rm&id=$dir", |
|
159 } |
102 |
160 |
103 } |
161 } |
104 print hr; |
|
105 |
162 |
106 if (my @files = glob "$DIR/*-*/*") { |
163 # |
107 |
164 # the rest uses some templates |
108 #print "<pre>", |
165 # |
109 #(map { "$_: $ENV{$_}\n" } sort keys %ENV), |
166 my $tt = Template->new(%TT2_CONFIG) or die Template->error(); |
110 #"</pre>"; |
167 print header(-charset => "UTF-8"); |
111 |
168 $tt->process("overview" => { |
112 print p <<__; |
169 alink => "?op=admin", |
113 Der gültige Download-Link ist die Link-Adresse, die sich hinter |
170 view => $ENV{REMOTE_USER}, |
114 dem Datei-Namen verbirgt. (Firefox: Rechte Maustaste, Link-Location). |
171 directory => $DIR, |
115 Nach Ablauf des <a href="http://de.wikipedia.org/wiki/Mindesthaltbarkeitsdatum">MHD</a> |
172 sel => { 7 => "selected" }, |
116 wird die Datei automatisch gelöscht. |
173 files => \@files, |
117 __ |
174 }) or die $tt->error; |
118 |
175 exit 0; |
119 print start_table, |
|
120 Tr(th { align => "left" }, [qw/Name Größe Hochgeladen Löschung/]); |
|
121 |
|
122 foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") { |
|
123 my ($file, $dir) = fileparse($_); |
|
124 $dir = basename $dir; |
|
125 |
|
126 # $dir =~ /(?<hash>\S+)-(?<expires>\d+)$/ or next; |
|
127 $dir =~ /(\S+)-(\d+)$/ or next; |
|
128 my $hash = $1; |
|
129 my $expires = $2; |
|
130 if (${expires} <= time) { |
|
131 /(.*)/; |
|
132 unlink $_ or die "Can't unlik $_: $!\n"; |
|
133 rmdir $dir or die "Can't rmdir $dir: $!\n"; |
|
134 next; |
|
135 } |
|
136 |
|
137 print Tr( |
|
138 td(a { href => "$DIR_URI/$dir/$file" }, $file), |
|
139 td({ align => "right" }, human((stat $_)[7])), |
|
140 td(scalar localtime +(stat $_)[9]), |
|
141 td(scalar localtime ${expires}), |
|
142 td(a({ href => "?delete=$dir" }, "remove")) |
|
143 ); |
|
144 } |
|
145 |
|
146 print end_table, hr; |
|
147 } |
|
148 |
|
149 print start_multipart_form, start_table, |
|
150 Tr(td("Dateiname: "), |
|
151 td(filefield(-name => "upload", -default => "nothing")), |
|
152 ), |
|
153 Tr(td("Löschen in: "), td(textfield(-name => "expires", -default => 10)), |
|
154 td("Tagen")), |
|
155 Tr(td(), td(submit(-value => "Hochladen")),), |
|
156 end_table, |
|
157 end_multipart_form; |
|
158 |
|
159 print hr, |
|
160 div( |
|
161 { -align => "right" }, |
|
162 a( |
|
163 { -href => "https://keller.schlittermann.de/hg/anon-upload/" } => |
|
164 "Scripting" |
|
165 ), |
|
166 " © 2010,2011 ", |
|
167 a({ -href => "http://www.schlittermann.de/" } => "Heiko Schlittermann") |
|
168 ), |
|
169 end_html; |
|
170 } |
176 } |
171 |
177 |
172 sub human($) { |
178 sub human($) { |
173 my $_ = shift; |
179 my $_ = shift; |
174 my @units = qw(B K M G T); |
180 my @units = qw(B K M G T); |