38df6f51c6
Yes, this is supposed to be a new top level in the repository. For the moment any changes to this area must be cleared by myself or Jordan. Once the kinks are worked out, the policy will probably be relaxed.
119 lines
4 KiB
C
119 lines
4 KiB
C
#!/usr/bin/perl -- -*- C -*-
|
|
# Perl Routines to Manipulate CGI input
|
|
# S.E.Brenner@bioc.cam.ac.uk
|
|
# $Header: /home/ncvs/www/en/cgi/cgi-lib.pl,v 1.1.1.1 1996-09-24 17:45:57 jfieber Exp $
|
|
#
|
|
# Copyright 1994 Steven E. Brenner
|
|
# Unpublished work.
|
|
# Permission granted to use and modify this library so long as the
|
|
# copyright above is maintained, modifications are documented, and
|
|
# credit is given for any use of the library.
|
|
#
|
|
# Thanks are due to many people for reporting bugs and suggestions
|
|
# especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen,
|
|
# Andrew Dalke, Mark-Jason Dominus and Dave Dittrich.
|
|
# For more information, see:
|
|
# http://www.bio.cam.ac.uk/web/form.html
|
|
# http://www.seas.upenn.edu/~mengwong/forms/
|
|
# Minimalist http form and script (http://www.bio.cam.ac.uk/web/minimal.cgi):
|
|
#
|
|
# require "cgi-lib.pl";
|
|
# if (&ReadParse(*input)) {
|
|
# print &PrintHeader, &PrintVariables(%input);
|
|
# } else {
|
|
# print &PrintHeader,'<form><input type="submit">Data: <input name="myfield">';
|
|
#}
|
|
# ReadParse
|
|
# Reads in GET or POST data, converts it to unescaped text, and puts
|
|
# one key=value in each member of the list "@in"
|
|
# Also creates key/value pairs in %in, using '\0' to separate multiple
|
|
# selections
|
|
# Returns TRUE if there was input, FALSE if there was no input
|
|
# UNDEF may be used in the future to indicate some failure.
|
|
# Now that cgi scripts can be put in the normal file space, it is useful
|
|
# to combine both the form and the script in one place. If no parameters
|
|
# are given (i.e., ReadParse returns FALSE), then a form could be output.
|
|
# If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
|
|
# information is stored there, rather than in $in, @in, and %in.
|
|
sub ReadParse {
|
|
local (*in) = @_ if @_;
|
|
local ($i, $key, $val);
|
|
# Read in text
|
|
if (&MethGet) {
|
|
$in = $ENV{'QUERY_STRING'};
|
|
} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
|
|
read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
|
|
}
|
|
@in = split(/&/,$in);
|
|
foreach $i (0 .. $#in) {
|
|
# Convert plus's to spaces
|
|
$in[$i] =~ s/\+/ /g;
|
|
# Split into key and value.
|
|
($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
|
|
# Convert %XX from hex numbers to alphanumeric
|
|
$key =~ s/%(..)/pack("c",hex($1))/ge;
|
|
$key =~ tr/[^A-Za-z0-9\-\_\$\+\=\~\.\,]//; # allow only safe chars
|
|
$val =~ s/%(..)/pack("c",hex($1))/ge;
|
|
$val =~ tr/[^A-Za-z0-9\-\_\$\+\=\~\.\,]//; # allow only safe chars
|
|
# Associate key and value
|
|
$in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
|
|
$in{$key} .= $val;
|
|
}
|
|
return length($in);
|
|
}
|
|
# PrintHeader
|
|
# Returns the magic line which tells WWW that we're an HTML document
|
|
sub PrintHeader {
|
|
return "Content-type: text/html\n\n";
|
|
}
|
|
# MethGet
|
|
# Return true if this cgi call was using the GET request, false otherwise
|
|
sub MethGet {
|
|
return ($ENV{'REQUEST_METHOD'} eq "GET");
|
|
}
|
|
# MyURL
|
|
# Returns a URL to the script
|
|
sub MyURL {
|
|
return 'http://' . $ENV{'SERVER_NAME'} . $ENV{'SCRIPT_NAME'};
|
|
}
|
|
# CgiError
|
|
# Prints out an error message which which containes appropriate headers,
|
|
# markup, etcetera.
|
|
# Parameters:
|
|
# If no parameters, gives a generic error message
|
|
# Otherwise, the first parameter will be the title and the rest will
|
|
# be given as different paragraphs of the body
|
|
sub CgiError {
|
|
local (@msg) = @_;
|
|
local ($i,$name);
|
|
if (!@msg) {
|
|
$name = &MyURL;
|
|
@msg = ("Error: script $name encountered fatal error");
|
|
};
|
|
print &PrintHeader;
|
|
print "<html><head><title>$msg[0]</title></head>\n";
|
|
print "<body><h1>$msg[0]</h1>\n";
|
|
foreach $i (1 .. $#msg) {
|
|
print "<p>$msg[$i]</p>\n";
|
|
}
|
|
print "</body></html>\n";
|
|
}
|
|
# PrintVariables
|
|
# Nicely formats variables in an associative array passed as a parameter
|
|
# And returns the HTML string.
|
|
sub PrintVariables {
|
|
local (%in) = @_;
|
|
local ($old, $out, $output);
|
|
$old = $*; $* =1;
|
|
$output .= "<DL COMPACT>";
|
|
foreach $key (sort keys(%in)) {
|
|
foreach (split("\0", $in{$key})) {
|
|
($out = $_) =~ s/\n/<BR>/g;
|
|
$output .= "<DT><B>$key</B><DD><I>$out</I><BR>";
|
|
}
|
|
}
|
|
$output .= "</DL>";
|
|
$* = $old;
|
|
return $output;
|
|
}
|
|
1;
|