%formdata = ();

# CGI parsing routine taken from "Perl and CGI for the World Wide Web" by
# Elizabeth Castro
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
    @pairs = split(/&/, $ENV{'QUERY_STRING'});
    &parse_querystring;
} elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
    # 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;
    }
}

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;

        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;
    }
}

1;