#!/usr/pkg/bin/perl # mesmail.cgi -- A customized Perl-based CGI email handler for Meyer # English School. # # Copyright 2011 David Meyer # # This program is based on email.cgi by Boutell.Com # http://www.boutell.com/email/ # # CHANGE LOG: # 2011/8/20 - Update output HTML output for SSI segments # 2011/8/13 - Added fields: email2 (address confirmation), antispam # (Captcha-like value) # - MES layout for error page # - Error messages translated to Japanese # - Custom errors for email2, antispam use CGI; use Jcode; use utf8; my $sendmail = "/usr/sbin/sendmail"; # A text file containing a list of valid email recipients and the web pages to # which the user should be redirected after email is sent to each, on # alternating lines. This allows one copy of the script to serve multiple # purposes without the risk that the script will be abused to send spam. # YOU MUST CREATE SUCH A TEXT FILE AND CHANGE THE NEXT LINE TO ITS # LOCATION ON THE SERVER. my $emailConfPath = "/arpa/ns/p/papa/.mesmail"; # Parse any submitted form fields and return an object we can use # to retrieve them my $query = new CGI; my $name = &veryclean($query->param('name')); my $email = &veryclean($query->param('email')); my $email2 = &veryclean($query->param('email2')); my $antispam = &veryclean($query->param('antispam')); my $recipient = &veryclean($query->param('recipient')); my $subject = &veryclean($query->param('subject')); #newlines allowed my $content = &clean($query->param('content')); #Note: subject is not mandatory, but you can easily change that if (($name eq "") || ($email eq "") || ($email2 eq "") || ($antispam eq "") || ($content eq "") || ($recipient eq "")) { &error("エラー：必須項目未記入", "前のページに戻って、すべての必須項目を記入してください。"); } if (!open(IN, "$emailConfPath")) { &error("Configuration Error", "The file $emailConfPath does not exist or cannot be " . "opened. Please read the documentation before installing " . "email.cgi."); } if ($email2 ne $email) { &error("エラー：メールアドレス確認失敗", "前のページに戻って、メールアドレスを確認してメールアドレス" . "（確認）を再入力してください。"); } if ($antispam ne "2") { &error("エラー：スパム防止失敗", "前のページに戻って、スパム防止の数字を再入力してください。"); } my $returnpage; my $ok = 0; while (1) { my $recipientc = ; $recipientc =~ s/\s+$//; if ($recipientc eq "") { last; } my $returnpagec = ; $returnpagec =~ s/\s+$//; if ($returnpagec eq "") { last; } if ($recipientc eq $recipient) { $ok = 1; $returnpage = $returnpagec; last; } } close(IN); if (!$ok) { &error("Email Rejected", "The requested destination address is not one of " . "the permitted email recipients. Please read the " . "documentation before installing email.cgi."); } # MIME-encode name, subject $name_mime = Jcode->new(\$name)->mime_encode; if ($subject) { $subject = Jcode->new(\$subject)->mime_encode; } # Open a pipe to the sendmail program open(OUT, "|$sendmail -t"); # Use the highly convenient <\n\n", 'jis'); print OUT Jcode::convert(\$content, 'jis'); close(OUT); # Now redirect to the appropriate "landing" page for this recipient. print $query->redirect($returnpage); exit 0; sub clean { # Clean up any leading and trailing whitespace # using regular expressions. my $s = shift @_; $s =~ s/^\s+//; $s =~ s/\s+$//; return $s; } sub veryclean { # Also forbid newlines by folding all internal whitespace to # single spaces. This prevents faking extra headers to cc # extra people. my $s = shift @_; $s = &clean($s); $s =~ s/\s+$/ /g; return $s; } sub error { # Output a valid HTML page as an error message my($title, $content) = @_; print $query->header(-charset=>'utf-8'); print "\n"; open(HEAD, ") { print "$_"; } close HEAD; open(NAV, ") { print "$_"; } close NAV; print <

$title

A-B-C

$content

END ; open(FOOT, ") { if ($_ =~ //) { open(INC, "<$1") or die "Can't open file $1"; while ($inc = ) { print $inc; } close INC; } else { print "$_"; } } close FOOT; exit 0; }