uploader/daemon.pl

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