#!/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 /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- :] Systems Hacker FCCJ 501 W State St Jacksonville, Fl 32202 Email: bill@fccj.org =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@fccj.org'; 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 infoRequest.html`; exit; } # Globals ... my $required = 0; my $ercBuffer = ''; # Execute the logical stuff... &_verify(); &_main(); sub _verify() { # Optional field: #$ercBuffer .= '
Erc:  Salutation missing...' # unless ((param('select2')) || ($FCCJ::select2 ne 'NI')); $ercBuffer .= '
Erc:  Name missing...' unless ((param('textfield')) || ($FCCJ::textfield 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('select')) || ($FCCJ::select ne 'NI')); $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) # Are they a Returning Student? $ercBuffer .= '
Erc:  Please indicate if you are returning student...' unless (param('isRS')); unless (param('emailCB')) { $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; 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; } #exit $error; ############################################################ ### WARNING: ### Source Changed dramatically Sat 9:45AM on 04/29/2000 by WC Jones -Sneex- :] # 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); } # Format for testing: #$ercBuffer .= '
Erc:  Salutation missing...' # unless ((param('select2')) || ($FCCJ::select2 ne 'NI')); # Format for testing: #$ercBuffer .= '
Erc:  Salutation missing...' # unless ((param('select2')) || ($FCCJ::select2 ne 'NI')); # Optional fields: # textfield12 = Career Interest # apCB = apCB (Application Packet checkbox) # catCB = catCB (Catalog checkbox) # csRB = csFall (Credit Schedule radiobutton) (Also available are csSpring & csSummer...) # cesRB = cesFall (Continuing Education Schedule radiobutton) (" " " cesSpring & cesSummer...) # fapCB = fap2000SummerCB (Financial Aid Packet checkbox for Summer 2000 only...) # fapRB = fapFall (Financial Aid Packet for 2001 Fall) (" " " fapSpring & fapSummer...) $required = 1 if ($ercBuffer =~ /Erc/gi); } 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; print <<_1EOBA;

Hello from the FCCJ (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 'NI'); print "$FCCJ::textfield"; print "
$FCCJ::textfield2  "; print "  Apt: $FCCJ::textfield3" if ((param('textfield3')) || ($FCCJ::textfield3 ne '')); print "
$FCCJ::textfield4, $FCCJ::select $FCCJ::textfield5

Phone: ($FCCJ::textfield6) $FCCJ::textfield7-$FCCJ::textfield8 "; print "Ext: $FCCJ::textfield9" if ((param('textfield9')) || ($FCCJ::textfield9 ne '')); print "

E-Mail: $FCCJ::textfield10\@$FCCJ::textfield11 -- REQUIRED to get an E-Mailed Receipt!

=== Your request consisted of:"; print "
"; print "
Career Interest: $FCCJ::textfield12" if (param('textfield12') || $FCCJ::textfield12 ne ''); print "
Application Packet requested." if (param('apCB')); print "
I am an International Student." if (param('isCB')); print "
I am a Returning Student." if (param('isRS')); print "
Catalog requested." if (param('catCB')); # fapCB = fap2000SummerCB (Financial Aid Packet checkbox for Summer 2000 only...) print "

Financial Aid Packet, for Summer 2000 only, requested." if (param('fapCB') && $FCCJ::fapCB ne ''); print "
"; if (param('csRB')) { # csRB = csFall (Credit Schedule radiobutton) (Also available are csSpring & csSummer...) print "
Fall Credit Schedule requested." if ($FCCJ::csRB eq 'csFall'); print "
Spring Credit Schedule requested." if ($FCCJ::csRB eq 'csSpring'); print "
Summer Credit Schedule requested." if ($FCCJ::csRB eq 'csSummer'); } print "
"; if (param('cesRB')) { # cesRB = cesFall (Continuing Education Schedule radiobutton) (" " " cesSpring & cesSummer...) print "
Fall Continuing Education Schedule requested." if ($FCCJ::cesRB eq 'cesFall'); print "
Spring Continuing Education Schedule requested." if ($FCCJ::cesRB eq 'cesSpring'); print "
Summer Continuing Education Schedule requested." if ($FCCJ::cesRB eq 'cesSummer'); } print "
"; if (param('fapRB')) { # fapRB = fapFall (Financial Aid Packet for 2001 Fall) (" " " fapSpring & fapSummer...) print "
Financial Aid Packet for 2001 Fall requested." if ($FCCJ::fapRB eq 'fapFall'); print "
Financial Aid Packet for 2001 Spring requested." if ($FCCJ::fapRB eq 'fapSpring'); print "
Financial Aid Packet for 2001 Summer requested." if ($FCCJ::fapRB eq 'fapSummer'); } print <<_EOBB;

=== end of request ===

Note: _EOBB print "

This request will be sent to the FCCJ 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 = "astro"; my $defaultdomain = "fccj.org"; # 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 (param('emailCB')) { open (MAIL, "| $SENDMAIL $FCCJ::textfield10\@$FCCJ::textfield11, $REPLY_TO") || die ("$0: Can't open $SENDMAIL: $!\n"); } else { open (MAIL, "| $SENDMAIL $REPLY_TO") || die ("$0: Can't open $SENDMAIL: $!\n"); $FCCJ::textfield10 = "decode"; $FCCJ::textfield11 = "astro.fccj.org"; } # 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: \"$host.infoRequest\" \<$userid\@$host.$domain\>, \"$REPLY_TO\" \<$REPLY_TO\>\n"; print MAIL "To: $FCCJ::textfield10\@$FCCJ::textfield11, $REPLY_TO\n"; print MAIL "Subject: FCCJ Information Request; received at ", scalar localtime, "\n"; print MAIL "\n"; print MAIL "=================================================================\n"; print MAIL "NOTE: This message was sent through the infoRequest Perl System,\n"; print MAIL " infoRequest v1.15n (Beta) by -Sneex- :] (WC Jones), JaxPM\n"; print MAIL "=================================================================\n"; print MAIL "\n\n"; print MAIL <<_1EOMA; Hello from the FCCJ (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:\n\n _1EOMA print MAIL "$FCCJ::select2" unless ($FCCJ::select2 eq 'NI'); print MAIL " $FCCJ::textfield\n"; print MAIL "$FCCJ::textfield2 "; print MAIL "- Apt: $FCCJ::textfield3" if ((param('textfield3')) || ($FCCJ::textfield3 ne '')); print MAIL "\n$FCCJ::textfield4, $FCCJ::select $FCCJ::textfield5\n\n Phone: ($FCCJ::textfield6) $FCCJ::textfield7-$FCCJ::textfield8 "; print MAIL "- Ext: $FCCJ::textfield9\n\n" if ((param('textfield9')) || ($FCCJ::textfield9 ne '')); print MAIL "\n\nE-Mail: $FCCJ::textfield10\@$FCCJ::textfield11\n\n === Your request consisted of:"; print MAIL "\n"; print MAIL "\nCareer Interest: $FCCJ::textfield12" if (param('textfield12') || $FCCJ::textfield12 ne ''); print MAIL "\nApplication Packet requested." if (param('apCB')); print MAIL "\nI am an International Student." if (param('isCB')); print MAIL "\nI am an Returning Student." if (param('isRS')); print MAIL "\nCatalog requested." if (param('catCB')); print MAIL "\n"; # fapCB = fap2000SummerCB (Financial Aid Packet checkbox for Summer 2000 only...) print MAIL "Financial Aid Packet, for Summer 2000 only, requested." if (param('fapCB') && $FCCJ::fapCB ne ''); print MAIL "\n"; if (param('csRB')) { # csRB = csFall (Credit Schedule radiobutton) (Also available are csSpring & csSummer...) print MAIL "\nFall Credit Schedule requested." if ($FCCJ::csRB eq 'csFall'); print MAIL "\nSpring Credit Schedule requested." if ($FCCJ::csRB eq 'csSpring'); print MAIL "\nSummer Credit Schedule requested." if ($FCCJ::csRB eq 'csSummer'); } print MAIL "\n"; if (param('cesRB')) { # cesRB = cesFall (Continuing Education Schedule radiobutton) (" " " cesSpring & cesSummer...) print MAIL "\nFall Continuing Education Schedule requested." if ($FCCJ::cesRB eq 'cesFall'); print MAIL "\nSpring Continuing Education Schedule requested." if ($FCCJ::cesRB eq 'cesSpring'); print MAIL "\nSummer Continuing Education Schedule requested." if ($FCCJ::cesRB eq 'cesSummer'); } print MAIL "\n"; if (param('fapRB')) { # fapRB = fapFall (Financial Aid Packet for 2001 Fall) (" " " fapSpring & fapSummer...) print MAIL "\nFinancial Aid Packet for 2001 Fall requested." if ($FCCJ::fapRB eq 'fapFall'); print MAIL "\nFinancial Aid Packet for 2001 Spring requested." if ($FCCJ::fapRB eq 'fapSpring'); print MAIL "\nFinancial Aid Packet for 2001 Summer requested." if ($FCCJ::fapRB eq 'fapSummer'); } 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 FCCJ! Thank you, we appreciate your time in sending your request(s)! (This mailing was sent by request of either a current or potential FCCJ 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 FCCJ Webmaster at webmaster\@fccj.org with a written request to have your e-mail address blocked and you will no longer receive these mailings... _EOMB print MAIL "\n\nEnd of E-Mail...\n"; close (MAIL); exit; } __END__ End of program