#!/usr/local/bin/perl 

########################################################################
########## Configurable variables ######################################

$SENDMAIL = '/usr/sbin/sendmail';
#                                   The location of your sendmail binary

@AUTHDOMAINS = ('');
#           List of lower-case Internet domains that can use this script 
#                                such as ('ncsa.uiuc.edu', 'domain.com')

## Also, make sure the first line of this script points
## to your PERL binary

########## Nothing else to change ######################################
########################################################################


$ENV{'SCRIPT_NAME'} =~ m#(/.*/)(.*)$#;
$SCRIPTDIR = $1;
$SCRIPT = $2;

#### Do standard HTTP stuff ####
&cgi_receive;
&cgi_decode;
&cgi_header;

#### Load mail.list into associative array ####
open (MAILNAMES, "mail.list") || die ("$SCRIPT: Can't open mail.list: $!\n");
while (<MAILNAMES>) {
    chop;
    ($nick, $addr) = split(/:/, $_);
    $ADDRESS{$nick} = $addr;
}
close (MAILNAMES);

#### Figure out who the information should be sent to ####
if ($ENV{'QUERY_STRING'} =~ /\@/) {
    #### User specified a full email address ####
    ($machine = $') =~ tr/A-Z/a-z/;
    undef $FLAG{'authorized'};
    for ($[ .. $#AUTHDOMAINS) {
	$FLAG{'authorized'} = $AUTHDOMAINS[$_], last if ($ENV{'QUERY_STRING'} =~ /$AUTHDOMAINS[$_]$/);
    }
    &error_blank_field('an authorized email address') unless ($FLAG{'authorized'});
    $recipient = $ENV{'QUERY_STRING'};
    $extraaction = "?$recipient";
}
elsif ($ENV{'QUERY_STRING'}) {
    #### User specified a nickname ####
    $nickname = $ENV{'QUERY_STRING'};
    &error_blank_field('a valid recipient nickname') unless ($ADDRESS{$nickname});
    $recipient = $ADDRESS{$nickname};
    $extraaction = "?$nickname";
}
elsif ($FORM{'nickname'}) {
    #### Input is coming from listbox, ready for forwarding ####
    $nickname = $FORM{'nickname'};
    &error_blank_field('a valid recipient nickname') unless ($ADDRESS{$nickname});
    $recipient = $ADDRESS{$FORM{'nickname'}};
}
elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
    #### I don't know who the information was for ####
    &error_blank_field('a valid recipient');
}

#### Output a default email form if not POSTing already ####
&print_form unless ($ENV{'REQUEST_METHOD'} eq "POST");

#### Check for require fields
foreach $field (@requirefields) {
    &error_blank_field($field) unless ($FORM{$field});
}

#### Fill in missing fields for forwarding FORM results ####
($FORM{'subject'}) || ($FORM{'subject'} = "FORM results");
($FORM{'from-email'}) || ($FORM{'from-email'} = $recipient);
($FORM{'from-name'}) || ($FORM{'from-name'} = "WebMonitor mail");
#($FORM{'from-phone'}) || ($FORM{'from-phone'} = "WebMonitor phone");

#### increment counter sofeab-count ####
open (TSC, '<sofeab-count');
    $COUNT = <TSC>;
    $COUNT = $COUNT + 1;
open (TSC, '>sofeab-count');
print TSC "$COUNT";
close (TSC);

#### compose mail message to sofe-sec ####
open (MAIL, "| $SENDMAIL $recipient") || die ("$SCRIPT: Can't open $mailprog: $!\n");
print MAIL "Reply-to: $FORM{'from-email'} ($FORM{'from-name'})\n";
print MAIL "From: $FORM{'from-email'} ($FORM{'from-name'})\n";
print MAIL "To: $recipient\n";
print MAIL "Subject: $FORM{'subject'}\n";
print MAIL "X-Comments: =============================================================\n";
print MAIL "X-Comments: NOTE:  This message was sent through the WebMonitor mail form\n";
print MAIL "X-Comments: PLEASE FILE WITH SOFE ABSTRACTS\n";
print MAIL "X-Comments: LOG NUMBER:  WA-$COUNT\n";
print MAIL "X-Comments: =============================================================\n";
print MAIL "X-Comments: HOST:      $ENV{'REMOTE_HOST'} ($ENV{'REMOTE_ADDR'})\n";
#print MAIL "X-Comments: BROWSER:   $ENV{'HTTP_USER_AGENT'}\n";
print MAIL "X-Comments: REFERER:   $FORM{'previous-url'}\n" if ($FORM{'previous-url'});
print MAIL "X-Comments: =============================================================\n";
print MAIL "\n";
#&dump_values(FORM, MAIL);
#print MAIL "\n";
print MAIL "$FORM{'title'}\n";
print MAIL "\n";
print MAIL "$FORM{'authors'}\n";
print MAIL "\n";
print MAIL "$FORM{'orgs'}\n";
print MAIL "\n";
print MAIL "$FORM{'abstract'}\n";
print MAIL "\n";
print MAIL "$FORM{'from-name'}\n";
print MAIL "$FORM{'from-address1'}\n";
print MAIL "$FORM{'from-address2'}\n";
print MAIL "$FORM{'from-address3'}\n";
print MAIL "$FORM{'country'}\n";
print MAIL "$FORM{'from-phone'}\n";
print MAIL "$FORM{'from-fax'}\n";
print MAIL "$FORM{'from-email'}\n";
print MAIL "\n";
print MAIL "Session number: $FORM{'session'}\n";
print MAIL "\n";
print MAIL "Additional instructions:\n";
print MAIL "  $FORM{'message'}\n";
close (MAIL);

#### Now, redirect if "next-url" is included
if ($FORM{'next-url'}) {
    print "Location: $FORM{'next-url'}\n";
    print "\n";
    exit;
}

#### Prevent HTML output
foreach $key (keys %FORM) {
    $FORM{$key} =~ s/</\&lt;/g;
    $FORM{$key} =~ s/>/\&gt;/g;
}

#### Output confirmation message ####
print qq|<HTML><HEAD><TITLE>Abstract Sent</TITLE></HEAD><BODY>\n|;
print qq|<H2>Your abstract has been sent.</H2>\n|;
print "(please note your Log number: WA-$COUNT)\n";
print qq|<HR>\n|;
print "<PRE>\n";
print "    Name: $FORM{'title'}\n";
print "    Name: $FORM{'from-name'}\n";
print "  e-mail: $FORM{'from-email'}\n";
print "\n";
#&dump_values(FORM, STDOUT);
print qq|<HR><P>\n|;
print qq|You may now return to the <a href="http://aries.ucsd.edu/LIB/MEETINGS/9710-SOFE97">SOFE97 Home Page</a>\n|;
print "</PRE>\n";
print "</BODY></HTML>\n";
exit;

#####################################################################
#### SUBROUTINES ####################################################

sub error_blank_field {
    local($variable) = @_;
    print "\n" if ($FORM{'next-url'});
    print "<HTML><HEAD><TITLE>WebMonitor-Email Error</TITLE></HEAD><BODY>\n";
    print "<H1>Error!</H1>\n";
    print "You did not fill in $variable.\n";
    print "</BODY></HTML>\n";
    exit;
}

sub cgi_header {
    print "Content-type: text/html\n";
    print "\n" unless ($FORM{'next-url'});
}        

sub cgi_receive {
    if ($ENV{'REQUEST_METHOD'} eq "POST") {
        read(STDIN, $incoming, $ENV{'CONTENT_LENGTH'});
    }
    else {
        $incoming = $ENV{'QUERY_STRING'};
    }
}

sub cgi_decode {
    @pairs = split(/&/, $incoming);

    foreach (@pairs) {
        ($name, $value) = split(/=/, $_);

        $name  =~ tr/+/ /;
        $value =~ tr/+/ /;
        $name  =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie;
        $value =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie;

        #### Strip out semicolons unless for special character
        $value =~ s/;/$$/g;
        $value =~ s/&(\S{1,6})$$/&\1;/g;
        $value =~ s/$$/ /g;

        $value =~ s/\|/ /g;
        $value =~ s/^!/ /g; ## Allow exclamation points in sentences

	#### Split apart any directive prefixes
	#### NOTE: colons are reserved to delimit these prefixes
	@parts = split(/:/, $name);
	$name = $parts[$#parts];
	if (grep(/^require$/, @parts)) {
	    push (@requirefields, $name);
	}
	if (grep(/^ignore$/, @parts)) {
	    push (@ignorefields, $name);
	}
	if (grep(/^dynamic$/, @parts)) {
	    #### For simulating a checkbox
	    #### It may be dynamic, but useless if nothing entered
            next if ($value eq "");
            $name = $value;
            $value = "on";
	}

        #### Skip generally blank fields
        next if ($value eq "");

	#### Allow for multiple values of a single name
        $FORM{$name} .= ", " if ($FORM{$name});

        $FORM{$name} .= $value;
	#### Add to ordered list if not on list already
        push (@fields, $name) unless (grep(/^$name$/, @fields));
    }
}

sub dump_values {
    local($env, $handle) = @_;
    ($handle eq "STDOUT") && (print $handle "<PRE>\n");
    foreach $field (@fields) {
	next if (grep(/^$field$/, @ignorefields));
	if ($FORM{$field} =~ /[\cM\n]/) {
	    print $handle "($field)\n";
	    print $handle "-" x 75, "\n", $FORM{$field}, "\n", "-" x 75, "\n";
	}
	else {
            print $handle "($field)  $FORM{$field}\n";
	}
    }
    ($handle eq "STDOUT") && (print $handle "</PRE>\n");
}

sub print_form {
    print qq|<HTML><HEAD><TITLE>SOFE'97 Abstract Submission Form</TITLE></HEAD><BODY>\n|;
    print qq|<TABLE WIDTH=100%><TR><TD ALIGN=left>\n|;
    print qq|<H2>SOFE'97 Abstract Submission Form</H2>\n|;
    print qq|(See <a href="http://aries.ucsd.edu/LIB/MEETINGS/9710-SOFE97/sample.html">sample</a>\n|;
    print qq|of format for guidance)\n|;
    print qq|<td align=right><img src="http://aries.ucsd.edu/LIB/MEETINGS/9710-SOFE97/ieee.gif" align=top></TABLE>\n|;
    print qq|<FORM METHOD="POST" ACTION="$ENV{'SCRIPT_NAME'}$extraaction">\n|;
    print qq|<HR>\n|;
    print qq|<TABLE WIDTH=100%><TR><TD ALIGN=LEFT><INPUT TYPE="submit" VALUE="Submit">\n|;
    print qq|<TD ALIGN=RIGHT><INPUT TYPE="reset" VALUE="Start Over"></TABLE>\n|;
    print qq|<HR>\n|;
    print qq|<b>Title:</b><br><center>\n|;
    print qq|<TEXTAREA NAME="require:ignore:title" ROWS="3" COLS="80">\n|;
    print qq|Please don't type outside the visible area!</TEXTAREA></center>\n|;
    print qq|<p><b>Author List:</b><br><center>\n|;
    print qq|<TEXTAREA NAME="require:ignore:authors" ROWS="3" COLS="80">\n|;
    print qq|Please don't type outside the visible area!</TEXTAREA></center>\n|;
    print qq|<p><b>Organization:</b><br><center>\n|;
    print qq|<TEXTAREA NAME="require:ignore:orgs" ROWS="5" COLS="80">\n|;
    print qq|Please don't type outside the visible area!</TEXTAREA></center>\n|;
    print qq|<H3>Body of Abstract</H3>\n|;
    print qq|<TEXTAREA NAME="require:ignore:abstract" ROWS="32" COLS="90">\n|;
    print qq|Please don't type outside the visible area!</TEXTAREA>\n|;
    print qq|<p>Contact Name:<br> <INPUT NAME="require:ignore:from-name" SIZE="40">\n|;
    print qq|<p>Address: <INPUT NAME="require:ignore:from-address1" SIZE="40">\n|;
    print qq|<br>Address: <INPUT NAME="ignore:from-address2" SIZE="40">\n|;
    print qq|<br>Address: <INPUT NAME="ignore:from-address3" SIZE="40">\n|;
    print qq|<br>Country: <INPUT NAME="ignore:country" SIZE="40">\n|;
    print qq|<br>Phone: <INPUT NAME="ignore:from-phone" SIZE="40">\n|;
    print qq|<br>FAX: <INPUT NAME="ignore:from-fax" SIZE="40">\n|;
    print qq|<br>Email Address: <INPUT NAME="require:ignore:from-email" SIZE="40">\n|;
    print qq|      <p>Session Number: <SELECT NAME="session">\n|;
    print qq|<OPTION VALUE="01">1. Tokamak experiments\n|;
    print qq|<OPTION VALUE="02">2. Next-generation devices\n|;
    print qq|<OPTION VALUE="03">3. Advanced confinement concepts\n|;
    print qq|<OPTION VALUE="04">4. ITER\n|;
    print qq|<OPTION VALUE="05">5. NIF\n|;
    print qq|<OPTION VALUE="06">6. Magnet systems\n|;
    print qq|<OPTION VALUE="07">7. Heating, fueling and current drive\n|;
    print qq|<OPTION VALUE="08">8. Driver technology for IFE\n|;
    print qq|<OPTION VALUE="09">9. Plasma-material interactions\n|;
    print qq|<OPTION VALUE="10">10. IFE wall interactions\n|;
    print qq|<OPTION VALUE="11">11. Nuclear technologies (IFE and MFE)\n|;
    print qq|<OPTION VALUE="12">12. Materials behavior\n|;
    print qq|<OPTION VALUE="13">13. Tritium and vacuum systems\n|;
    print qq|<OPTION VALUE="14">14. Electrical power systems\n|;
    print qq|<OPTION VALUE="15">15. Instrumentation, diagnostics and data handling\n|;
    print qq|<OPTION VALUE="16">16. Remote handling\n|;
    print qq|<OPTION VALUE="17">17. Fusion power plant studies\n|;
    print qq|<OPTION VALUE="18">18. Safety and environmental studies\n|;
    print qq|<OPTION VALUE="19">19. Other (please specify below)\n|;
    print qq|</SELECT>\n|;
    print qq|<H3>Additional instructions</H3>\n|;
    print qq|<TEXTAREA NAME="ignore:message" ROWS="2" COLS="80"></TEXTAREA>\n|;
    print qq|<INPUT TYPE="hidden" NAME="subject" VALUE="SOFE97 Abstract from Web">\n|;
    print qq|<p><HR>\n|;
    print qq|<TABLE WIDTH=100%><TR><TD ALIGN=LEFT><INPUT TYPE="submit" VALUE="Submit">\n|;
    print qq|<TD ALIGN=RIGHT><INPUT TYPE="reset" VALUE="Start Over"></TABLE>\n|;
    print qq|<INPUT TYPE="hidden" NAME="ignore:previous-url" VALUE="$ENV{'HTTP_REFERER'}">\n|;
    print qq|</FORM>\n|;
    print qq|</BODY></HTML>\n|;

    exit;
}