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/
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.
12 # FIXME rewrite to use non-blocking IO and put limits on waiting
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";
23 #Once a filehandle is set for non-blocking I/O, the sysread or syswrite calls that would block will instead return undef and
29 use vars qw($output_path $g_filename $flags $buffer $the_end $refills_at_end $content_length $bytes_written $progress_written $bytes_left $boundary);
31 $output_path = $ARGV[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
44 $size = length $buffer;
45 if($the_end == 1 || $bytes_left - $size < 1) {
47 if($refills_at_end > 10) {
48 die('refill_buffer called too many times (11) after EOF was reached');
52 return unless $size < 1000;
53 $max_read = (1100 - $size);
54 if($max_read > ($bytes_left - $size)) {
55 $max_read = ($bytes_left - $size);
57 $ret = sysread STDIN, $buffer, $max_read, $size;
60 } elsif($ret == undef) {
61 die("read returned: " . $!);
65 # remove x bytes from buffer and return them
66 # read_line doesn't use this, but keeps bytes_count anyway
70 $str = substr $buffer, 0, $count;
71 $buffer = substr $buffer, $count;
72 $bytes_left -= $count;
76 # mark the entire buffer as used
78 $bytes_left -= length $buffer;
82 # returns the next line from the input stream (not including the trailing crlf)
88 $size = length $buffer;
89 $crlf_index = index $buffer, "\r\n";
91 die("expected a line, but didn't find a CRLF for $size characters (bytes_left: $bytes_left)");
93 $line = substr $buffer, 0, $crlf_index;
94 $buffer = substr $buffer, ($crlf_index + 2);
95 $bytes_left -= $crlf_index + 2;
99 sub parse_main_headers {
104 $i = index($line, '/');
106 $line = substr($line, $i + 1);
107 $i = index($line, ' ');
109 $line = substr($line, 0, $i);
113 die('no filename passed');
117 $line =~ s/[^a-z0-9.-]/_/g;
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=');
131 die('no boundary= in content-type header');
133 $boundary = substr $line, ($i + 9);
134 } elsif($line eq '') {
135 if($content_length == -1) {
136 die('No Content-Length header');
138 if($boundary eq "") {
139 die('No boundary found in headers');
141 $boundary = '--' . $boundary;
142 $bytes_left = $content_length;
148 # pass int from 0-1000
149 sub progress_bar_update {
152 if($pct > $progress_written) {
153 syswrite(PROGRESS_FD, '............................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................................', $pct - $progress_written);
154 $progress_written = $pct;
158 sub progress_bar_start {
159 my $progress_filename = shift; # global
160 $progress_written = 0;
162 open PROGRESS_FD, ">$progress_filename";
165 sub progress_bar_finish {
166 progress_bar_update(1000);
171 # save bytes past and update progress bar
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);
184 sub save_to_next_boundary {
185 my $filename = shift;
187 my $crlfboundary = "\r\n$boundary";
188 open FD, ">$output_path/partial/$filename";
189 progress_bar_start("$output_path/progress/$filename");
192 $i = index $buffer, $crlfboundary;
198 output(read_buff($i));
200 read_buff(2); # remove crlf between content and boundary #FIXME make sure this exists
202 progress_bar_finish();
216 $line = lc(read_line());
218 return save_to_next_boundary($g_filename);
220 #if(substr($line, 0, 21) eq 'content-disposition: ') {
221 # $i = index($line, 'filename="');
223 # die('no filename=" in content-disposition sub-header');
225 # $i2 = index($line, '"', ($i + 10));
227 # die('no filename=" in content-disposition sub-header');
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');
236 # return save_to_next_boundary($filename);
242 print "HTTP/1.1 200 OK\r\nConnection: close\r\nContent-Type: text/plain\r\nContent-Length: 8\r\n\r\nReceived";
251 if($line eq $boundary) {
253 } elsif($line eq ($boundary . '--')) {
256 die("Expecting boundary \"$boundary\" but got: \"$line\"");
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";