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=""Tom Scavo" <trscavo@syr.edu>"> 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 }