1  #!/usr/npac/bin/perl -w
  2  
  3  #############################################################################
  4  #  
  5  #   File:    mailform.pl
  6  #
  7  #   Author:  Tom Scavo <trscavo@npac.syr.edu>
  8  #
  9  #   This perl script is a web-based mail utility.  If invoked with
 10  #   no parameters, a simple HTML form is returned to the browser.
 11  #   Otherwise the script will process a query string containing 
 12  #   any number of keyword-value pairs.  An e-mail message is 
 13  #   constructed from this input and sent to the specified recipient.
 14  #
 15  #   One of the keywords must be:
 16  #
 17  #     _mailTo
 18  #
 19  #   whose value is the address of the recipient of the e-mail message.
 20  #   Here are some examples of HTML form elements satisfying this requirement:
 21  #
 22  #     <INPUT TYPE=HIDDEN NAME=_mailTo VALUE="trscavo@syr.edu">
 23  #     <INPUT TYPE=HIDDEN NAME=_mailTo VALUE="trscavo@syr.edu (Tom Scavo)">
 24  #     <INPUT TYPE=HIDDEN NAME=_mailTo 
 25  #            VALUE="&quot;Tom Scavo&quot; &lt;trscavo@syr.edu&gt;">
 26  #
 27  #   The following keywords are optional, but processed specially:
 28  #
 29  #     _mailFrom
 30  #     _mailSubject
 31  #     _mailCc
 32  #     _mailBcc
 33  #     _mailConfirmURL
 34  #     _mailArchive
 35  #
 36  #   The purpose of the first four of these keywords should be obvious.
 37  #
 38  #   The keyword '_mailConfirmURL' gives the URL of an HTML page
 39  #   confirming that a message has been sent.  If this keyword is 
 40  #   omitted, a default confirmation page will be returned.
 41  #
 42  #   The keyword '_mailArchive' is used to specify a file archive.
 43  #   For example,
 44  #
 45  #     <INPUT TYPE=HIDDEN NAME=_mailArchive VALUE="mail.txt">
 46  #
 47  #   would cause all messages processed by mailform to be archived
 48  #   in a file called "mail.txt".
 49  #
 50  #   All other keyword-value pairs are sent to the recipient specified
 51  #   in '_mailTo', after which the user is notified whether or not the 
 52  #   mailing was successful.
 53  #
 54  #############################################################################
 55  
 56  #############################################################################
 57  #  
 58  #   Initialization
 59  #
 60  #############################################################################
 61  
 62  use strict;
 63  # Import a standard set of methods from CGI.pm (see
 64  # page 187 of the Llama book for details):
 65  use CGI qw(:standard);
 66  
 67  # Jeffrey Friedl's e-mail pattern matcher (see Chapter 7 of
 68  # his book "Mastering Regular Expressions", which explains
 69  # this 6,598 byte-long regex in detail!):
 70  require "email-opt.pl";
 71  
 72  my @keywords   = ('_mailTo', 
 73                    '_mailFrom', 
 74                    '_mailSubject',
 75                    '_mailCc', 
 76                    '_mailBcc',
 77                    '_mailConfirmURL',
 78                    '_mailArchive');
 79                    
 80  my $maintainer =  'trscavo@npac.syr.edu';     # script maintainer
 81  my $sendmail   =  '/usr/lib/sendmail -t -n';  # sendmail deamon
 82  # my $sendmail   =  '/usr/bin/more';            # for debugging
 83  
 84  # Other global variables:
 85  my (
 86    $BODY,      # message body constructed by BuildBody()
 87    $ORIGIN,    # originating host of sender
 88    $MESSAGE    # error messages
 89  );
 90  
 91  #############################################################################
 92  #  
 93  #   Main routines
 94  #
 95  #############################################################################
 96  
 97  if ( param() ) {
 98    if ( ValidData() ) {
 99      GetOrigin();
100      SendData();
101    } else {
102      SendError();
103    }
104  } else {
105    PrintForm();
106  }
107  
108  #############################################################################
109  #  
110  #   Subroutines
111  #
112  #############################################################################
113  
114  # Try to determine the host of origin:
115  sub GetOrigin {
116    my ($remote_address, @subnet_numbers, $packed_address, $remote_host);
117    
118    # Convert IP address into hostname:
119    if ( defined($ENV{'REMOTE_ADDR'}) ) {
120      $remote_address = $ENV{'REMOTE_ADDR'};
121      @subnet_numbers = split(/\./, $remote_address);
122      $packed_address = pack("C4", @subnet_numbers);
123      ($remote_host) = gethostbyaddr($packed_address, 2);
124      $ORIGIN = defined($remote_host) ? $remote_host : $remote_address;
125    } else {
126      $ORIGIN = "UNKNOWN";
127    }
128    
129    return 1;
130  }
131  
132  # A boolean function that checks for valid input data:
133  sub ValidData {
134    my ( $toAddress, $fromAddress );
135    $MESSAGE = "";
136    my $isOkay = 1;
137    my $pat = $email::mailbox;           # defined in email-opt.pl
138    if ( $toAddress = param('_mailTo') ) {
139      if ( $toAddress !~ m/^$pat$/xo ) {
140        $MESSAGE .= "Invalid e-mail address: $toAddress<BR>\n";
141        $isOkay = 0;
142      }
143    } else {
144      $MESSAGE .= qq{"To:" address omitted!<BR>\n};
145      $isOkay = 0;
146    }
147    if ( $fromAddress = param('_mailFrom') ) {
148      if ( $fromAddress !~ m/^$pat$/xo ) {
149        $MESSAGE .= "Invalid e-mail address: $fromAddress<BR>\n";
150        $isOkay = 0;
151      }
152    }
153    
154    return $isOkay;
155  }
156  
157  # Invoke the mail deamon:
158  sub SendData {
159    if ( open(MAIL, "|$sendmail") ) {
160      print MAIL "To: ", param('_mailTo'), "\n";
161      print MAIL "From: ", param('_mailFrom'), "\n";
162      print MAIL "Subject: ", param('_mailSubject'), "\n";
163      print MAIL "Cc: ", param('_mailCc'), "\n";
164      print MAIL "Bcc: ", param('_mailBcc'), "\n";
165      print MAIL "X-Remote-Host: $ORIGIN\n";
166      BuildBody();
167      print MAIL "\n$BODY";
168      close(MAIL);
169      UpdateArchive() &&
170      SendConfirm();
171      return 1;
172    } else {
173      $MESSAGE = "$sendmail could not be opened!<BR>\n";
174      SendError();
175      return 0;
176    }
177  }
178  
179  # Optionally update a mail archive:
180  sub UpdateArchive {
181    if ( defined(param('_mailArchive')) ) {
182      if ( open(ARCHIVE, ">>". param('_mailArchive')) ) {
183        print ARCHIVE "Date:  " . `date`;
184        print ARCHIVE "To: ", param('_mailTo'), "\n";
185        print ARCHIVE "From: ", param('_mailFrom'), "\n" if ( defined(param('_mailFrom')) );
186        print ARCHIVE "Subject: ", param('_mailSubject'), "\n" if ( defined(param('_mailSubject')) );
187        print ARCHIVE "Cc: ", param('_mailCc'), "\n" if ( defined(param('_mailCc')) );
188        print ARCHIVE "Bcc: ", param('_mailBcc'), "\n" if ( defined(param('_mailBcc')) );
189        print ARCHIVE "X-Remote-Host: $ORIGIN\n";
190        print ARCHIVE "\n$BODY";
191        print ARCHIVE "-------------------------------------------------\n\n";
192        close(ARCHIVE);
193      } else {
194        $MESSAGE = param('_mailArchive') ." could not be opened!<BR>\n";
195        SendError();
196        return 0;
197      }
198    }
199    return 1;
200  }
201  
202  #############################################################################
203  #  
204  #   Output
205  #
206  #############################################################################
207  
208  # Print a simple HTML input form:
209  sub PrintForm {
210  
211    # Print MIME header:
212    print header(-type=>'text/html');
213    
214    # Print first few lines of the HTML document:
215    print start_html(
216            -title=>'Universal Mail Form',
217            -BGCOLOR=>'white'
218          ), "\n";
219    
220    # Print a heading:
221    print h2('Mail Form'), "\n";
222    
223    # Print <FORM> tag:
224    print start_form();
225                  
226    # Print a textfield for the recipient's address:
227    print p( "To:\n",
228             textfield(
229               -name=>'_mailTo',
230               -size=>30
231             )
232          ), "\n";
233          
234    # Print a textfield for the sender's address:
235    print p( "From:\n",
236             textfield(
237               -name=>'_mailFrom',
238               -size=>30
239             )
240          ), "\n";
241          
242    # Print a textfield for the subject:
243    print p( "Subject:\n",
244             textfield(
245               -name=>'_mailSubject',
246               -size=>30
247             )
248          ), "\n";
249          
250    # Print a textarea for e-mail message:
251    print "Type your message:\n";
252    print p( textarea(
253               -name=>'message',
254               -rows=>10, 
255               -columns=>60
256             )
257          ), "\n";
258    
259    # Print submit and reset buttons:
260    print p( submit('Send'), 
261             reset('Erase') 
262          ), "\n";
263    
264    # Print </FORM>:
265    print end_form(), "\n";
266    
267    # Print last few lines of HTML document:
268    print end_html(), "\n";
269  
270  }
271  
272  # Redirect the browser to a confirmation page or print a
273  # default confirmation page:
274  sub SendConfirm {
275    if ( defined(param('_mailConfirmURL')) ) {
276      print redirect(param('_mailConfirmURL'));
277      return 1;
278    }
279    
280    # Print MIME header:
281    print header(-type=>'text/html');
282    
283    # Print first few lines of the HTML document:
284    print start_html(
285            -title=>'Mail Form Confirmation Notice',
286            -BGCOLOR=>'white'
287          ), "\n";
288    
289    # Print a heading:
290    print h1('Mail Form Notice!'), "\n";
291    
292    # Print HTML body:
293    print 'Your message has been sent to', "\n";
294    print p( param('_mailTo') ), "\n";
295    print 'Thank you for using mailform!', "\n";
296    
297    # Print last few lines of HTML document:
298    print end_html(), "\n";
299    
300    return 1;
301  }
302  
303  # Print an error page:
304  sub SendError {
305    # Print MIME header:
306    print header(-type=>'text/html');
307    
308    # Print first few lines of the HTML document:
309    print start_html(
310            -title=>'Mail Form Error Notice',
311            -BGCOLOR=>'white'
312          ), "\n";
313    
314    # Print a heading:
315    print h1('Mail Form Error!'), "\n";
316    
317    # Print HTML body:
318    print p( $MESSAGE ), "\n";
319    print 'Please contact', "\n";
320    print "<A HREF=\"mailto:$maintainer\">the maintainer of this script</A>.\n";
321    
322    # Print last few lines of HTML document:
323    print end_html(), "\n";
324  
325    return 1;
326  }
327  
328  #############################################################################
329  #  
330  #   Utilities
331  #
332  #############################################################################
333  
334  # Construct mail message body:
335  sub BuildBody {
336    my $val;
337    $BODY = "";
338    foreach ( param() ) {
339      if ( ! IsSpecial($_) ) {
340        $val = param($_);
341        $BODY .= "$_: $val\n";
342      }
343    }
344  }
345  
346  # Test for array membership:
347  sub IsSpecial {
348    my ($special, $keyword);
349    
350    $special = 0;
351    foreach $keyword ( @keywords ) {
352      if ($_[0] eq $keyword) {
353        $special = 1;
354        last;
355      }
356    }
357    
358    return $special;
359  }