#!/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.16 2009/12/23 00:04:08 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

use strict;
use warnings;
use CGI::Simple;
use Template;
use Authen::Captcha;
use HTML::Entities;
use MIME::Base64;

## Initialize our template and variables
my $template = Template->new( { INCLUDE_PATH => '/home/suter/web/zwitterion.org:/var/www/zwitterion.org/', EVAL_PERL => 1 } );
my %vars = (
    ## Fixed variables used in the templates
    admin            => 'webmaster@zwitterion.org',
    admin_name       => 'Zwitterion Webmaster',
    destination      => 'suter@zwitterion.org',
    destination_name => 'Mark Suter',
    data_folder      => '/tmp/.zwitterion-captcha-db',
    output_folder    => '/var/www/zwitterion.org/contacts/captchas',

    ## 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,
);

## To allow indented HERE documents for improved code readability
sub fix {
    local $_ = shift;
    s/^\s{4}//gm;
    return $_;
}

eval {

    ## Initialize CGI object and start output
    my $q = new CGI::Simple;
    print $q->header( -pragma => 'no-cache', -expires => '-1d' );

    -e $vars{data_folder} or mkdir $vars{data_folder} or die "$vars{data_folder} doesn't exist!\n";
    -e $vars{output_folder} or mkdir $vars{output_folder} or die "$vars{output_folder} doesn't exist!\n";

    ## Ready our captcha engine
    my $captcha = Authen::Captcha->new(
        data_folder   => $vars{data_folder},
        output_folder => $vars{output_folder},
        width         => 30,
        height        => 40
    ) or die;

    ## Promote any encoded versions
    foreach (qw(from subject message)) {
        if ( defined( $q->param("base64_$_") ) ) {
            $q->param($_, decode_base64( $q->param("base64_$_") ) );
        }
    }

    ## Get clean versions of our parameters
    my $count = 0;
    foreach (qw(from subject message)) {

        if ( defined( $q->param($_) ) ) {
            if ( $q->param($_) =~ $vars{$_} ) {
                $vars{$_} = 'default value';
            }
            else {
                $vars{$_} = $q->param($_);

                ## Ok, now clean-up the value safely
                $vars{$_} =~ s{[^[:space:][:print:]]+}{}gix;

                ## Record the count (zero is bad)
                $count++;
            }
        }
        else {
            $vars{$_} = 'not submitted';
        }
    }
    die "No real values given!\n" unless $count > 0;

    ## Create the encoded versions
    foreach (qw(from subject message)) {
        $vars{"base64_$_"} = encode_base64( $vars{$_} );
    }

    ## Include the source address to help track abuse.
    my $source_address = 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;
        $source_address .= "X$label: $ENV{$_}\n";
    }
    $source_address .= "\n";

    ## Construct a plain text message to email
    $vars{email} = fix <<"    EOF" ;    ## NB: four spaces
    From: $vars{admin_name} <$vars{admin}>
    To: $vars{destination_name} <$vars{destination}>
    Subject: Message from http://zwitterion.org/contacts/
    $source_address
    
    The following details are based on information submitted
    to the webform at http://zwitterion.org/contacts/
    
    From: $vars{from}
    Subject: $vars{subject}
    
    $vars{message}
    EOF

    ## Encode the message for presentation to the customer
    $vars{encoded} = HTML::Entities::encode( $vars{email} );

    ## Captcha passed?
    my $results = 0;
    if ( $q->param('code') and $q->param('md5sum') ) {
        ## Carefully get the captcha parameters
        my $md5sum = $q->param('md5sum');
        my $code   = $q->param('code');
        $md5sum =~ s{ \A ( [0-9a-z]+ ) \Z }{$1}ix or die "regex: $md5sum\n";
        $code   =~ s{ \A ( [0-9a-z]+ ) \Z }{$1}ix or die "regex: $code\n";

        ## Carefully check the captcha
        $results = $captcha->check_code( $code, $md5sum );
    }

    if ( $results == 1 ) {
        ## Send the email
        $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";

        ## Output success
        $template->process( 'contacts/success', \%vars );
    }
    else {
        ## Offer the Captcha
        ( $vars{md5sum}, $vars{code} ) = $captcha->generate_code(5);
        $vars{image} = '/contacts/captchas/' . $vars{md5sum} . '.png';
        $template->process( 'contacts/captcha', \%vars );
    }

};
if ($@) {
    $vars{error} = $@;
    $template->process( 'contacts/failure', \%vars );
}