FORM for Reference query-from one site to another-- in C or PERL?
Preston, Linda
LPRESTON at ncdc.noaa.gov
Tue Oct 7 15:50:00 EDT 1997
I understand that most could not, but is anyone able to help me resolve my
getting a form to be e-mailed from one city to another for emergency
reference questions? The script file seems to be the problem. I have one
in PERL. C is used here. Maybe there is a better one than the source file
and cgi file I have copied. No copyright problems--but is there a simpler
better one out there designed for this library problem in mind--or could
someone look at these?
[[ REF_FORM.HTM : 3936 in REF_FORM.HTM ]][[ FORMMAIL.CGI : 3937 in
FORMMAIL.CGI ]]
BACKGROUND:
I have just taken a web class via the web. It has been very helpful for me
since I am in a branch library. We will put the web page and weblets
resultant from that class onto our center's web page that will be available
only to our personnel. It is small stuff compared to the large systems, but
it is nice and has a lot of examples of variety.
I read one of Ronald Wagner's books and began e-mailing him. He was helpful
in sending me a PERL cgi script file for his form which I copied but we are
having problems. We are not experts here in PERL. Usually, C is used.
Not being any kind of programmer, I was not able to correctly understand
how to correct the problem from Matt's Archive for Scripts on the web. He
has been so nice I hate to continue to ask him questions since I am not a
student of his.
Please respond directly if possible:
Linda D. Preston, Librarian
National Climatic Data Center
Federal Building--Library
151 Patton Avenue, Room 400
Asheville, NC 28801-5001
IP address: 205.167.24.113
Domain address: LPRESTON at NCDC.NOAA.GOV
(T) 704-271-4677
(F) 704-271-4328
<HTML>
<HEAD><TITLE>REFERENCE QUESTION TO CENTRAL LIBRARY</HEAD>
<BODY>
<CENTER><FONT COLOR=#008000><H2>REFERENCE QUESTION TO CENTRAL LIBRARY <BR> IF Approved by Pete Steurer:</TITLE>
(This service is solely available to NOAA employees.)
Note: If your browser does not support forms, you can send an e-mail
message to reference at nodc.noaa.gov. </FONT></CENTER></H2></BR>
<FORM METHOD="POST" ACTION="http://www.ncdc.noaa.gov/cgi-bin/lpreston/lpformmail.cgi">
<P>
<INPUT NAME="recipient" VALUE="reference at nodc.noaa.gov" TYPE="HIDDEN">
<INPUT NAME="redirect" VALUE=ACTION="/cgi-bin/ref-query"
TYPE="HIDDEN"><TABLE border=1 cellpadding=3 cellspacing=7><TR><TD align=right>
<B>Your E-mail Address: </TD><TD></B><INPUT NAME="email" VALUE="" ROWS=1
SIZE=40></TR><TR><TD align=right><B>Your
Real Name: </TD><TD></B><INPUT NAME="realname" VALUE="" ROWS=1
SIZE=40></TR><TR><TD align=right><B>Organization:
</TD><TD></B><INPUT NAME="organization" VALUE="" ROWS=1
SIZE=40></TR><TR><TD align=right><B>Subject:
</TD><TD></B><INPUT NAME="subject" VALUE="" ROWS=1 SIZE=60></TR><TR><TD
align=right>
<B>Message: </TD><TD></B>
<TEXTAREA NAME="message" ROWS=12 COLS=60>
</TEXTAREA>
</TR></TABLE><CENTER> <INPUT type = "SUBMIT" VALUE="SEND MAIL">
<INPUT TYPE="RESET"></CENTER>
</FORM>
</BODY>
</HTML>
#! /bin/perl
##############################################################################
# FormMail Version 1.5 #
# Copyright 1996 Matt Wright mattw at misha.net #
# Created 6/9/95 Last Modified 2/5/96 #
# Scripts Archive at: http://www.worldwidemart.com/scripts/ #
##############################################################################
# COPYRIGHT NOTICE #
# Copyright 1996 Matthew M. Wright All Rights Reserved. #
# #
# FormMail may be used and modified free of charge by anyone so long as this #
# copyright notice and the comments above remain intact. By using this #
# code you agree to indemnify Matthew M. Wright from any liability that
#
# might arise from it's use.
#
# #
# Selling the code for this program without prior written consent is #
# expressly forbidden. In other words, please ask first before you try and #
# make money off of my program. #
##############################################################################
#
# Define Variables
#
# $mailprog defines the location of your sendmail program on your unix
# system.
$mailprog = '/usr/lib/sendmail';
# @referers allows forms to be located only on servers which are defined
# in this field. This fixes a security hole in the last version which
# allowed anyone on any server to use your FormMail script.
@referers = ($ENV{'SERVER_NAME'}, $ENV{'HTTP_HOST'});
# Done
#############################################################################
# Check Referring URL
&check_url;
# Retrieve Date
&get_date;
# Parse Form Contents
&parse_form;
# Check Required Fields
&check_required;
# Return HTML Page or Redirect User
&return_html;
# Send E-Mail
&send_mail;
sub check_url {
if ($ENV{'HTTP_REFERER'}) {
foreach $referer (@referers) {
if ($ENV{'HTTP_REFERER'} =~ /$referer/i) {
$check_referer = '1';
last;
}
}
}
else {
$check_referer = '1';
}
if ($check_referer != 1) {
&error('bad_referer');
}
}
sub get_date {
@days =
('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
@months = ('January','February','March','April','May','June','July',
'August','September','October','November','December');
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
if ($hour < 10) { $hour = "0$hour"; }
if ($min < 10) { $min = "0$min"; }
if ($sec < 10) { $sec = "0$sec"; }
$date = "$days[$wday], $months[$mon] $mday, 19$year at $hour\:$min\:$sec";
}
sub parse_form {
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
# Split the name-value pairs
@pairs = split(/&/, $ENV{'QUERY_STRING'});
}
elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
# Get the input
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# Split the name-value pairs
@pairs = split(/&/, $buffer);
}
else {
&error('request_method');
}
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# If they try to include server side includes, erase them, so they
# arent a security risk if the html gets returned. Another
# security hole plugged up.
$value =~ s/<!--(.|\n)*-->//g;
# Create two associative arrays here. One is a configuration array
# which includes all fields that this form recognizes. The other
# is for fields which the form does not recognize and will report
# back to the user in the html return page and the e-mail message.
# Also determine required fields.
if ($name eq 'recipient' ||
$name eq 'subject' ||
$name eq 'E-Mail' ||
$name eq 'Real Name' ||
$name eq 'redirect' ||
$name eq 'bgcolor' ||
$name eq 'background' ||
$name eq 'link_color' ||
$name eq 'vlink_color' ||
$name eq 'text_color' ||
$name eq 'alink_color' ||
$name eq 'title' ||
$name eq 'sort' ||
$name eq 'print_config' ||
$name eq 'return_link_title' ||
$name eq 'return_link_url' && ($value)) {
$CONFIG{$name} = $value;
}
elsif ($name eq 'required') {
@required = split(/,/,$value);
}
elsif ($name eq 'env_report') {
@env_report = split(/,/,$value);
}
else {
if ($FORM{$name} && ($value)) {
$FORM{$name} = "$FORM{$name}, $value";
}
elsif ($value) {
$FORM{$name} = $value;
}
}
}
}
sub check_required {
foreach $require (@required) {
if ($require eq 'recipient' ||
$require eq 'subject' ||
$require eq 'E-Mail' ||
$require eq 'Real Name' ||
$require eq 'redirect' ||
$require eq 'bgcolor' ||
$require eq 'background' ||
$require eq 'link_color' ||
$require eq 'vlink_color' ||
$require eq 'alink_color' ||
$require eq 'text_color' ||
$require eq 'sort' ||
$require eq 'title' ||
$require eq 'print_config' ||
$require eq 'return_link_title' ||
$require eq 'return_link_url') {
if (!($CONFIG{$require}) || $CONFIG{$require} eq ' ') {
push(@ERROR,$require);
}
}
elsif (!($FORM{$require}) || $FORM{$require} eq ' ') {
push(@ERROR,$require);
}
}
if (@ERROR) {
&error('missing_fields', @ERROR);
}
}
sub return_html {
if ($CONFIG{'redirect'} =~ /http\:\/\/.*\..*/) {
# If the redirect option of the form contains a valid url,
# print the redirectional location header.
print "Location: $CONFIG{'redirect'}\n\n";
}
else {
print "Content-type: text/html\n\n";
print "<html>\n <head>\n";
# Print out title of page
if ($CONFIG{'title'}) {
print " <title>$CONFIG{'title'}</title>\n";
}
else {
print " <title>Thank You</title>\n";
}
print " </head>\n <body>\n <center>";
if ($CONFIG{'title'}) {
print " <h1>$CONFIG{'title'}</h1>\n";
}
else {
print " <h1>Thank You For Filling Out This Form</h1>\n";
}
print "</center>\n";
print "Below is what you submitted to $CONFIG{'recipient'} on ";
print "$date<p><hr size=7 width=75\%><p>\n";
if ($CONFIG{'sort'} eq 'alphabetic') {
foreach $key (sort keys %FORM) {
# Print the name and value pairs in FORM array to html.
print "<b>$key:</b> $FORM{$key}<p>\n";
}
}
elsif ($CONFIG{'sort'} =~ /^order:.*,.*/) {
$sort_order = $CONFIG{'sort'};
$sort_order =~ s/order://;
@sorted_fields = split(/,/, $sort_order);
foreach $sorted_field (@sorted_fields) {
# Print the name and value pairs in FORM array to html.
if ($FORM{$sorted_field}) {
print "<b>$sorted_field:</b> $FORM{$sorted_field}<p>\n";
}
}
}
else {
foreach $key (keys %FORM) {
# Print the name and value pairs in FORM array to html.
print "<b>$key:</b> $FORM{$key}<p>\n";
}
}
print "<p><hr size=7 width=75%><p>\n";
# Check for a Return Link
if ($CONFIG{'return_link_url'} =~ /http\:\/\/.*\..*/ &&
$CONFIG{'return_link_title'}) {
print "<ul>\n";
print "<li><a
href=\"$CONFIG{'return_link_url'}\">$CONFIG{'return_link_title'}</a>\n";
print "</ul>\n";
}
print "</body>\n</html>";
}
}
sub send_mail {
# Open The Mail Program
open(MAIL,"|$mailprog -t");
print MAIL "To: $CONFIG{'recipient'}\n";
print MAIL "From: $CONFIG{'E-Mail'} ($CONFIG{'Real Name'})\n";
# Check for Message Subject
if ($CONFIG{'subject'}) {
print MAIL "Subject: $CONFIG{'subject'}\n\n";
}
else {
print MAIL "Subject: WWW Form Submission\n\n";
}
print MAIL "Below is a Client Registration submisson. It was ";
print MAIL "submitted by $CONFIG{'Real Name'} ($CONFIG{'E-Mail'}) on ";
print MAIL "$date\n";
print MAIL
"---------------------------------------------------------------------------\n\
\n";
if ($CONFIG{'print_config'}) {
@print_config = split(/,/,$CONFIG{'print_config'});
foreach $print_config (@print_config) {
if ($CONFIG{$print_config}) {
print MAIL "$print_config: $CONFIG{$print_config}\n\n";
}
}
}
if ($CONFIG{'sort'} eq 'alphabetic') {
foreach $key (sort keys %FORM) {
# Print the name and value pairs in FORM array to mail.
print MAIL "$key: $FORM{$key}\n\n";
}
}
elsif ($CONFIG{'sort'} =~ /^order:.*,.*/) {
$CONFIG{'sort'} =~ s/order://;
@sorted_fields = split(/,/, $CONFIG{'sort'});
foreach $sorted_field (@sorted_fields) {
# Print the name and value pairs in FORM array to mail.
if ($FORM{$sorted_field}) {
print MAIL "$sorted_field: $FORM{$sorted_field}\n\n";
}
}
}
else {
foreach $key (keys %FORM) {
# Print the name and value pairs in FORM array to html.
print MAIL "$key: $FORM{$key}\n\n";
}
}
print MAIL
"---------------------------------------------------------------------------\n"
";
# Send Any Environment Variables To Recipient.
foreach $env_report (@env_report) {
print MAIL "$env_report: $ENV{$env_report}\n";
}
close (MAIL);
}
sub error {
($error, at error_fields) = @_;
print "Content-type: text/html\n\n";
if ($error eq 'bad_referer') {
print "<html>\n <head>\n <title>Bad Referrer - Access Denied</title>\n
</head>\n";
print " <body>\n <center>\n <h1>Bad Referrer - Access Denied</h1>\n
</center>\n";
print "The form that is trying to use this <a
href=\"http://www.worldwidemart.com/scripts/\">FormMail Program</a>\n";
print "resides at: $ENV{'HTTP_REFERER'}, which is not allowed to access
this cgi script.<p>\n";
print "Sorry!\n";
print "</body></html>\n";
}
elsif ($error eq 'request_method') {
print "<html>\n <head>\n <title>Error: Request Method</title>\n
</head>\n";
print "</head>\n <body>\n <center>\n";
print " <h1>Error: Request Method</h1>\n </center>\n\n";
print "The Request Method of the Form you submitted did not match\n";
print "either GET or POST. Please check the form, and make sure the\n";
print "method= statement is in upper case and matches GET or POST.\n";
print "<p><hr size=7 width=75%><p>\n";
print "<ul>\n";
print "<li><a href=\"$ENV{'HTTP_REFERER'}\">Back to the Submission
Form</a>\n";
print "</ul>\n";
print "</body></html>\n";
}
elsif ($error eq 'missing_fields') {
print "<HTML>\n <HEAD>\n <TITLE>Error: Blank Fields in Form</TITLE>\n
</HEAD>\n";
print "<BODY BACKGROUND=\"graphics/bg_dmg.jpg\" BGCOLOR=\PINK>\n";
print "<CENTER>\n <H1><FONT COLOR=RED>$title</FONT></H1>\n </CENTER>\n";
print "<H2 ALIGN=CENTER><FONT COLOR=RED>Error: Blank Fields</FONT></H2>\n";
print "<H3 ALIGN=CENTER>The following fields were left blank in your
submission form:</H3>\n";
print "<CENTER>\n";
# Print Out Missing Fields in a List.
print "<TABLE BORDER=4 BGCOLOR=#FFFF99 CELLPADDING=5><TR><TD><B>\n";
foreach $missing_field (@error_fields) {
print " $missing_field <BR>\n";
}
print "</B></TABLE>\n";
# Provide Explanation for Error and Offer Link Back to Form.
print "</CENTER>\n";
print "<HR SIZE=3 NOSHADE COLOR=RED WIDTH=75%>\n";
print "<BLOCKQUOTE><B>These fields must be completed before we can accept
your submission. \n";
print "Please return to the <A HREF=\"$ENV{'HTTP_REFERER'}\">Previous
Form</A> and try again.</B></BLOCKQUOTE>\n";
print "</BODY></HTML>\n";
}
exit;
}
More information about the Web4lib
mailing list