#!/usr/bin/perl
#
# Send is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
#
# $Id: send,v 1.19 2019/09/04 10:13:18 suter Exp $
# [MJS 17 Oct 2002] Simple and safe web form for /contacts/
# [MJS 21 Sep 2009] Added Authen::Captcha and cleaned up a little
# [MJS 25 Jul 2019] Switch to version 3 of Google's reCAPTCHA
use strict;
use warnings;
use CGI::Simple;
use File::Slurp;
use HTML::Entities;
use MIME::Base64;
use JSON;
use Template;
use WWW::Mechanize;
our $VERSION = '20190725';
our $NAME = 'send';
my $tt = Template->new(
{ INCLUDE_PATH => '/home/suter/web/zwitterion.org:/var/www/zwitterion.org',
EVAL_PERL => 1
}
) or die $Template::ERROR, "\n";
my %vars = (
## Fixed variables used in the templates.
admin => 'webmaster@zwitterion.org',
admin_name => 'Zwitterion Webmaster',
destination => 'suter@zwitterion.org',
destination_name => 'Mark Suter',
## Defaults from the form (regex to detect unchanged submissions).
from => qr/^example $/,
subject => qr/^I do not spam$/,
message => qr/^Your source.+will be displayed\.$/ms,
);
## fix allows indented HERE documents for readability.
sub fix {
local $_ = shift;
s/^\s{4}//gm;
return $_;
}
## https://www.google.com/recaptcha/admin
sub recaptcha_secret {
my $key = read_file('/home/suter/.google-recaptcha-v3-secret-key');
chomp($key);
return $key;
}
## Returns the reCAPTCHA response.
## https://developers.google.com/recaptcha/docs/v3
sub check_captcha {
my ( $resp, $ip ) = @_;
my $mech = WWW::Mechanize->new( autocheck => 0, timeout => 10 );
$mech->agent( "$NAME/$VERSION " . $mech->agent );
$mech->post(
'https://www.google.com/recaptcha/api/siteverify',
{ secret => recaptcha_secret(),
response => $resp,
remoteip => $ip,
}
);
if ( 200 == $mech->status() ) {
my $ans = decode_json( $mech->content );
if ( exists $ans->{'success'} ) {
return $ans;
}
}
return { 'success' => 0 };
}
eval {
my $q = new CGI::Simple;
print $q->header( -pragma => 'no-cache', -expires => '-1d' );
## Promote any encoded versions.
foreach (qw(from subject message)) {
if ( defined( $q->param("base64_$_") ) ) {
$q->param( $_, decode_base64( $q->param("base64_$_") ) );
}
}
my $count = 0;
foreach (qw(from subject message)) {
if ( not defined( $q->param($_) ) ) {
$vars{$_} = 'not submitted';
next;
}
if ( $q->param($_) =~ $vars{$_} ) {
$vars{$_} = 'default value';
next;
}
$vars{$_} = $q->param($_);
$vars{$_} =~ s{[^[:space:][:print:]]+}{}gix;
$count++;
}
if ( $count == 0 ) {
die "No real values given - please fill in the form!\n";
}
foreach (qw(from subject message)) {
$vars{"base64_$_"} = encode_base64( $vars{$_} ); # for later promotion
}
my $meta = check_captcha( $q->param('g-recaptcha-response'), $q->remote_addr() );
my $abuse_info = q{};
foreach (qw(HTTP_USER_AGENT REMOTE_ADDR HTTP_X_FORWARDED_FOR HTTP_VIA)) {
exists( $ENV{$_} ) or next;
my $label = '_' . lc $_;
$label =~ s/_(.)/'-' . uc $1/ge;
$abuse_info .= "X$label: $ENV{$_}\n";
}
if ( exists $meta->{'score'} ) {
$abuse_info .= "X-Recaptcha-Score: $meta->{'score'}\n";
$abuse_info .= "X-Recaptcha-Timestamp: $meta->{'challenge_ts'}\n";
}
$abuse_info .= "\n";
$vars{email} = fix <<" EOF" ; ## NB: four spaces
From: $vars{admin_name} <$vars{admin}>
To: $vars{destination_name} <$vars{destination}>
Subject: Message from https://zwitterion.org/contacts/
$abuse_info
The following details are based on information submitted
to the webform at https://zwitterion.org/contacts/
From: $vars{from}
Subject: $vars{subject}
$vars{message}
EOF
$vars{encoded} = HTML::Entities::encode( $vars{email} );
if ( $meta->{'success'} != 1 ) {
$tt->process( 'contacts/captcha', \%vars ) or die $tt->error(), "\n";
return;
}
$ENV{PATH} = '/bin:/usr/bin';
open MAIL, "| /usr/sbin/sendmail -oi -oem -t -f $vars{admin}"
or die "There was a problem forking the mailer!\n";
print MAIL $vars{email}, "\n";
close MAIL or die "There was a problem with sending the mail.\n";
$tt->process( 'contacts/success', \%vars ) or die $tt->error(), "\n";
};
if ($@) {
$vars{error} = $@;
$tt->process( 'contacts/failure', \%vars ) or die $tt->error(), "\n";
}