91 if (param("op") eq "admin") { |
93 if (param("op") eq "admin") { |
92 my $tt = Template->new(%TT2_CONFIG) |
94 my $tt = Template->new(%TT2_CONFIG) |
93 or die Template->error(); |
95 or die Template->error(); |
94 print header(-charset => "UTF-8"); |
96 print header(-charset => "UTF-8"); |
95 $tt->process("admin" => { |
97 $tt->process("admin" => { |
|
98 view => $ENV{REMOTE_USER}, |
|
99 alink => "?op=admin", |
96 }) or die $tt->error; |
100 }) or die $tt->error; |
97 exit 0; |
101 exit 0; |
98 } |
102 } |
99 |
103 |
100 # |
104 # |
101 # it is an upload |
105 # it is an upload |
102 # |
106 # |
103 |
107 |
104 if (length(my $file = param("upload"))) { |
108 if (length(param("upload"))) { |
105 my $days = param("expires"); |
109 _upload(param("upload"), param("expires")); |
106 my $expires; |
|
107 tie my $uuid => "OSSP::uuid::tie", "v4"; |
|
108 |
|
109 # sanitize expires |
|
110 $days =~ /.*?(\d+).*/; |
|
111 $days = defined $1 ? $1 : 10; |
|
112 $expires = time + $days * 86400; |
|
113 |
|
114 # sanitizing the filename |
|
115 (my $filename = $file) =~ tr /\\/\//; |
|
116 $filename =~ /(.*)/; |
|
117 $filename = $1; |
|
118 |
|
119 my $dir = "$DIR/$uuid-$expires"; |
|
120 mkdir $dir, 0750 or die "Can't mkdir $dir: $!\n"; |
|
121 open(my $outfh, ">" => "$dir/$filename") |
|
122 or die "Can't create $dir/$filename: $!\n"; |
|
123 print {$outfh} <$file>; |
|
124 |
|
125 if (open(my $atfh, "|-" => "at now + $days days")) { |
|
126 print {$atfh} |
|
127 "rm -f \"$dir/$filename\"\n", |
|
128 "rmdir \"$dir\"\n"; |
|
129 close $atfh; |
|
130 } |
|
131 } |
110 } |
132 |
111 |
133 # |
112 my @files = _get_files($DIR, $DIR_URI); |
134 # now check for existing files |
113 |
135 # |
114 # |
|
115 # the rest uses some templates |
|
116 # |
|
117 my $tt = Template->new(%TT2_CONFIG) or die Template->error(); |
|
118 print header(-charset => "UTF-8"); |
|
119 $tt->process("overview" => { |
|
120 alink => "?op=admin", |
|
121 view => $ENV{REMOTE_USER}, |
|
122 directory => "$DIR | " . path_info() . " | " . url(-path => 0), |
|
123 sel => { 7 => "selected" }, |
|
124 files => \@files, |
|
125 }) or die $tt->error; |
|
126 exit 0; |
|
127 } |
|
128 |
|
129 sub _upload($$) { |
|
130 my ($file, $days) = @_; |
|
131 my $expires; |
|
132 tie my $uuid => "OSSP::uuid::tie", "v4"; |
|
133 |
|
134 # sanitize expires |
|
135 $days =~ /.*?(\d+).*/; |
|
136 $days = defined $1 ? $1 : 10; |
|
137 $expires = time + $days * 86400; |
|
138 |
|
139 # sanitizing the filename |
|
140 (my $filename = $file) =~ tr /\\/\//; |
|
141 $filename =~ /(.*)/; |
|
142 $filename = $1; |
|
143 |
|
144 my $dir = "$DIR/$uuid-$expires"; |
|
145 mkdir $dir, 0750 or die "Can't mkdir $dir: $!\n"; |
|
146 open(my $outfh, ">" => "$dir/$filename") |
|
147 or die "Can't create $dir/$filename: $!\n"; |
|
148 print {$outfh} <$file>; |
|
149 |
|
150 if (open(my $atfh, "|-" => "at now + $days days")) { |
|
151 print {$atfh} |
|
152 "rm -f \"$dir/$filename\"\n", |
|
153 "rmdir \"$dir\"\n"; |
|
154 close $atfh; |
|
155 } |
|
156 } |
|
157 |
|
158 sub _get_files($$) { |
|
159 my ($base, $base_uri) = @_; |
|
160 |
136 my @files; |
161 my @files; |
137 foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") { |
162 foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$base/*-*/*") { |
138 my ($file, $dir) = fileparse($_); |
163 my ($file, $dir) = fileparse($_); |
139 $dir = basename $dir; |
164 $dir = basename $dir; |
140 |
165 |
141 # $dir =~ /(?<hash>\S+)-(?<expires>\d+)$/ or next; |
|
142 $dir =~ /(\S+)-(\d+)$/ or next; |
166 $dir =~ /(\S+)-(\d+)$/ or next; |
143 my $hash = $1; |
167 my $hash = $1; |
144 my $expires = $2; |
168 my $expires = $2; |
145 if ($expires <= time) { |
169 if ($expires <= time) { |
146 /(.*)/; |
170 /(.*)/; |
148 rmdir $dir or die "Can't rmdir $dir: $!\n"; |
172 rmdir $dir or die "Can't rmdir $dir: $!\n"; |
149 next; |
173 next; |
150 } |
174 } |
151 |
175 |
152 push @files, { |
176 push @files, { |
153 link => "$DIR_URI/$dir/$file", |
177 link => "$base_uri/$dir/$file", |
154 name => $file, |
178 name => $file, |
155 size => human((stat $_)[7]), |
179 size => _human((stat $_)[7]), |
156 mtime => (stat $_)[9], |
180 mtime => (stat $_)[9], |
157 dtime => $expires, |
181 dtime => $expires, |
158 dlink => "?op=rm&id=$dir", |
182 dlink => "?op=rm&id=$dir", |
159 } |
183 } |
160 |
184 |
161 } |
185 } |
162 |
186 return @files; |
163 # |
|
164 # the rest uses some templates |
|
165 # |
|
166 my $tt = Template->new(%TT2_CONFIG) or die Template->error(); |
|
167 print header(-charset => "UTF-8"); |
|
168 $tt->process("overview" => { |
|
169 alink => "?op=admin", |
|
170 view => $ENV{REMOTE_USER}, |
|
171 directory => $DIR, |
|
172 sel => { 7 => "selected" }, |
|
173 files => \@files, |
|
174 }) or die $tt->error; |
|
175 exit 0; |
|
176 } |
187 } |
177 |
188 |
178 sub human($) { |
189 sub _human($) { |
179 my $_ = shift; |
190 my $_ = shift; |
180 my @units = qw(B K M G T); |
191 my @units = qw(B K M G T); |
181 while (length int > 3 and @units) { |
192 while (length int > 3 and @units) { |
182 $_ = sprintf "%.1f" => $_ / 1024; |
193 $_ = sprintf "%.1f" => $_ / 1024; |
183 shift @units; |
194 shift @units; |