"Fossies" - the Fresh Open Source Software Archive 
Member "laspack/html/form-mail.pl" (13 Aug 1995, 3993 Bytes) of package /linux/privat/old/laspack.tgz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
1 #!/usr/local/bin/perl
2
3 # ------------------------------------------------------------
4 # Form-mail.pl, by Reuven M. Lerner (reuven@the-tech.mit.edu).
5 #
6 # Last updated: March 14, 1994
7 #
8 # Form-mail provides a mechanism by which users of a World-
9 # Wide Web browser may submit comments to the webmasters
10 # (or anyone else) at a site. It should be compatible with
11 # any CGI-compatible HTTP server.
12 #
13 # Please read the README file that came with this distribution
14 # for further details.
15 # ------------------------------------------------------------
16
17 # ------------------------------------------------------------
18 # This package is Copyright 1994 by The Tech.
19
20 # Form-mail is free software; you can redistribute it and/or modify it
21 # under the terms of the GNU General Public License as published by the
22 # Free Software Foundation; either version 2, or (at your option) any
23 # later version.
24
25 # Form-mail is distributed in the hope that it will be useful, but
26 # WITHOUT ANY WARRANTY; without even the implied warranty of
27 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
28 # General Public License for more details.
29
30 # You should have received a copy of the GNU General Public License
31 # along with Form-mail; see the file COPYING. If not, write to the Free
32 # Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
33 # ------------------------------------------------------------
34
35 # Define fairly-constants
36
37 # This should match the mail program on your system.
38 $mailprog = '/usr/lib/sendmail';
39
40 # This should be set to the username or alias that runs your
41 # WWW server.
42 $recipient = 'skalicky@msmfs1.mw.tu-dresden.de';
43
44 # Print out a content-type for HTTP/1.0 compatibility
45 print "Content-type: text/html\n\n";
46
47 # Print a title and initial heading
48 print "<Head><Title>Thank you</Title></Head>";
49 print "<Body><H1>Thank you</H1>";
50
51 # Get the input
52 read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
53
54 # Split the name-value pairs
55 @pairs = split(/&/, $buffer);
56
57 foreach $pair (@pairs)
58 {
59 ($name, $value) = split(/=/, $pair);
60
61 # Un-Webify plus signs and %-encoding
62 $value =~ tr/+/ /;
63 $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
64
65 # Stop people from using subshells to execute commands
66 # Not a big deal when using sendmail, but very important
67 # when using UCB mail (aka mailx).
68 # $value =~ s/~!/ ~!/g;
69
70 # Uncomment for debugging purposes
71 # print "Setting $name to $value<P>";
72
73 $FORM{$name} = $value;
74 }
75
76 # If the comments are blank, then give a "blank form" response
77 &blank_response unless ($FORM{'name'} && $FORM{'email'});
78
79 # Now send mail to $recipient
80
81 open (MAIL, "|$mailprog $recipient") || die "Can't open $mailprog!\n";
82 print MAIL "Reply-to: $FORM{'username'} ($FORM{'realname'})\n";
83 $subject = ($FORM{'comments'} ? "Comment: $FORM{'subject'}" :
84 "Bug Report: $FORM{'bug+short+description'}" );
85 print MAIL "Subject: $subject\n\n";
86 print MAIL "$FORM{'email'} ($FORM{'name'}) sent the following report:\n";
87 print MAIL "------------------------------------------------------------\n";
88 while (($key, $value) = each %FORM) {
89 print MAIL "[>>$key<<]:\n$value\n";
90 }
91 print MAIL "\n------------------------------------------------------------\n";
92 print MAIL "Server protocol: $ENV{'SERVER_PROTOCOL'}\n";
93 print MAIL "Remote host: $ENV{'REMOTE_HOST'}\n";
94 print MAIL "Remote IP address: $ENV{'REMOTE_ADDR'}\n";
95 close (MAIL);
96
97 # Make the person feel good for writing to us
98 # $archive = ($FORM{'comments'} ? "comment.html" : "bugs.html");
99 print "Thank you for your comments on LASPack!<P>";
100 print "Unfortunately because of the current workload it is not possible to give personal replies but your report will be processed and
101 may appear in the report archive</A>.\n";
102
103 # ------------------------------------------------------------
104 # subroutine blank_response
105 sub blank_response
106 {
107 print <<_EOF ;
108 Your name and e-mail address appear to be blank, and thus your
109 bug report was not sent. Please try again.
110 _EOF
111 exit;
112 }