home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / osr5 / sco / scripts / www / comment-mail.pl next >
Encoding:
Perl Script  |  1997-08-26  |  4.9 KB  |  145 lines
  1. #!/usr/local/bin/perl -- -*-perl-*-
  2. # @(#) comment-mail.perl 1.1 96/03/16
  3.  
  4. # ------------------------------------------------------------
  5. # Form-mail.pl, by Reuven M. Lerner (reuven@the-tech.mit.edu).
  6. #
  7. # Last updated: March 14, 1994
  8. #
  9. # Form-mail provides a mechanism by which users of a World-
  10. # Wide Web browser may submit comments to the webmasters
  11. # (or anyone else) at a site.  It should be compatible with
  12. # any CGI-compatible HTTP server.
  13. # 
  14. # Please read the README file that came with this distribution
  15. # for further details.
  16. # ------------------------------------------------------------
  17. # 94/04/02 john@armory.com   Generalized a bit.
  18. # 96/02/09 john@armory.com   Fixed to deal with trailing / in PATH_INFO
  19. # 96/02/10 john@armory.com   Deal with trailing newline in hostname;
  20. #                            added processing of subject field.
  21. # 96/03/16 john@armory.com   Print a few more env vars if available.
  22.  
  23. # ------------------------------------------------------------
  24. # This package is Copyright 1994 by The Tech. 
  25.  
  26. # Form-mail is free software; you can redistribute it and/or modify it
  27. # under the terms of the GNU General Public License as published by the
  28. # Free Software Foundation; either version 2, or (at your option) any
  29. # later version.
  30.  
  31. # Form-mail is distributed in the hope that it will be useful, but
  32. # WITHOUT ANY WARRANTY; without even the implied warranty of
  33. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  34. # General Public License for more details.
  35.  
  36. # You should have received a copy of the GNU General Public License
  37. # along with Form-mail; see the file COPYING.  If not, write to the Free
  38. # Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  39. # ------------------------------------------------------------
  40.  
  41. # Define fairly-constants
  42.  
  43. # This should match the mail program on your system.
  44. #$mailprog = '/usr/lib/mail/execmail';
  45. $mailprog = '/usr/lib/sendmail';
  46. $host = `hostname`;
  47. $host =~ s/\n//g;    # get rid of trailing newline if any 
  48. # PATH_INFO will be set to /recip=username
  49. $pinfo = substr($ENV{'PATH_INFO'},7);
  50. # Get rid of trailing / if PATH_INFO was set to /recip=username/
  51. if (substr($pinfo,(length $pinfo) - 1,1) eq '/') {
  52.     $pinfo = substr($pinfo,0,(length $pinfo) - 1);
  53. }
  54. $recipient = $pinfo . '@' . $host;
  55.  
  56. # Print out a content-type for HTTP/1.0 compatibility
  57. print "Content-type: text/html\n\n";
  58.  
  59. # Print a title and initial heading
  60. print "<Head><Title>Comment Reply</Title></Head>\n";
  61.  
  62. # Get the input
  63. read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
  64.  
  65. # Split the name-value pairs
  66. @pairs = split(/&/, $buffer);
  67.  
  68. foreach $pair (@pairs)
  69. {
  70.     ($name, $value) = split(/=/, $pair);
  71.  
  72.     # Un-Webify plus signs and %-encoding
  73.     $value =~ tr/+/ /;
  74.     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  75.  
  76.     # Stop people from using subshells to execute commands
  77.     # Not a big deal when using sendmail, but very important
  78.     # when using UCB mail (aka mailx).
  79.     # $value =~ s/~!/ ~!/g; 
  80.  
  81.     # Uncomment for debugging purposes
  82.     # print "Setting $name to $value<P>";
  83.  
  84.     $FORM{$name} = $value;
  85. }
  86.  
  87. # If the comments are blank, then give a "blank form" response
  88. &blank_response unless $FORM{'comments'};
  89. &name_response unless $FORM{'name'};
  90. if ($pinfo !~ /^[-a-zA-Z0-9_.=]+$/) {
  91.     &recip_response
  92. }
  93.  
  94. # Now send mail to $recipient
  95.  
  96. open (MAIL, "|$mailprog $recipient") || die "Can't open $mailprog!\n";
  97. print MAIL "Reply-to: $FORM{'email'} ($FORM{'name'})\n";
  98. print MAIL "From: www@" . $host . "\n";
  99. print MAIL "Subject: WWW comments" . ( $FORM{'subject'} ne '' ?
  100. " re: " . $FORM{'subject'} : " (Forms submission)" ) . "\n\n";
  101. print MAIL "$FORM{'name'} ($FORM{'email'}) sent the following\n";
  102. print MAIL "comment about your WWW page:\n\n";
  103. if ($FORM{'url'}) {
  104.     print MAIL  "----------------------------------------------------------\n";
  105.     print MAIL "URL: $FORM{'url'}\n";
  106. }
  107. print MAIL  "----------------------------------------------------------\n";
  108. print MAIL "$FORM{'comments'}";
  109. print MAIL "\n----------------------------------------------------------\n";
  110. print MAIL "Server protocol: $ENV{'SERVER_PROTOCOL'}\n";
  111. if ($ENV{'REMOTE_HOST'}) {
  112.     print MAIL "Remote host: $ENV{'REMOTE_HOST'}\n";
  113. }
  114. print MAIL "Remote IP address: $ENV{'REMOTE_ADDR'}\n";
  115. if ($ENV{'HTTP_REFERER'}) {
  116.     print MAIL "Referer: $ENV{'HTTP_REFERER'}\n";
  117. }
  118. if ($ENV{'HTTP_USER_AGENT'}) {
  119.     print MAIL "Referer: $ENV{'HTTP_USER_AGENT'}\n";
  120. }
  121. close (MAIL);
  122.  
  123. print "<Body><h1>Your comments have been sent.  Thank you!</H1>\n";
  124.  
  125. sub blank_response
  126. {
  127.     print "Your comment submission appears to be blank, and thus was not sent.";
  128.     print "  Please re-enter and submit.\n";
  129.     exit;
  130. }
  131.  
  132. sub name_response
  133. {
  134.     print "Your comment did not include a name, and thus was not sent.";
  135.     print "  Please re-enter and submit.\n";
  136.     exit;
  137. }
  138.  
  139. sub recip_response
  140. {
  141.     print "The recipient ($pinfo) specified on this form is not a user on";
  142.     print "the local machine, so this form was not processed.\n";
  143.     exit;
  144. }
  145.