+sub parse_multipart_form_data() {
+ # First of all, find the boundary string
+ my $ct = rfc822_prepare($ENV{"CONTENT_TYPE"});
+ if (!(($boundary) = ($ct =~ /^.*;boundary=([^; ]+)/))) {
+ die "Multipart content with no boundary string received";
+ }
+ $boundary = rfc822_deescape($boundary);
+ print STDERR "BOUNDARY IS $boundary\n" if $debug;
+
+ # BUG: IE 3.01 on Macintosh forgets to add the "--" at the start of the boundary string
+ # as the MIME specs preach. Workaround borrowed from CGI.pm in Perl distribution.
+ my $agent = http_get("User-agent") || "";
+ $boundary = "--$boundary" unless $agent =~ /MSIE\s+3\.0[12];\s*Mac/;
+ $boundary = "\r\n$boundary";
+ $boundary_len = length($boundary) + 2;
+
+ # Check upload size in advance
+ if (my $size = http_get("Content-Length")) {
+ my $max_allowed = 0;
+ foreach my $a (values %$arg_table) {
+ $max_allowed += $a->{"maxsize"} || 65536;
+ }
+ if ($size > $max_allowed) {
+ die "Maximum form data length exceeded";
+ }
+ }
+
+ # Initialize our buffering mechanism and part splitter
+ $mp_buffer = "\r\n";
+ $mp_buffer_i = 0;
+ $mp_buffer_boundary = -1;
+ $mp_eof = 0;
+
+ # Skip garbage before the 1st part
+ while (my $i = refill_mp_data(256)) { $mp_buffer_i += $i; }
+ skip_mp_boundary() || return;
+
+ # Process individual parts
+ do { PART: {
+ print STDERR "NEXT PART\n" if $debug;
+ my $h = parse_mp_header();
+ my ($field, $cdisp, $a);
+ if ($h &&
+ ($cdisp = $h->{"content-disposition"}) &&
+ $cdisp =~ /^form-data/ &&
+ (($field) = ($cdisp =~ /;name=([^;]+)/)) &&
+ ($a = $arg_table->{"$field"})) {
+ print STDERR "FIELD $field\n" if $debug;
+ if (defined $h->{"content-transfer-encoding"}) { die "Unexpected Content-Transfer-Encoding"; }
+ if (defined $a->{"var"}) {
+ while (defined (my $l = get_mp_line(1))) {
+ print STDERR "VALUE $l\n" if $debug;
+ parse_arg_string("$field=$l");
+ }
+ next PART;
+ } elsif (defined $a->{"file"}) {
+ require File::Temp;
+ require IO::Handle;
+ my $max_size = $a->{"maxsize"} || 1048576;
+ my @tmpargs = (undef, UNLINK => 1);
+ push @tmpargs, DIR => $a->{"tmpdir"} if defined $a->{"tmpdir"};
+ my ($fh, $fn) = File::Temp::tempfile(@tmpargs);
+ print STDERR "FILE UPLOAD to $fn\n" if $debug;
+ ${$a->{"file"}} = $fn;
+ ${$a->{"fh"}} = $fh if defined $a->{"fh"};
+ my $total_size = 0;
+ while (my $i = refill_mp_data(4096)) {
+ print $fh substr($mp_buffer, $mp_buffer_i, $i);
+ $mp_buffer_i += $i;
+ $total_size += $i;
+ if ($total_size > $max_size) { die "Uploaded file too long"; }
+ }
+ $fh->flush(); # Don't close the handle, the file would disappear otherwise
+ next PART;
+ }
+ }
+ print STDERR "SKIPPING\n" if $debug;
+ while (my $i = refill_mp_data(256)) { $mp_buffer_i += $i; }
+ } } while (skip_mp_boundary());
+}
+
+### Generating Self-ref URL's ###
+