# ipdb/cgi-bin/CommonWeb.pm ### # SVN revision info # $Date$ # SVN revision $Rev$ # Last update by $Author$ ### package CommonWeb; use strict; use warnings; use Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = 1.00; @ISA = qw(Exporter); @EXPORT_OK = qw(&parse_post &printFooter &printHeader &printError &printAndExit &desanitize &cleanInput &desanitize); @EXPORT = (); #export nothing by default %EXPORT_TAGS = ( ALL => [qw( &parse_post &printFooter &printHeader &printError &printAndExit &desanitize &cleanInput )], lean => [qw( &parse_post &printFooter &printHeader &printError &printAndExit &cleanInput )] ); sub parse_post { my $buffer; if ($ENV{'REQUEST_METHOD'} eq "GET") { $buffer=$ENV{'QUERY_STRING'} } elsif ($ENV{'REQUEST_METHOD'} eq 'POST' && $ENV{'CONTENT_TYPE'} eq "application/x-www-form-urlencoded") { read(STDIN, $buffer, $ENV{CONTENT_LENGTH}); } else { $buffer = $ENV{'QUERY_STRING'}; $buffer || read(STDIN, $buffer, $ENV{CONTENT_LENGTH}); } my @pairs = split(/&/, $buffer); my %webvarLocal; foreach my $pair (@pairs) { my ($name, $value) = split(/=/, $pair); $name =~ tr/+/ /; $name =~ 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; $value =~ s/\'/\\\'/g; $webvarLocal{$name} = $value; } return %webvarLocal; } sub printHeader { my $title = shift; print "Content-type: text/html\n\n"; # This doesn't work well. Must investigate. # my $realm = shift; # print qq(WWW-Authenticate: Basic realm="$realm"\n) if $realm; open FILE, "../header.inc" or carp $!; my $html = join('',); close FILE; $html =~ s/\$\$TITLE\$\$/$title/; # Necessary for mangling arbitrary bits of the header my $i=0; while (defined(my $param = shift)) { $html =~ s/\$\$EXTRA$i\$\$/$param/g; $i++; } print $html; } sub printFooter { open FILE, "../footer.inc" or croak $!; while () { print; } close FILE; } sub printError($) { my $errStr = $_[0]; print qq(

$errStr

); } sub printAndExit($) { my $errStr = $_[0]; print qq(

$errStr

); printFooter(); exit(0); } # needs a reference to the webvar hash. # takes out backticks and single quotes sub cleanInput($) { my $hashRef = $_[0]; foreach my $key (keys %$hashRef) { $hashRef->{$key} =~ s/`/\\`/g; $hashRef->{$key} =~ s/'/\'/g; } } # undoes clean input. takes a string as an arg. sub desanitize($) { my $string = $_[0]; $string =~ s/\\`/`/g; $string =~ s/\\'/'/g; return $string; } # indicate that the module loaded okay. 1;