#!/usr/local/bin/perl

# $Id: send_feedback,v 1.38 2007/01/17 22:38:14 kclark Exp $

use strict;
use warnings;
use Apache::Request;
use CGI;
use Email::Valid;
use Gramene::Page;
use HTML::LinkExtractor;
use Mail::Sendmail;
use Mail::SpamAssassin;
use Readonly;
use Template;
use Authen::Captcha;

my $cfile  = Gramene::Config->new;

Readonly my $CONFIRM_FORM          => 'confirm.tmpl';
Readonly my $DOUBLE_NEWLINE        => "\n\n";
Readonly my $FEEDBACK_FROM         => 'feedback_submission@%s.gramene.org';
Readonly my $FEEDBACK_FROM_SPAMMER => 'possible_feedback@%s.gramene.org';
Readonly my $INPUT_FORM            => 'input-form.tmpl';
Readonly my $MAX_URLS              => 5;
Readonly my $RECIPIENTS            => 'gramene-dev@gramene.org';

Readonly my $CAPTCHA_DATA_FOLDER   => '/tmp';
Readonly my $CAPTCHA_OUTPUT_FOLDER => $cfile->get('feedback')->{'captcha_dir'};

#fnar. It's one or more elements.
Readonly my @TRUSTED_IPS            =>
	ref $cfile->get('feedback')->{'trusted_ip'} eq 'ARRAY'
		? @{ $cfile->get('feedback')->{'trusted_ip'} }
		: $cfile->get('feedback')->{'trusted_ip'};

my $q = CGI->new;

my ( $t, $page, $html, %template_args, $template );

# our captcha object, used to validate any guesses that came in,
# and create any new codes
my $captcha = Authen::Captcha->new(
    data_folder   => $CAPTCHA_DATA_FOLDER,
    output_folder => $CAPTCHA_OUTPUT_FOLDER,
    #'debug'      => 2,
);

# assume that the number of trusted IPs will be small, so just iterate
# over the array. Do a regex so we can trust entire domains
my $is_trusted_ip = 0;
foreach my $ip (@TRUSTED_IPS) {
	if ($ENV{'REMOTE_ADDR'} =~ /^$ip$/) {
		$is_trusted_ip = 1;
		last;
	}
}

eval {
    my $config = $cfile->get('feedback');
    $page      = Gramene::Page->new( Apache->request );
    $t         = Template->new( 
        INCLUDE_PATH => [
            $config->{'template_dir'},
        ],
        WRAPPER      => 'wrapper.tmpl',
        VARIABLES    => {
            cgi           => $q,
            gramene_page  => $page,
        },
    );

    my $refer_to = $q->param('refer_to') || $q->param('refer_to_url') || '';

    if ( !$refer_to ) {
        if ( $q->param('refer_from') ) {
            $refer_to = $q->unescape( $q->url( -relative => 1, -query => 1 ) );
            $refer_to =~ s/\Qsend_feedback?refer_from=//;
        }
        elsif ( $refer_to = Apache->request->header_in('referer') ) {
            # Make it uniform, just in case:
            $refer_to =~ s{ \A http:// \w+ \. gramene \. org }{}x;
        }
        else {
            $refer_to = $q->url;
        }
    }

    %template_args = ( referrer => $refer_to );

    if ( $q->param('send_feedback') ) {
        my @errors;

        for my $field ( qw[ subject name organization email ] ) {
            my $val = $q->param( $field );
            if ( $val =~ /[\r\n]|(\\[rn])/ ) {
                push @errors, "Field $field '$val' looks like a spam attack."
            }
        }

        my $user_name      = $q->param('name')         || '';
        my $org            = $q->param('organization') || '';
        my $user_email     = $q->param('email')
                or push @errors, 'No email address';
        my $comments       = $q->param('comments')
                or push @errors, 'No comments';
        my $captcha_guess  = $q->param('captcha')
                or push @errors, 'No text for image';
        my $captcha_md5sum = $q->param('md5sum')
                or push @errors, 'Internal CAPTCHA error. Please try again.';

        if ( $user_email &&
             !Email::Valid->address( -address => $user_email, -mxcheck=> 1 ) 
        ) {
            push @errors, "Invalid email address '$user_email'";
        }

        # if they guessed something, and it doesn't match, then toss an error
        # if there was no guess, we've already noted that they didn't give us
        # one up above.
        if (! $is_trusted_ip && 
        	$captcha_guess &&
            $captcha->check_code($captcha_guess, $captcha_md5sum) != 1) {
            push @errors, 'Typed text does not match image. Please try again.';
        }

        if ( @errors ) {
            die join("<br>\n", @errors, '');
        }

        my $lx           = HTML::LinkExtractor->new;
        $lx->parse( \$comments );
        my $base_url     = $q->url( -base => 1 );
        my $is_dev       = $base_url =~ /www\.gramene\.org/ 
                           ? 'Live' : 'Development';
        my $subject      = sprintf "Gramene %s Site Feedback: %s", 
            $is_dev ? 'Development' : 'Live',
            $q->param('subject') || 'No subject',
        ;
        my $user         = sprintf '%s%s%s', 
            $user_name   ? $user_name : '',
            $org         ? " [$org]"  : '',
            " <$user_email>"
        ;
        my $full_url     = sprintf '%s%s%s', 
            $base_url, $refer_to =~ m{^/} ? '' : '/', $refer_to,
        ;
        $comments .= "\n\nSubmitted by ". $q->user_agent 
                  .  ' from ' . $q->remote_host;
        my $num_links    = scalar @{ $lx->links };
        my $spamtest     = Mail::SpamAssassin->new;
        my $mail         = $spamtest->parse( $comments );
        my $status       = $spamtest->check( $mail );
        my $is_spam      = $status->is_spam;
        if ( !$is_spam ) {
            if ( 
                   ( $num_links > $MAX_URLS )
                || ( $user_name eq $user_email && $user_email eq $org )
                || ( $subject =~ /@/ )
                || ( $full_url =~ /@/ )
            ) {
                $is_spam = 1;
            }
        }
        my $from_tmpl    = $is_spam ? $FEEDBACK_FROM : $FEEDBACK_FROM_SPAMMER;
        my $from_address = sprintf $from_tmpl, $is_dev ? 'dev' : 'www';

        my $message = join $DOUBLE_NEWLINE,
            "URL         : $full_url",
            "Subject     : $subject",
            "Name        : $user_name",
            "Email       : $user_email",
            "Organization: $org",
            'Comments    : ',
            $comments,
        ;

        my %mail_args  = (
            'Subject'  => $subject,
            'To'       => $RECIPIENTS,
            'From'     => $from_address,
            'Cc'       => $user,
            'Reply-To' => "$user_email, $RECIPIENTS",
            'Message'  => $message,
        );

        sendmail( %mail_args ) or die $Mail::Sendmail::error;

        $template      = $CONFIRM_FORM;
        %template_args = ( %mail_args, %template_args, title => 'Thank You' );
    }
    else {
        $template = $INPUT_FORM;
    }

};

#gotta do this down below so the check above succeeds
$template_args{'captcha_md5sum'} = $captcha->generate_code(6);
$template_args{'trusted_ip'} = $ENV{'REMOTE_ADDR'} if $is_trusted_ip;

#
# Error handler
#
if ( $@ ) {
    if ( $t ) {
        $template_args{'title'}   = 'Error';
        $template_args{'err_msg'} = $@;

        $t->process( $INPUT_FORM, \%template_args, \$html) 
            or $html = $t->error;
    }
    else {
        $html = $@;
    }
}
else {
    $t->process( $template, \%template_args, \$html ) or $html = $t->error;
}

print $q->header('text/html'), $html;
exit 0;

# -------------------------------------------------------

=pod

=head1 NAME

send_feedback - a CGI script for user feedback on Gramene

=head1 DESCRIPTION

This is a simple CGI script for users to submit feedback on Gramene.

I hope one day it will interact with Mantis to create a ticket.

=head1 AUTHOR

Ken Youens-Clark E<lt>kclark@cshl.eduE<gt>.

=head1 COPYRIGHT

Copyright (c) 2006 Cold Spring Harbor Laboratory

This library is free software;  you can redistribute it and/or modify 
it under the same terms as Perl itself.

=cut
