#!/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 <http://www.gnu.org/licenses/>.
#
# $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 <example\@example.org>$/,
    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";
}