#!/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") . "<br>\n";
#print "looking for footer file: " . (-e "$footpath") . "<br>\n";
#print "looking for terms file: " . (-e "$termspath") . "<br>\n";
#print "looking for blurb file: " . (-e "$blurbpath") . "<br>\n";
#print "looking for people file: " . (-e "$datapath") . "<br>\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<br>\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("Content-type: text/html\n\n");
    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("<form action=\"$cgiurl\" ");
                print("method=POST>\n");
            }
            print("<Table align=center border=2 cellpadding=10>\n");
        }
        #
        $email=trimwhite($row[1]);
        $ack  =trimwhite($row[2]);
        $ack=&parsecontributions($ack);
        $url  =trimwhite($row[$nfields-2]);
        $ihttp = index($url,"http");
        if($ihttp ge 0) {
            $rs=$row[0];
            $rs="<a href=\"$url\">$rs</a>";
            $row[0]=$rs;
        }
        #
        print("<tr>\n");
        print("<td valign=top><h3>name:</h3>\n</td>");
        print("<td>\n$name\n</td>\n");
        print("</tr>\n");
        #
        print("<tr>\n");
        print("<td valign=top><h3>acknowedgements:</h3>\n</td>");
        print("<td>\n$ack\n</td>\n");
        print("</tr>\n");
        #
        print("<tr>\n");
        print("<td valign=top><h3>correspondence:</h3></td>\n");
        print("<td valign=top>");
        if($secure) {
            $Temail=&parseemail($email);
            $Temail=&atsymbol($Temail);
            print("<code>\n$Temail\n<code></td>\n");
        } else {
            $hyd=$name;
            print("\n<input NAME=\"full\" VALUE=\"$hyd\" ");
            print("TYPE=\"hidden\">\n");
            print("<input TYPE=\"text\" NAME=\"key\" SIZE=40");
            print(" VALUE=\"Retype name here.\">");
            print("&nbsp;");
            print("<input type=\"submit\" value=\"SUBMIT\">\n");
        }
        print("</tr>\n");
        #
        if ($url ne "") {
            print("<tr>\n");
            print("<td valign=top><h3>link:</h3></td>\n");
            print("<td><code>");
            print("<a href=\"$url\">$url</a></code></td>\n");
            print("</tr>\n");
        }
        #
        @lines = <DATAFILE>;
    }
} while (($row[0] ne "^")&&(<DATAFILE>));

#
close(DATAFILE);
#

if($found == 0) {

    &HTMLheader("Unknown Person");
} else {

    print("</Table>\n<p>\n");
    if(! $secure) {
        &HTMLterms;
        print("</form>\n");
    }
}
#
&HTMLfooter;
exit(0);
#
#
#
#
sub error { 
# error routine
    ($message) = @_; 
    print("<b>ERROR:<b>", 
        $message, 
        "<p>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 = <DATAFILE>;
        chomp($key);
        if (length($key) > 0) {
            if (index($key,"|") > 0) { 
                $key =~ s/\|//g; 
                $tdstr=$key;
            } elsif (length($key) > 1) {
                $v = "";
                $tdstr=$key;
                while (index($v,"|") != 0) {
                    $v = <DATAFILE>;
                    chomp($v);
                    if (index($v,"|") != 0) { $tdstr .= "\n" . $v; }
                }
            } else {
                $tdstr=$key;
            }
        }
    }
    
    #print(":" . $tdstr . ":\n");
    
    return($tdstr);
}
#
#
sub readTR {
# procedure to read a table row from file
    @row=();
    $t="";
    while($t ne "^" && (!eof DATAFILE)) {
        $t=&readTD;
        if ($t eq "|") {
            push(@row,"");
        } elsif ($t ne "") {
            push(@row,$t);
        }
    } 
    return(@row);
}
#
#
sub HTMLheader {
    ($tit)= @_;
    if (-e "$headpath") {
        open(HTML,$headpath);
        @temp = <HTML>;
        close(HTML);
        $all=join("",@temp);
        $ss="INSERT";
        @bits=split(/INSERT/, $all);
        $all=join("$tit",@bits);
        if (index($tit,"Unknown") >=0) {
            $all .= qq[
<p>
<form action="$cgiurl" method=POST> 
<br> 
<p>
<table cellpadding=10>
<tr>
<td align=right><h3>Full Name:</h3></td>
<td><code><input TYPE="text" NAME="full" SIZE="80"></code></td>
</tr>
<tr>
<td></td>
<td>
<input type="submit" value="SUBMIT"> 
</td>
</tr>
</table>
<p>
<p>
</form>
<p>];
        }

    } else {
        $all="<html>\n<head><title>$tit</title></head>\n<body>\n<p>\n";
    }
    # print("Content-type: text/html\n\n");
    print($all);
}
#
#
sub HTMLfooter {
    if (-e "$footpath") {
        open(HTML,$footpath);
        @temp = <HTML>;
        close(HTML);
        print(@temp);
    } else {
        print("<p>\n</body>\n</html>\n");
    }
}
#
#
sub HTMLblurb {
    if (-e "$blurbpath") {
        open(HTML,$blurbpath);
        @temp = <HTML>;
        close(HTML);
        print(@temp);
    } else {
        print("<p>\n");
    }
}
#
#
sub HTMLterms {
    if (-e "$termspath") {
        open(HTML,$termspath);
        @temp = <HTML>;
        close(HTML);
        print(@temp);
    } else {
        print("NO TERMS<p>\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("&#00064;",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]="<a href=\"$t\">$t</a>";
        } else {
            $tarr[$l]="<a href=\"mailto:$t\">$t</a>";
        }
    }
    $temp=join(",\n",@tarr);
    return($temp);
}
#
#
#
sub parsecontributions {
    ($temp)= @_;
    @tarr=split("::", $temp);
    $temp=join("<br> ",@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);
}