uploader/daemon.pl

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