commit:32c41bdd5204fc373d545f03e9ebcade902446d5
author:Chip Black
committer:Chip Black
date:Wed Aug 9 23:56:57 2017 -0500
parents:688e69de9dbf3b6a0e89ca7ed80a980208c78554
Support multipart/form-data
diff --git a/cgi-bin/form.lib b/cgi-bin/form.lib
line changes: +69/-14
index 641a9f8..4699cfc
--- a/cgi-bin/form.lib
+++ b/cgi-bin/form.lib
@@ -4,25 +4,80 @@
 # Elizabeth Castro
 if ($ENV{'REQUEST_METHOD'} eq 'GET') {
     @pairs = split(/&/, $ENV{'QUERY_STRING'});
+    &parse_querystring;
 } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
-    read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
-    @pairs = split(/&/, $buffer);
+    # Garth says the reason the server keeps crashing is because the form
+    # uploads are using too much memory.  I told him these old Solaris boxes
+    # aren't cutting it and we should switch to Linux.  This'll keep things
+    # running. -cb
+    if ($ENV{'CONTENT_LENGTH'} > 102400) {
+        print "Status: 413 Request Entity Too Large\r\n";
+        print "Content-Type: text/plain\r\n\r\n";
+        print "Upload too large";
+        exit 0;
+    }
+    if ($ENV{'CONTENT_TYPE'} =~ /^multipart\/form-data/) {
+        $boundary = (split(/;/, $ENV{'CONTENT_TYPE'}))[1];
+        $boundary = (split(/=/, $boundary))[1];
+        read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
+        @parts = split(/(?:\r\n)?--$boundary(?:\r\n)?/, $buffer);
+        shift @parts;
+        pop @parts;
+        &parse_multipart;
+    } else {
+        read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
+        @pairs = split(/&/, $buffer);
+        &parse_querystring;
+    }
 }
 
-foreach $pair (@pairs) {
-    ($key, $value) = split(/=/, $pair);
-    $key =~ tr/+/ /;
-    $key =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
-    $value =~ tr/+/ /;
-    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
+sub parse_querystring {
+    foreach $pair (@pairs) {
+        ($key, $value) = split(/=/, $pair);
+        $key =~ tr/+/ /;
+        $key =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
+        $value =~ tr/+/ /;
+        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
 
-    # I don't even understand this -cb
-    $value =~ s/<!--(.|\n)*-->//g;
+        # I don't even understand this -cb
+        $value =~ s/<!--(.|\n)*-->//g;
 
-    if ($formdata{$key}) {
-        $formdata{$key} .= ", $value";
-    } else {
-        $formdata{$key} = $value;
+        if ($formdata{$key}) {
+            $formdata{$key} .= ", $value";
+        } else {
+            $formdata{$key} = $value;
+        }
+    }
+}
+
+sub parse_multipart {
+    for $part (@parts) {
+        %part_headers = ();
+        $name = '';
+        ($head, $content) = split(/\r\n\r\n/, $part);
+        @fields = split(/\r\n/, $head);
+        for $field (@fields) {
+            ($key, $value) = split(/:\s*/, $field);
+            if ($key eq 'Content-Disposition') {
+                ($type, @extra) = split(/;\s*/, $value);
+                if ($type ne 'form-data') {
+                    print "400 Bad Request\r\n\r\n";
+                    print STDERR "Invalid form data type: $type\n";
+                    exit 1;
+                }
+                for $e (@extra) {
+                    ($k, $v) = split(/=/, $e);
+                    $v =~ s/^"//;
+                    $v =~ s/"$//;
+                    if ($k eq 'name') {
+                        $name = $v;
+                    } elsif ($k eq 'filename') {
+                        $filenames{$name} = $v;
+                    }
+                }
+            }
+        }
+        $formdata{$name} = $content;
     }
 }