#!/usr/bin/perl
#
################################################################
# FIle path and URL definitions that depend on the host system.
################################################################
#
$cgiurl="http://theforce.net/swtc/who.cgi";
#
$orgForm="http://www.theforce.net/swtc/_who/";
#
$headpath="C:\\Sites\\TheForce.Net\\active\\swtc\\_who\\cgi.head.html";
$footpath="C:\\Sites\\TheForce.Net\\active\\swtc\\_who\\cgi.foot.html";
$termspath="C:\\Sites\\TheForce.Net\\active\\swtc\\_who\\cgi.terms.html";
$blurbpath="C:\\Sites\\TheForce.Net\\active\\swtc\\_who\\cgi.blurb.html";
#
$datapath="C:\\Sites\\TheForce.Net\\active\\swtc\\_who\\people.txt";
#
################################################################
# Default values of important flag variables.
################################################################
#
$formget=0;
$secure=0;
$diag=0;
#
$nfields=5;
$showfields=3;
#
#
################################################################
# Old junk.
################################################################
#
#$sendmail = "/usr/lib/sendmail";
$date = `date`;
chop($date);
#
################################################################
# Commence output.
################################################################
if ($diag) { print("Content-type: text/plain\n\n"); };
#print "looking for header file: " . (-e "$headpath") . "
\n";
#print "looking for footer file: " . (-e "$footpath") . "
\n";
#print "looking for terms file: " . (-e "$termspath") . "
\n";
#print "looking for blurb file: " . (-e "$blurbpath") . "
\n";
#print "looking for people file: " . (-e "$datapath") . "
\n";
#exit;
#moved to HTMheader
#print("Content-type: text/plain\n\n");
#
#print("The time is ",$date,".\n");
#
################################################################
# Process the form variables.
################################################################
#
$query=&readcgivars;
$query = decode($query);
@cgiPairs = split("&",$query);
#
foreach $pair ( @cgiPairs ) {
($var,$val) = split("=",$pair);
#trust me on this magic.
$val =~ s/\+/ /g;
$val =~ s/%(..)/pack("c",hex($1))/ge;
$cgiVals{"$var"} = "$val";
#if($diag) { print("$var = $val
\n"); }
}
#
#if($diag) { exit(0); }
#
$recipient = $cgiVals{"full"};
$key = $cgiVals{"key"};
$contract = $cgiVals{"contract"};
#
#
#$recipient=trimwhite($recipient);
if ( ! $recipient ) {
# Nobody was named in the form.
# modify this text appropriately
print("Location: $orgForm\n\n");
# &HTMLheader("Unspecified Person");
# &HTMLfooter;
exit(0);
}
#
#
if ($recipient eq $key) {
$secure=1;
}
if ($formget) {
$secure=0;
}
if ($contract ne "agreed") {
$secure=0;
}
#
#
########################################################################
# Search the data file for the requested person's name.
########################################################################
#
open(DATAFILE,$datapath);
#
$found=0;
$foundkey=0;
do {
@row=&readTR;
$name=trimwhite($row[0]);
$scramble=join("\*",split(//, $recipient));
if ($name eq $key) {
$foundkey++;
}
if ($name eq $recipient) {
#
# foreach $fld (@row) {
# chomp($fld);
# print ("." . $fld . ".\n")
# }
# print (".......\n");
# chomp($row[0]);
# print ("." . $row[0] . ".\n");
#
$found++;
if($found == 1) {
&HTMLheader("Acknowledgements: $recipient");
if(! $secure) {
print("
Contact the author of the previous page for assistance\n");
exit(0);
}
#
# procedure to check if the setuid bit is on
sub checkSUID {
return( -u $_[0] );
}
#
#
#
sub readTD {
# procedure to read a table element from the file
$tdstr="";
$nonwhite = 0;
$number=0;
if (!eof DATAFILE) {
$key =
];
}
} else {
$all="\n \n";
}
# print("Content-type: text/html\n");
# print("Content-type: text/html\n\n");
print($all);
}
#
#
sub HTMLfooter {
if (-e "$footpath") {
open(HTML,$footpath);
@temp = ;
close(HTML);
print(@temp);
} else {
print(" \n\n\n");
}
}
#
#
sub HTMLblurb {
if (-e "$blurbpath") {
open(HTML,$blurbpath);
@temp = ;
close(HTML);
print(@temp);
} else {
print(" \n");
}
}
#
#
sub HTMLterms {
if (-e "$termspath") {
open(HTML,$termspath);
@temp = ;
close(HTML);
print(@temp);
} else {
print("NO TERMS \n");
}
}
#
#
sub HTMLdie {
($tit)= @_;
&HTMLhead($tit);
&HTMLfoot;
exit(0);
}
#
#
sub trimwhite {
# subroutine to remove some white-space characters from a string
($temp)= @_;
$temp=join("",split(/\n+/, $temp));
$temp=join("",split(/\t+/, $temp));
$temp=join("",split(/\r+/, $temp));
$temp=join("",split(/\0+/, $temp));
return($temp);
}
#
#
sub atsymbol {
($temp)= @_;
$temp=join("@",split(/\@/, $temp));
return($temp);
}
#
#
sub parseemail {
($temp)= @_;
@tarr=split(/\s+/, $temp);
$temp=join("",@tarr);
@tarr=split(/,/, $temp);
for($l=0;$l<=$#tarr;$l++) {
$t=$tarr[$l];
$ihttp = index($t,"http");
if($ihttp >= 0) {
$tarr[$l]="$t";
} else {
$tarr[$l]="$t";
}
}
$temp=join(",\n",@tarr);
return($temp);
}
#
#
#
sub parsecontributions {
($temp)= @_;
@tarr=split("::", $temp);
$temp=join("
",@tarr);
return($temp);
}
#
#
sub decode($)
{
$_[0] =~ s/\+/ /g; ### Change + to space
my(@parts) = split /%/, $_[0];
my($returnstring) = "";
(($_[0] =~ m/^\%/) ? (shift(@parts)) : ($returnstring = shift(@parts)));
my($part);
foreach $part (@parts)
{
$returnstring .= chr(hex(substr($part,0,2)));
my($tail) = substr($part,2);
$returnstring .= $tail if (defined($tail));
}
return($returnstring);
}
#
#
#
sub readcgivars {
# A generalised procedure for reading CGI variables regardless of METHOD.
if ( ($ENV{'REQUEST_METHOD'} eq 'GET') ||
($ENV{'REQUEST_METHOD'} eq 'HEAD') ) {
# Use this for forms with method=GET
$in= $ENV{'QUERY_STRING'} ;
$formget=1;
$secure=0;
} elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
# Use this for forms with method=POST
if ($ENV{'CONTENT_TYPE'}=~
m#^application/x-www-form-urlencoded$#i) {
length($ENV{'CONTENT_LENGTH'})
|| &HTMLdie("POST request has no Content-Length.");
read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
} else {
$mess="Unsupported Content-Type:";
$mess="$mess $ENV{'CONTENT_TYPE'}"
&HTMLdie($mess);
}
$formget=0;
} else {
&HTMLdie("Script was called with unsupported REQUEST_METHOD.");
}
return($in);
}