dont return and/or delete files on HEAD requests once
authorMatthias Förste <foerste@schlittermann.de>
Tue, 07 Oct 2014 10:44:10 +0200
branchonce
changeset 30 e3f90a124398
parent 29 aebcf858b3b0
child 31 49165dc3954d
dont return and/or delete files on HEAD requests
upload.pl
--- a/upload.pl	Mon Oct 06 15:17:51 2014 +0200
+++ b/upload.pl	Tue Oct 07 10:44:10 2014 +0200
@@ -64,12 +64,14 @@
 
 		open F, '<', $absolute or die "Can't open '<', '$absolute': $!";
 		print header(-type => mimetype($absolute));
-		my ($buf, $res);
-		print $buf while $res = read F, $buf, 32*2**10;
-		defined $res or die "Can't read: $!";
+                if (request_method() ~~ [qw(GET POST)]) {
+                    my ($buf, $res);
+                    print $buf while $res = read F, $buf, 32*2**10;
+                    defined $res or die "Can't read: $!";
 
-		(my $dir = $relative) =~ s|/[^/]+$||;
-		deletedir $dir if $dir =~ /-d$/;
+                    (my $dir = $relative) =~ s|/[^/]+$||;
+                    deletedir $dir if $dir =~ /-d$/;
+                }
 		exit 0;
 
 	}