package NaiveCGI; # Security measures. See man 1 perlsec $ENV{PATH} = "/bin:/usr/bin"; delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}; # Courtesy: don't bother the webmaster or root... use CGI::Carp qw(fatalsToBrowser set_message); set_message("Congratulations! You found a bug in my program."); #================================================================= # utility subroutines sub PrintHeader { my ($title) = @_; open F, TranslateLocation("/~ckhung/i/header.shtml"); my (@inc_text) = ; close F; print < $title @inc_text

$title

eof } sub PrintFooter { open F, TranslateLocation("/~ckhung/i/techfooter.shtml"); my (@inc_text) = ; close F; print < eof } # Launder tainted variables. See 'taint' in perlsec(1) # Usage: Launder($tainted, $allowed); # $allowed is the allowed character class to be interpreted as a regexp # (without the enclosing []). Best passed enclosed in '...'. # Result: # If $tained is a scalar, returns the laundered string; # if $tainted is a reference to a scalar, launder $$tainted in # place, and returns the first segment of non-allowed substring; # if $tainted is a reference to an array or to a hash, launder # every element of $tainted in place. sub Launder { my ($tainted) = shift; my ($allowed) = (shift or '\w_\-/.'); my ($type) = ref $tainted; if (not $type) { return undef unless defined $tainted; $tainted =~ m#([$allowed]*)#; return $1; } elsif ($type eq "SCALAR") { return undef unless defined $$tainted; $$tainted =~ m#([^$allowed]+)#; my $dirt = $1; $$tainted =~ m#([$allowed]*)#; $$tainted = $1; return $dirt; } elsif ($type eq "ARRAY") { foreach (@$tainted) { Launder(\$_, $allowed); } } elsif ($type eq "HASH") { foreach (keys %$tainted) { Launder(\$$tainted{$_}, $allowed); } } else { die "don't know how to launder a reference to $type\n"; } } # Returns, as a hash, all parameters from a cgi object sub ImportFormParam { my ($cgi_obj) = @_; my (%result); foreach ($cgi_obj->param) { $result{$_} = $cgi_obj->param($_); } return %result; } BEGIN { use vars qw($DocumentRoot $UserDir); # open F, "/etc/httpd/conf/srm.conf" or die; # while () { # $DocumentRoot = $1 if /^\s*DocumentRoot\s+(\S+)\s*$/; # $UserDir = $1 if /^\s*UserDir\s+(\S+)\s*$/; # } # close F; $DocumentRoot = "/home/httpd/html"; $UserDir = "public_html"; # We could use FastGrep here, but it's too inefficient for searching # two strings at once. } # Translates local URL's to file system paths. Only works with absolute paths sub TranslateLocation { my ($location) = @_; croak "\"$location\" is not an absolute local URL" unless $location =~ m#^/#; if ($location =~ m#/~(\w+)(.*)#) { return `echo -n ~$1` . "/$UserDir" . $2; } else { return $DocumentRoot . $location; } } # Finds the first occurrence of a string in a file (without using ``). # Returns a list of (up to 5) substrings corresponding to the # parenthesized substrings. sub FastGrep { my ($fn, $regexp) = @_; open F, $fn or return undef; my ($match) = grep m($regexp), ; close F; return undef unless defined $match; chomp $match; $match =~ m($regexp); return wantarray ? ($1, $2, $3, $4, $5) : $1; } sub HtmlEscape { my ($s) = @_; $$s =~ s/&/&/g; $$s =~ s//>/g; return $$s; } 1;