#!/usr/local/bin/perl -w ## MOST of this script is Copyright 1999 -Sneex- (WCJones); All Rights Reserved... ## However, as I don't want to reinvent the wheel, there are portions Copyright others - ## Many thanks to Friedl & O'Reilly for writing and publishing: ## _Mastering Regular Expressions_ # # Code to build a regex to match an internet email address, # from Chapter 7 of _Mastering Regular Expressions_ (Friedl / O'Reilly) # (http://www.ora.com/catalog/regexp/) # # Optimized version. # # Copyright 1997 O'Reilly & Associates, Inc. # # Some things for avoiding backslashitis later on. my $esc = '\\\\'; my $Period = '\.'; my $space = '\040'; my $tab = '\t'; my $OpenBR = '\['; my $CloseBR = '\]'; my $OpenParen = '\('; my $CloseParen = '\)'; my $NonASCII = '\x80-\xff'; my $ctrl = '\000-\037'; my $CRlist = '\n\015'; # note: this should really be only \015. # Items 19, 20, 21 my $qtext = qq/[^$esc$NonASCII$CRlist\"]/; # for within "..." my $dtext = qq/[^$esc$NonASCII$CRlist$OpenBR$CloseBR]/; # for within [...] my $quoted_pair = qq< $esc [^$NonASCII] >; # an escaped character ############################################################################## # Items 22 and 23, comment. # Impossible to do properly with a regex, I make do by allowing at most one level of nesting. my $ctext = qq< [^$esc$NonASCII$CRlist()] >; # $Cnested matches one non-nested comment. # It is unrolled, with normal of $ctext, special of $quoted_pair. $Cnested = qq< $OpenParen # ( $ctext* # normal* (?: $quoted_pair $ctext* )* # (special normal*)* $CloseParen # ) >; # $comment allows one level of nested parentheses # It is unrolled, with normal of $ctext, special of ($quoted_pair|$Cnested) $comment = qq< $OpenParen # ( $ctext* # normal* (?: # ( (?: $quoted_pair | $Cnested ) # special $ctext* # normal* )* # )* $CloseParen # ) >; ############################################################################## # $X is optional whitespace/comments. $X = qq< [$space$tab]* # Nab whitespace. (?: $comment [$space$tab]* )* # If comment found, allow more spaces. >; # Item 10: atom $atom_char = qq/[^($space)<>\@,;:\".$esc$OpenBR$CloseBR$ctrl$NonASCII]/; $atom = qq< $atom_char+ # some number of atom characters... (?!$atom_char) # ..not followed by something that could be part of an atom >; # Item 11: doublequoted string, unrolled. $quoted_str = qq< \" # " $qtext * # normal (?: $quoted_pair $qtext * )* # ( special normal* )* \" # " >; # Item 7: word is an atom or quoted string $word = qq< (?: $atom # Atom | # or $quoted_str # Quoted string ) >; # Item 12: domain-ref is just an atom $domain_ref = $atom; # Item 13: domain-literal is like a quoted string, but [...] instead of "..." $domain_lit = qq< $OpenBR # [ (?: $dtext | $quoted_pair )* # stuff $CloseBR # ] >; # Item 9: sub-domain is a domain-ref or domain-literal $sub_domain = qq< (?: $domain_ref | $domain_lit ) $X # optional trailing comments >; # Item 6: domain is a list of subdomains separated by dots. $domain = qq< $sub_domain (?: $Period $X $sub_domain )* >; # Item 8: a route. A bunch of "@ $domain" separated by commas, followed by a colon. $route = qq< \@ $X $domain (?: , $X \@ $X $domain )* # additional domains : $X # optional trailing comments >; # Item 6: local-part is a bunch of $word separated by periods $local_part = qq< $word $X (?: $Period $X $word $X # additional words )* >; # Item 2: addr-spec is local@domain $addr_spec = qq< $local_part \@ $X $domain >; # Item 4: route-addr is $route_addr = qq[ < $X # < (?: $route )? # optional route $addr_spec # address spec > # > ]; # Item 3: phrase........ $phrase_ctrl = '\000-\010\012-\037'; # like ctrl, but without tab # Like atom-char, but without listing space, and uses phrase_ctrl. # Since the class is negated, this matches the same as atom-char plus space and tab $phrase_char = qq/[^()<>\@,;:\".$esc$OpenBR$CloseBR$NonASCII$phrase_ctrl]/; # We've worked it so that $word, $comment, and $quoted_str to not consume trailing $X # because we take care of it manually. $phrase = qq< $word # leading word $phrase_char * # "normal" atoms and/or spaces (?: (?: $comment | $quoted_str ) # "special" comment or quoted string $phrase_char * # more "normal" )* >; ## Item #1: mailbox is an addr_spec or a phrase/route_addr my $mailbox = qq< $X # optional leading comment (?: $addr_spec # address | # or $phrase $route_addr # name and address ) >; # End of Copyright 1997 O'Reilly & Associates, Inc. # End of Copyrighted code section... =pod =head1 NAME infoRequest - A script for obtaining Requests for Information and immediately replying. =head1 SYNOPSIS iR3.cgi ( was: /cgi/infoRequest.cgi ) =head1 DESCRIPTION I'll enter a longer description later... =head1 INSTALLATION Install this script into /cgi/ of relevant WWW server... =head1 SCRIPT CATEGORIES cgi mail stuff =head1 PREREQUISITES None... =head1 OSNAMES any OS using sendmail or a compatible mail server =head1 AUTHOR -Sneex- (IUDICIUM) :] Chasecreek Systemhouse Jacksonville, Fl 32225 Email: sneex@mac.com =head1 SEE ALSO L =cut # Uncomment when Debugging & Error Checking ... #use strict; #use diagnostics; # REQUIRED -- CGI Processing ... use CGI qw(:all); use CGI::Carp qw/fatalsToBrowser/; my($fccjPointer) = new CGI; $fccjPointer->import_names('FCCJ'); # Troubleshooting! Comment out when in production! #print "Content-type: text/html\n\n

infoRequest - Debug Data Dump:


"; #print $fccjPointer->dump; ############################################################################ # # Configurable section # ############################################################################ my $REPLY_TO = 'info@127.0.0.1'; my $SENDMAIL = '/usr/lib/sendmail'; # Use an entry like # # info-owner: /dev/null # # to suppress error messages from info-responder replies. # ############################################################################ $FCCJ::x = '' unless param('x'); $FCCJ::y = '' unless param('y'); # Was infoRequest.cgi called directly? If so, redirect ... unless (length($FCCJ::x . $FCCJ::y) > 0) { print "Content-type: text/html\n\n"; print `cat iR3.html`; # Example @ http://www.fccj.org/request.html exit; } # Globals ... my $required = 0; my $ercBuffer = ''; # Execute the logical stuff... &_verify(); &_main(); sub _verify() { $ercBuffer .= '
Erc:  Student Status missing...' unless ((param('select3')) && ($FCCJ::select3 ne '-')); $ercBuffer .= '
Erc:  Salutation missing...' unless ((param('select2')) && ($FCCJ::select2 ne '-')); if (param('checkbox24')) { $ercBuffer .= '
Erc:  Attendance Date missing...' unless ((param('select4')) && ($FCCJ::select4 ne '-')); } $ercBuffer .= '
Erc:  Career interest missing...' unless ((param('select5')) && ($FCCJ::select5 ne '-')); # Really, I should test to see if a phone was entered... #$ercBuffer .= '
Erc:  Please indicate AM or PM only...' # unless ((param('Time')) && ($FCCJ::Time ne '-')); $ercBuffer .= '
Erc:  First Name missing...' unless ((param('textfield')) || ($FCCJ::textfield ne '')); $ercBuffer .= '
Erc:  Last Name missing...' unless ((param('textfield13')) || ($FCCJ::textfield13 ne '')); $ercBuffer .= '
Erc:  Address missing...' unless ((param('textfield2')) || ($FCCJ::textfield2 ne '')); # apartment portion of Address is optional (field name: textfield3) $ercBuffer .= '
Erc:  City missing...' unless ((param('textfield4')) || ($FCCJ::textfield4 ne '')); $ercBuffer .= '
Erc:  State missing...' unless ((param('iState')) && ($FCCJ::iState ne '')); $ercBuffer .= '
Erc:  Country missing...' unless ((param('iCountry')) && ($FCCJ::iCountry ne '')); $ercBuffer .= '
Erc:  Zip Code missing...' unless ((param('textfield5')) || ($FCCJ::textfield5 ne '')); # area code portion of Phone number is optional (field name: textfield6) # exchange portion of Phone number is optional (field name: textfield7) # 4 digit number portion of Phone number is optional (field name: textfield8) # extension portion of Phone number is optional (field name: textfield9) $FCCJ::textfield10 = '' unless param('textfield10'); $FCCJ::textfield11 = '' unless param('textfield11'); if (length($FCCJ::textfield10 . $FCCJ::textfield11) > 0) { $ercBuffer .= '
Erc:  E-Mail given: ' . "$FCCJ::textfield10\@$FCCJ::textfield11" . '; has UserID missing...' unless ((param('textfield10')) || ($FCCJ::textfield10 ne '')); $ercBuffer .= '
Erc:  E-Mail given: ' . "$FCCJ::textfield10\@$FCCJ::textfield11" . '; has ISP Domain missing...' unless ((param('textfield11')) || ($FCCJ::textfield11 ne '')); $ercBuffer .= '
Erc:  E-Mail given: ' . "$FCCJ::textfield10\@$FCCJ::textfield11" . '; is not valid...' unless (($FCCJ::textfield10 . '@' . $FCCJ::textfield11) =~ /(\@).+(\.).+/); ##### Let's see if the address given is generally valid: ############################################################ @_ = $FCCJ::textfield10 . '@' . $FCCJ::textfield11; my $error = 0; my $valid; my @blocked = @_; # Blocked Addresses, by request: Addresses are blocked at the wish of the requestor, see listing... # Blocked Spamming Domains: too many to mention, see listing... foreach (@blocked) { # Blocked Spammers: No domains listed at this time... # $invalid = 1 if //i; $ercBuffer .= '
Erc:  E-Mail given: ' . "$FCCJ::textfield10\@$FCCJ::textfield11" . '; not acceptable - Domain has been blocked...' if $invalid; # Blocked Addresses: # $invalid = 1 if /(jaxpm|root|postmaster|wcjones|sneex|bill)\@(insecurity|usa|fccj)\.(org|net|com|edu|cc)/i; # Example: $invalid = 1 if /sneex\@mac\.com/i; $ercBuffer .= '
Erc:  E-Mail given: ' . "$FCCJ::textfield10\@$FCCJ::textfield11" . '; not acceptable - Address has been blocked...' if $invalid; } # ForEach foreach my $address (@_) { $valid = $address =~ m/^$mailbox$/xo; # printf "`$address' is syntactically %s.\n", $valid ? "valid" : "invalid"; # $error = 1 if not $valid; $ercBuffer .= '
Erc:  E-Mail given: ' . "$FCCJ::textfield10\@$FCCJ::textfield11" . '; is not syntactically valid...' if not $valid; } # ForEach ############################################################ # Let's see if we can get rid of the 'extra' @ signs: #$_ = ($FCCJ::textfield10 . $FCCJ::textfield11); $_ =~ /\@/; # Split on @ signs... #$FCCJ::textfield10 = $`; # Hopefully the UserID... #$FCCJ::textfield11 = $'; # Hopefully the host/domain for delivery... #$FCCJ::textfield10 =~ s/\@//g; #$FCCJ::textfield11 =~ s/\@//g; # Let's see if we can get rid of the 'extra' spaces: $FCCJ::textfield10 =~ s/\s//g; $FCCJ::textfield11 =~ s/\s//g; # Let's see if the first five letters of the hosts/domain name appears in the userid; # if so, then this address is most likely invalid: #$ercBuffer .= '
Erc:  E-Mail given: ' . # "$FCCJ::textfield10\@$FCCJ::textfield11" . '; ERROR - UserID cannot contain the Host/Domain name...' # if (index($FCCJ::textfield10, (substr($FCCJ::textfield11,5))) > $[); # Let's see if they are trying to have it sent back to us: $ercBuffer .= '
Erc:  E-Mail given: ' . "$FCCJ::textfield10\@$FCCJ::textfield11" . '; ERROR - Local delivery not allowed...' if (($FCCJ::textfield10 . $FCCJ::textfield11) =~ /(astro|www)\.fccj.+/i); } # End of e-mail tests... # Optional fields: # select5 (was: textfield12) = Career Interest # checkbox (was: apCB) = Application Packet # checkbox2 (was: catCB) = Catalog # checkbox22 (was: csRB) = Credit Schedule # checkbox23 (was: cesRB) = Continuing Education Schedule # checkbox24/25 (was:fapCB) = Financial Aid Packet - Yes & No, respectively... $required = 1 if ($ercBuffer =~ /Erc/gi); } # Verify... sub _main() { print "Content-type: text/html\n\n"; if ($required) { print <<_Erc; Error! Required Data Missing!

FCCJ Home

ERROR! Required fields missing:

$ercBuffer

Please hit the browser's Back button and fill these required fields in. _Erc exit; } print <<_1SOH; Your Request Was Sent!

FCCJ Home

_1SOH print "

Your processed request is indicated below; a copy of which will be e-mailed to you.


"; my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime; my $sltime = "$sec$min$hour$mday$mon$year$wday"; my $stime = scalar localtime; my $rhost = remote_host() if remote_host(); my $raddr = remote_addr() if remote_addr(); my $uAgent = user_agent() if user_agent(); my $ref = referer() if referer(); # Referrer: referer() # Remote Addr: remote_addr() # Remote Host: remote_host() # User Agent: user_agent() print <<_1EOBA;

Hello from the YOUR (info) E-Mail infoRequest CGI :]
Your request was received by the CGI on $stime.
This request was assigned the following
(dss) Security Number: $sltime.

=== Your Name and Address information:

_1EOBA print "$FCCJ::select2 " unless ($FCCJ::select2 eq '-'); print "$FCCJ::textfield $FCCJ::textfield13"; print "
$FCCJ::textfield2  "; print "  Apt: $FCCJ::textfield3" if ((param('textfield3')) && ($FCCJ::textfield3 ne '')); print "
$FCCJ::textfield4, $FCCJ::iState $FCCJ::iCountry $FCCJ::textfield5

Phone: ($FCCJ::textfield6) $FCCJ::textfield7-$FCCJ::textfield8 "; print "Ext: $FCCJ::textfield9" if ((param('textfield9')) && ($FCCJ::textfield9 ne '')); print "
Best time to contact: $FCCJ::Time" if ((param('Time')) && ($FCCJ::Time ne '-')); print "
E-Mail: $FCCJ::textfield10\@$FCCJ::textfield11 -- REQUIRED to get an E-Mailed Receipt!

=== Your request consisted of:"; print "
Career Interest: $FCCJ::select5" if (param('select5') && $FCCJ::select5 ne '-'); print "
Application Packet requested." if (param('checkbox')); print "
I am an International Student." if (param('checkbox3')); print "
I am a $FCCJ::select3 student." if ((param('select3')) && (lc($FCCJ::select3) ne '-')); print "
Catalog requested." if (param('checkbox2')); print "
Financial Aid Packet requested." if (param('checkbox24')); print "
Planned Attendance Date: $FCCJ::select4" if ((param('select4')) && (lc($FCCJ::select4) ne '-')); print "
Credit Schedule requested." if (param('checkbox22')); print "
Continuing Education Schedule requested." if (param('checkbox23')); print <<_EOBB;
=== end of request ===

Note: _EOBB print "

This request will be sent to the YOUR Information office for \n
processing.  You will get a copy for your records \n
if you entered a valid e-mail address. \n

If you need to modify your request, please hit the back button."; # Set your locahost, default host; and localdomain, default domain: my $defaulthost = "localhost"; my $defaultdomain = "localdomain"; # I'll get your host and userID (who will get these reports?) # Or Set a recipient at the end of the first command here: #chomp(my $userid = `/usr/ucb/whoami` || `/usr/bin/whoami` || 'info'); my $userid = 'info'; # Forced... chomp(my $host = `/bin/hostname` || `/bin/uname -n` || $defaulthost); chomp(my $domain = `/bin/domainname` || $defaultdomain); unless (length($FCCJ::textfield10 . $FCCJ::textfield11) > 0) { $FCCJ::textfield10 = "owner-webmaster"; $FCCJ::textfield11 = "127.0.0.1"; } open (MAIL, "| $SENDMAIL $FCCJ::textfield10\@$FCCJ::textfield11, $REPLY_TO") || die ("$0: Can't open $SENDMAIL: $!\n"); # Use these mail header lines... #print MAIL "Reply-to: $REPLY_TO, $FCCJ::textfield10\@$FCCJ::textfield11\n"; # How to get both? Hmmm? print MAIL "Reply-to: $FCCJ::textfield10\@$FCCJ::textfield11\n"; print MAIL "From: \"Info Request\" \<$userid\@$host.$domain\>, \"$REPLY_TO\" \<$REPLY_TO\>\n"; print MAIL "To: $FCCJ::textfield10\@$FCCJ::textfield11, $REPLY_TO\n"; print MAIL "Subject: YOUR Information Request; received at ", scalar localtime, "\n"; print MAIL "\n"; print MAIL "Title: $FCCJ::select2\nLast Name: $FCCJ::textfield13\nFirst Name: $FCCJ::textfield\n"; print MAIL "Address: $FCCJ::textfield2\nApartment: $FCCJ::textfield3\n"; print MAIL "City: $FCCJ::textfield4\nState: $FCCJ::iState\nCountry: $FCCJ::iCountry\nZip: $FCCJ::textfield5\n"; print MAIL "Phone: ($FCCJ::textfield6) $FCCJ::textfield7-$FCCJ::textfield8 Ext: $FCCJ::textfield9\n"; print MAIL "BestTimeToCall: $FCCJ::Time\n"; print MAIL "E-Mail: $FCCJ::textfield10\@$FCCJ::textfield11\n === Your request consisted of:"; print MAIL "\nCareer Interest: $FCCJ::select5" if (param('select5') && $FCCJ::select5 ne '-'); print MAIL "\nApplication Packet requested." if (param('checkbox')); print MAIL "\nI am an International Student." if (param('checkbox3')); print MAIL "\nI am a $FCCJ::select3 student." if ((param('select3')) && (lc($FCCJ::select3) ne '-')); print MAIL "\nCatalog requested." if (param('checkbox2')); print MAIL "\nFinancial Aid Packet requested." if (param('checkbox24')); print MAIL "\nPlanned Attendance Date: $FCCJ::select4" if ((param('select4')) && (lc($FCCJ::select4) ne '-')); print MAIL "\nCredit Schedule requested." if (param('checkbox22')); print MAIL "\nContinuing Education Schedule requested." if (param('checkbox23')); print MAIL<<_EOMB; === end of request === Notice: If any of the above information is incorrect, please reply to and correct this e-mailed copy. WARNING: You must use the 'Reply All' button to send corrections back to us! Thank you, we appreciate your time in sending your request(s)! (This mailing was sent by request of either a current or potential student. If you have received this mailing in error - please delete it immediately and accept our most sincere apologies...) These mailings can be blocked - please contact the YOUR Webmaster at webmaster\@127.0.0.1 with a written request to have your e-mail address blocked and you will no longer receive these mailings... When requesting a block - please reference: The Request Time: $stime, the Security Number: $sltime, and include the following - Remote Host (IP Addr): $rhost ($raddr) ... URL Referer and User Agent: $ref using $uAgent ... Thank You; YOUR Data Security Group _EOMB print MAIL "\n\nEnd of E-Mail...\n"; close (MAIL); exit; } __END__ End of program - Example data follows: Title: Mr/Ms/Dr Last Name: Doe First Name: John R. Street: 233 Randolph Road Apartment: ##### City: Toronto State: FL Zip: 32216 +Country: USA Phone: 9047303406 +BestTimeToCall: AM/PM Email: johndoe@your.com Career Interest: Computers/Programming Application Packet requested. I am an International Student. I am a prospective student. Catalog requested. Financial Aid Packet requested. Planned Attendance Date: August 2001 Credit Schedule requested. Continuing Education Schedule requested.