# This software may be freely distributed and used according to the terms
# of the GNU Lesser General Public License.
-# FIXME:
-# - respond with proper HTTP error codes
-# - if we get invalid parameters, generate HTTP error or redirect
-
package UCW::CGI;
# First of all, set up error handling, so that even errors during parsing
if (defined($UCW::CGI::error_hook)) {
&$UCW::CGI::error_hook($_[0]);
} else {
- print "Content-type: text/plain\n\n";
+ print "Content-Type: text/plain\n\n";
print "Internal bug:\n";
print $_[0], "\n";
print "Please notify $UCW::CGI::error_mail\n" if defined $UCW::CGI::error_mail;
our @EXPORT = qw(&html_escape &url_escape &url_deescape &url_param_escape &url_param_deescape &self_ref &self_form &http_get);
our @EXPORT_OK = qw();
+our $utf8_mode = 0;
+
+sub http_error($;@) {
+ my $err = shift @_;
+ print join("\n", "Status: $err", "Content-Type: text/plain", @_, "", $err, "");
+ exit;
+}
+
### Escaping ###
sub url_escape($) {
my $x = shift @_;
+ utf8::encode($x) if $utf8_mode;
$x =~ s/([^-\$_.!*'(),0-9A-Za-z\x80-\xff])/"%".unpack('H2',$1)/ge;
+ utf8::decode($x) if $utf8_mode;
return $x;
}
sub url_deescape($) {
my $x = shift @_;
+ utf8::encode($x) if $utf8_mode;
$x =~ s/%(..)/pack("H2",$1)/ge;
+ utf8::decode($x) if $utf8_mode;
return $x;
}
my ($arg, $s) = @_;
$s =~ s/\r\n/\n/g;
$s =~ s/\r/\n/g;
+ utf8::decode($s) if $utf8_mode;
push @{$raw_args{$arg}}, $s;
}
if (my $qs = $ENV{"QUERY_STRING"}) {
parse_raw_args($qs);
}
- if ($method eq "GET") {
+ if ($method eq "GET" || $method eq "HEAD") {
} elsif ($method eq "POST") {
- if ($ENV{"CONTENT_TYPE"} =~ /^application\/x-www-form-urlencoded\b/i) {
+ my $content_type = $ENV{"CONTENT_TYPE"} // "";
+ if ($content_type =~ /^application\/x-www-form-urlencoded\b/i) {
while (<STDIN>) {
chomp;
parse_raw_args($_);
}
- } elsif ($ENV{"CONTENT_TYPE"} =~ /^multipart\/form-data\b/i) {
+ } elsif ($content_type =~ /^multipart\/form-data\b/i) {
parse_multipart_form_data();
} else {
- die "Unknown content type for POST data";
+ http_error "415 Unsupported Media Type";
+ exit;
}
} else {
- die "Unknown request method";
+ http_error "405 Method Not Allowed", "Allow: GET, HEAD, PUT";
}
}
return undef;
}
} else {
- die "Premature end of multipart POST data";
+ http_error "400 Bad Request: Premature end of multipart POST data";
}
}
sub skip_mp_boundary() {
if ($mp_buffer_boundary != $mp_buffer_i) {
- die "Premature end of multipart POST data";
+ http_error "400 Bad Request: Premature end of multipart POST data";
}
$mp_buffer_boundary = -1;
$mp_buffer_i += 2;
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";
+ if (!(($boundary) = ($ct =~ /^.*;\s*boundary=([^; ]+)/))) {
+ http_error "400 Bad Request: 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") || "";
+ 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;
$max_allowed += $a->{"maxsize"} || 65536;
}
if ($size > $max_allowed) {
- die "Maximum form data length exceeded";
+ http_error "413 Request Entity Too Large";
}
}
(($field) = ($cdisp =~ /;name=([^;]+)/)) &&
($a = $main_arg_table->{"$field"})) {
print STDERR "FIELD $field\n" if $debug;
- if (defined $h->{"content-transfer-encoding"}) { die "Unexpected Content-Transfer-Encoding"; }
+ if (defined $h->{"content-transfer-encoding"}) {
+ http_error "400 Bad Request: Unexpected Content-Transfer-Encoding";
+ }
if (defined $a->{"var"}) {
while (defined (my $l = get_mp_line(1))) {
print STDERR "VALUE $l\n" if $debug;
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"; }
+ if ($total_size > $max_size) { http_error "413 Request Entity Too Large"; }
}
$fh->flush(); # Don't close the handle, the file would disappear otherwise
next PART;