uploader/daemon.pl

   1 #!/usr/bin/perl
   2
   3 # This program is in the public domain within the United States. Additionally,
   4 # we waive copyright and related rights in the work worldwide through the CC0
   5 # 1.0 Universal public domain dedication, which can be found at
   6 # http://creativecommons.org/publicdomain/zero/1.0/
   7
   8 # WARNING: This is an old hack to get the server to report download progress
   9 # through a side channel. You almost definitely don't need this these days, as
  10 # modern browsers give access to this information on any upload via javascript.
  11
  12 # FIXME rewrite to use non-blocking IO and put limits on waiting
  13
  14 #use Fcntl;
  15
  16 #$flags = '';
  17 #fcntl(HANDLE, F_GETFL, $flags)
  18 #    or die "Couldn't get flags for HANDLE : $!\n";
  19 #$flags |= O_NONBLOCK;
  20 #fcntl(HANDLE, F_SETFL, $flags)
  21 #    or die "Couldn't set flags for HANDLE: $!\n";
  22 #
  23 #Once a filehandle is set for non-blocking I/O, the sysread or syswrite calls that would block will instead return undef and
  24 #set $! to EAGAIN:
  25
  26
  27 use strict;
  28
  29 use vars qw($output_path $g_filename $flags $buffer $the_end $refills_at_end $content_length $bytes_written $progress_written $bytes_left $boundary);
  30
  31 $output_path = $ARGV[0];
  32
  33 $the_end = 0;
  34 $content_length = -1;
  35 $boundary = '';
  36 $refills_at_end = 0;
  37 $bytes_left = 4000; # if the headers are bigger than this... too bad
  38 # FIXME if the entire request (including file contents) is less than 4000 this causes the program to hang. This happens with firefox when the file is deleted before hitting submit
  39
  40 sub refill_buffer {
  41         my $ret;
  42         my $size;
  43         my $max_read;
  44         $size = length $buffer;
  45         if($the_end == 1 || $bytes_left - $size < 1) {
  46                 $refills_at_end += 1;
  47                 if($refills_at_end > 10) {
  48                         die('refill_buffer called too many times (11) after EOF was reached');
  49                 }
  50                 return;
  51         }
  52         return unless $size < 1000;
  53         $max_read = (1100 - $size);
  54         if($max_read > ($bytes_left - $size)) {
  55                 $max_read = ($bytes_left - $size);
  56         }
  57         $ret = sysread STDIN, $buffer, $max_read, $size;
  58         if($ret == 0) {
  59                 $the_end = 1;
  60         } elsif($ret == undef) {
  61                 die("read returned: " . $!);
  62         }
  63 }
  64
  65 # remove x bytes from buffer and return them
  66 # read_line doesn't use this, but keeps bytes_count anyway
  67 sub read_buff {
  68         my $count = shift;
  69         my $str;
  70         $str = substr $buffer, 0, $count;
  71         $buffer = substr $buffer, $count;
  72         $bytes_left -= $count;
  73         return $str;
  74 }
  75
  76 # mark the entire buffer as used
  77 sub buffer_used {
  78         $bytes_left -= length $buffer;
  79         $buffer = '';
  80 }
  81
  82 # returns the next line from the input stream (not including the trailing crlf)
  83 sub read_line {
  84         my $size;
  85         my $crlf_index;
  86         my $line;
  87         refill_buffer();
  88         $size = length $buffer;
  89         $crlf_index = index $buffer, "\r\n";
  90         if($crlf_index < 0) {
  91                 die("expected a line, but didn't find a CRLF for $size characters (bytes_left: $bytes_left)");
  92         }
  93         $line = substr $buffer, 0, $crlf_index;
  94         $buffer = substr $buffer, ($crlf_index + 2);
  95         $bytes_left -= $crlf_index + 2;
  96         return $line;
  97 }
  98
  99 sub parse_main_headers {
 100         my $line;
 101         my $i;
 102
 103         $line = read_line;
 104         $i = index($line, '/');
 105         die(500) if $i < 0;
 106         $line = substr($line, $i + 1);
 107         $i = index($line, ' ');
 108         die(501) if $i < 0;
 109         $line = substr($line, 0, $i);
 110
 111         if($line eq '') {
 112                 # FIXME return 404?
 113                 die('no filename passed');
 114         }
 115
 116         $line = lc($line);
 117         $line =~ s/[^a-z0-9.-]/_/g;
 118         $line =~ s/^[.-]/_/;
 119
 120         $g_filename = $line;
 121
 122
 123
 124         while(1) {
 125                 $line = read_line;
 126                 if(substr(lc($line), 0, 16) eq 'content-length: ') {
 127                         $content_length = substr($line, 16);
 128                 } elsif(substr(lc($line), 0, 14) eq 'content-type: ') {
 129                         $i = index(lc($line), 'boundary=');
 130                         if($i < 0) {
 131                                 die('no boundary= in content-type header');
 132                         }
 133                         $boundary = substr $line, ($i + 9);
 134                 } elsif($line eq '') {
 135                         if($content_length == -1) {
 136                                 die('No Content-Length header');
 137                         }
 138                         if($boundary eq "") {
 139                                 die('No boundary found in headers');
 140                         }
 141                         $boundary = '--' . $boundary;
 142                         $bytes_left = $content_length;
 143                         return;
 144                 }
 145         }
 146 }
 147
 148 # pass int from 0-1000
 149 sub progress_bar_update {
 150         my $pct = shift;
 151         my $dots;
 152         if($pct > $progress_written) {
 153                 syswrite(PROGRESS_FD, '............................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................', $pct - $progress_written);
 154                 $progress_written = $pct;
 155         }
 156 }
 157
 158 sub progress_bar_start {
 159         my $progress_filename = shift; # global
 160         $progress_written = 0;
 161         $bytes_written = 0;
 162         open PROGRESS_FD, ">$progress_filename";
 163 }
 164
 165 sub progress_bar_finish {
 166         progress_bar_update(1000);
 167         close PROGRESS_FD;
 168 }
 169
 170
 171 # save bytes past and update progress bar
 172 sub output {
 173         my $out = shift;
 174         my $prog;
 175         print FD $out;
 176
 177         # update progressbar
 178         $bytes_written += length($out);
 179         $prog = $bytes_written / $content_length; # FIXME off by size of headers. do we care?
 180         $prog = int($prog * 999 + .99);
 181         progress_bar_update($prog);
 182 }
 183
 184 sub save_to_next_boundary {
 185         my $filename = shift;
 186         my $i;
 187         my $crlfboundary = "\r\n$boundary";
 188         open FD, ">$output_path/partial/$filename";
 189         progress_bar_start("$output_path/progress/$filename");
 190         while(1) {
 191                 refill_buffer;
 192                 $i = index $buffer, $crlfboundary;
 193                 if($i < 0) {
 194                         output $buffer;
 195                         buffer_used;
 196                 } else {
 197                         if ($i > 0) {
 198                                 output(read_buff($i));
 199                         }
 200                         read_buff(2); # remove crlf between content and boundary #FIXME make sure this exists
 201                         close FD;
 202                         progress_bar_finish();
 203                         return;
 204                 }
 205         }
 206 }
 207
 208
 209 sub parse_sub {
 210         my $sub_length = -1;
 211         my $line;
 212         my $i;
 213         my $i2;
 214
 215         while(1) {
 216                 $line = lc(read_line());
 217                 if($line eq "") {
 218                         return save_to_next_boundary($g_filename);
 219                 }
 220                 #if(substr($line, 0, 21) eq 'content-disposition: ') {
 221                 #       $i = index($line, 'filename="');
 222                 #       if($i < 0) {
 223                 #               die('no filename=" in content-disposition sub-header');
 224                 #       }
 225                 #       $i2 = index($line, '"', ($i + 10));
 226                 #       if($i2 < 0) {
 227                 #               die('no filename=" in content-disposition sub-header');
 228                 #       }
 229                 #       $filename = lc(substr($line, ($i + 10), ($i2 - ($i + 10))));
 230                 #       $filename =~ s/[^a-z0-9.-]/_/g;
 231                 #       $filename =~ s/^[.-]/_/;
 232                 #} elsif($line eq '') {
 233                 #       if($filename eq "") {
 234                 #               die('No filename found in headers on part');
 235                 #       }
 236                 #       return save_to_next_boundary($filename);
 237                 #}
 238         }
 239 }
 240
 241 sub reply_and_quit {
 242         print "HTTP/1.1 200 OK\r\nConnection: close\r\nContent-Type: text/plain\r\nContent-Length: 8\r\n\r\nReceived";
 243         exit 0;
 244 }
 245
 246 sub parse_body {
 247         my $line;
 248
 249         while(1) {
 250                 $line = read_line;
 251                 if($line eq $boundary) {
 252                         parse_sub;
 253                 } elsif($line eq ($boundary . '--')) {
 254                         reply_and_quit;
 255                 } else {
 256                         die("Expecting boundary \"$boundary\" but got: \"$line\"");
 257                 }
 258         }
 259 }
 260
 261
 262 #$flags = '';
 263 #fcntl(STDIN, F_GETFL, $flags)
 264 #    or die "Couldn't get flags for STDIN : $!\n";
 265 #$flags |= O_NONBLOCK;
 266 #fcntl(STDIN, F_SETFL, $flags)
 267 #    or die "Couldn't set flags for STDIN: $!\n";
 268 parse_main_headers;
 269 parse_body;