238 lines
7.9 KiB
Perl
Executable File
238 lines
7.9 KiB
Perl
Executable File
#!/usr/bin/perl -wT
|
|
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
|
|
|
# ***** BEGIN LICENSE BLOCK *****
|
|
# Version: MPL 1.1
|
|
#
|
|
# The contents of this file are subject to the Mozilla Public License Version
|
|
# 1.1 (the "License"); you may not use this file except in compliance with
|
|
# the License. You may obtain a copy of the License at
|
|
# http://www.mozilla.org/MPL/
|
|
#
|
|
# Software distributed under the License is distributed on an "AS IS" basis,
|
|
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
# for the specific language governing rights and limitations under the
|
|
# License.
|
|
#
|
|
# The Original Code is the Hendrix Feedback System.
|
|
#
|
|
# The Initial Developer of the Original Code is
|
|
# Gervase Markham.
|
|
# Portions created by the Initial Developer are Copyright (C) 2004
|
|
# the Initial Developer. All Rights Reserved.
|
|
#
|
|
# Contributor(s): Reed Loden <reed@reedloden.com>
|
|
#
|
|
# The Initial Developer wrote this software to the Glory of God.
|
|
# ***** END LICENSE BLOCK *****
|
|
|
|
use strict;
|
|
|
|
# This application requires installation of the "Email::Send" (note: not
|
|
# Mail::Send) module.
|
|
use Template;
|
|
use CGI;
|
|
use Email::Send;
|
|
use Net::RBLClient;
|
|
use Captcha::reCAPTCHA;
|
|
|
|
# use CGI::Carp qw(fatalsToBrowser);
|
|
|
|
# If you are using Hendrix on your site, you'll need new API keys.
|
|
# Get them at http://recaptcha.net/api/getkey . If these variables contain
|
|
# keys, they won't work for you anyway.
|
|
my $RECAPTCHA_PUBLIC = "6LckBgMAAAAAAHlkAGWVrdc3gorusTVlLjixmeFh";
|
|
my $RECAPTCHA_PRIVATE = "6LckBgMAAAAAACSa3zXC9K3_TU2KaDsLyt9UXSW2";
|
|
|
|
# Map products to destination
|
|
# When updating these two lists, don't forget the browser detection code in
|
|
# index.html.tmpl.
|
|
my %product_destination_map = (
|
|
"Firefox" => "mozilla.feedback.firefox",
|
|
"Firefox Release Candidate" => "mozilla.feedback.firefox.prerelease",
|
|
"Firefox (Mobile)" => "mozilla.feedback.firefox.mobile",
|
|
"Firefox (Mobile) Release Candidate" =>
|
|
"mozilla.feedback.firefox.mobile.prerelease",
|
|
"Leibnitz" => "mozilla.feedback.firefox.prerelease",
|
|
"Minefield" => "mozilla.feedback",
|
|
"Fennec" => "mozilla.feedback",
|
|
"Shredder" => "mozilla.feedback",
|
|
"SeaMonkey" => "mozilla.feedback",
|
|
"Sunbird" => "mozilla.feedback",
|
|
"Camino" => "caminofeedback\@mozilla.org",
|
|
"eBay Companion" => "mozilla.feedback.companion.ebay",
|
|
"Developer Center" => "mozilla.dev.mdc.feedback",
|
|
"Other" => "mozilla.feedback"
|
|
);
|
|
|
|
# List of products to show on the main Hendrix page (in order)
|
|
my @products_list = (
|
|
"Firefox", "Firefox Release Candidate",
|
|
"Firefox (Mobile)", "Firefox (Mobile) Release Candidate",
|
|
"Minefield", "Fennec",
|
|
"Camino", "SeaMonkey", "Sunbird",
|
|
"Developer Center", "Other"
|
|
);
|
|
|
|
# The default newsgroup if the product isn't in the above map (NNTP only)
|
|
my $default_newsgroup = $::ENV{'HENDRIX_NEWSGROUP'} || "mozilla.feedback";
|
|
|
|
# The news (NNTP) server to use for posting
|
|
my $nntp_server = $::ENV{'HENDRIX_NNTP_SERVER'} || "news.mozilla.org";
|
|
|
|
# The default sender to use if no e-mail address is provided
|
|
my $default_sender = $::ENV{'HENDRIX_SENDER'} || "hendrix-no-reply\@mozilla.org";
|
|
|
|
# The mail (SMTP) server to use for posting
|
|
my $smtp_server = $::ENV{'HENDRIX_SMTP_SERVER'} || "smtp.mozilla.org";
|
|
|
|
# The CSS file to include in the template
|
|
my $skin = $::ENV{'HENDRIX_SKIN'} || "skin/planet.css";
|
|
|
|
# The DNS blacklists by which to check sender IP addresses
|
|
my $rbl = Net::RBLClient->new(
|
|
lists => [
|
|
'dnsbl.ahbl.org',
|
|
'http.dnsbl.sorbs.net',
|
|
'socks.dnsbl.sorbs.net',
|
|
'misc.dnsbl.sorbs.net',
|
|
],
|
|
query_txt => 1
|
|
);
|
|
|
|
my $cgi = new CGI;
|
|
my $form = $cgi->Vars;
|
|
my $vars;
|
|
$vars->{'form'} = $form;
|
|
$vars->{'products'} = \@products_list;
|
|
$vars->{'default_product'} = $form->{'product'};
|
|
$vars->{'stylesheet'} = $skin;
|
|
$vars->{'referer'} = $::ENV{'HTTP_REFERER'};
|
|
$vars->{'recaptcha_public_key'} = $RECAPTCHA_PUBLIC;
|
|
|
|
my $template = Template->new({
|
|
INCLUDE_PATH => ["template"],
|
|
PRE_CHOMP => 1,
|
|
TRIM => 1,
|
|
FILTERS => {
|
|
email => \&emailFilter,
|
|
remove_newlines => \&removeNewlinesFilter,
|
|
},
|
|
}) || die("Template creation failed.\n");
|
|
|
|
my $action = $cgi->param("action");
|
|
|
|
if (!$action) {
|
|
# If no action, show the submission form
|
|
print "Content-Type: text/html;charset=UTF-8\n\n";
|
|
$template->process("index.html.tmpl", $vars)
|
|
|| die("Template process failed: " . $template->error() . "\n");
|
|
}
|
|
elsif ($action eq "submit") {
|
|
# Check the poster's IP against some blacklists
|
|
my $remote_addr = $::ENV{REMOTE_ADDR};
|
|
|
|
# RBL can't cope with IPv6 and this interacts badly with my dev box...
|
|
$remote_addr = "127.0.0.1" if $remote_addr eq "::1";
|
|
|
|
$rbl->lookup($remote_addr);
|
|
my %rbl_results = $rbl->txt_hash();
|
|
if (scalar(keys %rbl_results) > 0) {
|
|
$vars->{'rbl_results'} = \%rbl_results;
|
|
throwError("rbl_hit");
|
|
}
|
|
|
|
# Check the CAPTCHA
|
|
# throwError("captcha_error");
|
|
# XXX Currently we allow posting if CAPTCHA is not present. This is
|
|
# a temporary measure so we don't have to have a flag day to update
|
|
# all the different places which feed into Hendrix. We can then come
|
|
# back and change this to throw an error for a bogus CAPTCHA.
|
|
if ($form->{'recaptcha_response_field'} ||
|
|
$form->{'recaptcha_challenge_field'})
|
|
{
|
|
my $c = Captcha::reCAPTCHA->new;
|
|
|
|
my $result = $c->check_answer($RECAPTCHA_PRIVATE,
|
|
$ENV{'REMOTE_ADDR'},
|
|
$form->{'recaptcha_challenge_field'},
|
|
$form->{'recaptcha_response_field'});
|
|
|
|
if (!$result->{is_valid}) {
|
|
throwError("captcha_error", $result->{error});
|
|
}
|
|
}
|
|
|
|
# Format the parameters and send to the newsgroup.
|
|
|
|
# Check for compulsory parameters
|
|
if (!$form->{'subject'} || !$form->{'product'}) {
|
|
throwError("bad_parameters");
|
|
}
|
|
|
|
$vars->{'destination'} = $product_destination_map{$form->{'product'}} || $default_newsgroup;
|
|
$vars->{'method'} = $vars->{'destination'} =~ /@/ ? "SMTP" : "NNTP";
|
|
$vars->{'email'} = $form->{'email'} =~ /d:^[\w\.\+\-=]+@[\w\.\-]+\.[\w\-]+$:/ ? $form->{'email'} : $default_sender;
|
|
|
|
my $message;
|
|
my $headers;
|
|
|
|
$template->process("message-headers.txt.tmpl", $vars, \$headers)
|
|
|| die("Template process failed: " . $template->error() . "\n");
|
|
$template->process("message.txt.tmpl", $vars, \$message)
|
|
|| die("Template process failed: " . $template->error() . "\n");
|
|
|
|
# Post formatted message to newsgroup/email
|
|
my $theMsg = Email::Simple->new($headers . "\n\n" . $message);
|
|
my $sender = Email::Send->new({
|
|
mailer => $vars->{'method'},
|
|
mailer_args => [ Host => $vars->{'method'} eq "SMTP" ? $smtp_server : $nntp_server ],
|
|
});
|
|
my $success = $sender->send($theMsg);
|
|
|
|
# Give user feedback on success/failure
|
|
throwError("cant_post") if (!$success);
|
|
|
|
$vars->{'headers'} = $headers;
|
|
$vars->{'message'} = $message;
|
|
|
|
print "Content-Type: text/html;charset=UTF-8\n\n";
|
|
$template->process("submit-successful.html.tmpl", $vars)
|
|
|| die("Template process failed: " . $template->error() . "\n");
|
|
}
|
|
else {
|
|
die("Unknown action $action\n");
|
|
}
|
|
|
|
exit;
|
|
|
|
# Simple email obfuscation
|
|
sub emailFilter {
|
|
my ($var) = @_;
|
|
$var =~ s/\@/at/;
|
|
$var =~ s/\./dot/g;
|
|
return $var;
|
|
}
|
|
|
|
# Remove newlines and replace them with spaces
|
|
sub removeNewlinesFilter {
|
|
my ($var) = @_;
|
|
$var =~ s/\r\n/ /g;
|
|
$var =~ s/\n\r/ /g;
|
|
$var =~ s/\r/ /g;
|
|
$var =~ s/\n/ /g;
|
|
return $var;
|
|
}
|
|
|
|
sub throwError {
|
|
my ($error, $info) = @_;
|
|
$vars->{'error'} = $error;
|
|
$vars->{'info'} = $info || "";
|
|
|
|
print "Content-Type: text/html;charset=UTF-8\n\n";
|
|
$template->process("error.html.tmpl", $vars)
|
|
|| die("Template process failed: " . $template->error() . "\n");
|
|
|
|
exit;
|
|
}
|