#!/usr/local/bin/perl
##############################################################################
# FormMail Version 1.5 #
# Copyright 1996 Matt Wright mattw@worldwidemart.com #
# 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. #
# #
# Obtain permission before redistributing this software over the Internet or #
# in any other medium. In all cases copyright and header must remain intact #
##############################################################################
# parts of this were taken from FormMail, hence the notice above
# define variables
$STICKE_BASE='.'; # where stick-e software and applications are found (there is a link from .)
$show_client_calls=1; # for debugging set this non-zero
# @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.
#pjb: addition here
@referers = ( #'www.worldwidemart.com','worldwidemart.com','206.31.72.203',
'wwp.cambridge.rxrc.xerox.com', 'ww.cs.ukc.ac.uk', '/home/brown/sticke', '/home/cur/pjb', '/proj/sticke');
# Done
#############################################################################
# Check Referring URL
&check_url;
print "Content-type: text/html\n\n";
print "\n \n";
print " Processing form\n";
print " \n";
$have_frames = 0; #default
if (open PARAMS, "../tmp/params") {
while () {
if ($_ =~ "FRAMES=Y") {
$have_frames = 1;
}
}
}
if (!$have_frames) {
print " \n";
print `./generate_menu`;
}
# Parse Form Contents
&parse_form;
if (!$have_frames) {
print "";
}
print " ";
exit;
#----- checking of url
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');
}
} # check-url
#---- parse the form
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');
}
$req_flag = ''; # default
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
# are not a security risk if the html gets returned. Another
# security hole plugged up.
$value =~ s///g;
# call client
if ($name eq 'REQUIRED') {
if ($value eq 'REQUIRED') {
$req_flag = '-required';
}
} else {
if ($value eq '') {
$value = 'off';
}
# after each MULTIPLE SELECT that has at least one item already selected
# we have a hidden default setting to cover the case when none is selected
# this is ignored if a selection has already been found
# e.g.:
unless ($name =~ s/_default$// && $name_list{$name} ne '') {
# each request for input is preceded by a hidden field showing
# the previous setting. e.g.
# the purpose is to detect when a setting has not changed.
# NB some settings (e.g. " ... OR some other alternatives") are
# not syntactically correct input and are merely comments to the user;
# it is important to detect when these come back unchanged.
if (!($name =~ /_previous$/) && $name_list{$name . "_previous"} ne $value) {
$f_flag = '-F'; # default
unless ($name_list{$name} eq '') { # this covers selection after first in MULTIPLE
$f_flag = '-+'; # if tag has occurred before use -+ instead of -F
}
if ($show_client_calls && !$have_frames) {
print "
\n";
}
print `$STICKE_BASE/client $req_flag $f_flag "$name" ".4pretended=$value"`;
} # if
#was $name_list .= $name_list . '{' . $name . '}';
# print "Setting name_list($name) to $value ";
$name_list{$name} = $value; # record that the tag has occurred
} #unless
} # else
} # foreach
print `$STICKE_BASE/client -t`; # do the triggering
} # parse_form
sub error {
($error,@error_fields) = @_;
print "Content-type: text/html\n\n";
if ($error eq 'bad_referer') {
print "\n \n Bad Referrer - Access Denied\n \n";
print " \n
\n
Bad Referrer - Access Denied
\n
\n";
print "The form that is trying to use this FormMail Program\n";
print "resides at: $ENV{'HTTP_REFERER'}, which is not allowed to access this cgi script.
\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 "