#!/usr/bin/perl 

# subscribe.cgi - web-to-email gateway with many possible recipients,
# based on "roles" defined in a text file

# copyright (c) 2002 Prescient Code Solutions.  All rights reserved.
# Please do not redistribute without permission.
# contact daniel@coder.com

#use strict;

require 'cgi-lib.pl';

# configuration
my $formfile = 'newsletter-form.html';
my $outputURL = 'http://flgbtqc.quaker.org/newsletter/thanks.html';

my $databasefile = "subscriptions/download.csv";
my $roleDB = '../email-roles.txt';
my $rolename = 'Newsletter_subscriptions';
my $sendmail = '/usr/sbin/sendmail';

my $debug = 0;
print &header if $debug;

sub error {
    my $message = shift;
    print &header;
    print "Error: $message\n<p>Please use the \"back\" button on your browser and try again."; 
    exit;
}

# three lazy fixes for CGI.pm -> cgi-lib

sub header {
	&PrintHeader;
}

sub param {
	my $var = shift;
	return $in{$var};
}

sub referer {
	return $ENV{'HTTP_REFERER'};
}

sub remote_host {
	
	return $ENV{'REMOTE_HOST'} || lookup($ENV{'REMOTE_ADDR'}) || 'localhost';
}

sub lookup {
	my $ip = shift;
	return $ip unless $ip=~/\d+\.\d+\.\d+\.\d+/;
	return $CACHE{$ip} if exists $CACHE{$ip};
	my @h = eval <<'END';
	alarm(TIMEOUT);
	my @i = gethostbyaddr(pack('C4',split('\.',$ip)),2);
	alarm(0);
	@i;
END
     $CACHE{$ip} = $h[0];
	return $CACHE{$ip} || $ip;
}


sub redirect {
	my $url = shift;
    return "Status: 302 Moved\nLocation: $url$pic\n\n";
}

&error("Can't find your sendmail: $sendmail") unless (-f $sendmail);
&error("Can't execute your sendmail: $sendmail") unless (-e $sendmail);

# parse role file into $role{$rolename} and @rolelist
# file has format: <rolename> <whitespace> <rolevalues>

open(FILE, "<$roleDB") or &error("Couldn't read role file '$roleDB'");
my @roles = <FILE>;

my %role;
my @rolelist;
my $line;

foreach $line (@roles) {
    next if (($line =~ /^\s*\#/) or ($line =~ /^\s*$/));
    chomp $line;
    $line =~ s/^(\s+)//;  # strip leading space
    my ($rolename, $rolevalue) = split /\s+/, $line, 2;

    unless ($rolename =~ /^\w+$/) {
        &error("Role name '$rolename' is invalid in file '$roleDB'");
        }
    unless ($rolevalue =~ /\w+@\w*/) {
            &error("Role value '$rolevalue' for role '$rolename' isn't 
                    an email address.");
        }

    push @rolelist, $rolename;
    $role{$rolename} = $rolevalue;
    print "$rolename = $rolevalue\n" if ($debug);
}


my %in;
&ReadParse;

unless (param('email')) {

    # parse feedback-form, replace tag (REFERER)
    # print feedback-form and exit.

    open(FORMFILE, "<$formfile") or &error("Couldn't read feedback-form '$formfile'");

    my $formcontents;
    {
	local $/=undef;
	$formcontents = <FORMFILE>;
    }

    my $referer = referer() || 'Unknown';
    $formcontents =~ s/<REFERER>/<input type="hidden" name="url" value="$referer">/;

    print header();
    print $formcontents;
    exit;
}

# feedback form has been submitted, because 'message' and 'role' are filled in.
# process contents, send email, and redirect browser to $outputURL;

&error("No role specified in inputs") unless ($rolename);
&error("Invalid role specified: ".$rolename) unless ($role{$rolename});
$roleaddress = $role{$rolename};

&error("No email address was found.") unless (param('email'));
&error("Your email address '".param('email')."' seems to be invalid.") unless
    param('email') =~ /^.+@\w+\.\w+/;
&error("Your email address didn't match the copy for verification.") unless (param('email') eq param('email2'));   
&error("New subscription or change in subscription?") unless param('new');
&error("Do you want to receive the print version?") unless param('print');  
&error("Your name or title appears to be blank.") unless (param('sendername'));
foreach (qw(phone street city state zip country)) {
    &error("Your $_ appears to be blank.") unless (param($_));
}

# &error("got " .param('url').  param('message'));
# but first, silently squelch if they've come here for spammy purposes
if (param('url') eq 'Unknown' && param('message') =~ m{http://}) {
     print redirect($outputURL);
     exit; 
    }

my $send_email = "yes";
my $send_print = "yes";

$send_email = "no" if (param('print') eq 'only'); 
$send_print = "no" if (param('print') eq 'no');

my $sender = param('email');
my $sendername = param('sendername');
my $subject = "Newsletter Subscription Update";
my $org = param('org');
my $new = param('new');
my $streetdisp = $street = param('street');
my $street2 = param('street2') || ''; 
if ($street2) { 
    $streetdisp .= "\n$street2";
}
my $city = param('city');
my $state = param('state');
my $zip =  param('zip') || 'None'; 
my $country = param('country');
my $phone = param('phone') || 'None';
my $message = param('message');
my $url = param('url') || 'Unknown';
my $host = remote_host() || 'Unknown';

# if $roleaddress has more than one address, mangle to turn , into >,<
$roleaddress=~ s/,\s*/>,</; 

my $email = "To: <$roleaddress> 
From: $sendername <$sender>
Subject: FLGBTQC Website: $subject

New?: $new
Send Print?: $send_print
Send Email?: $send_email
Zip:  $zip
Org:  $org
Phone: $phone

$name
$streetdisp
$city, $state $zip
$country

$message
-----------------------------------------------------
Webpage:     $url
Sender's IP: $host
";

my $mailexec = "$sendmail -f$sender -t";

open(MAIL,"|$mailexec") || &error("Couldn't open mail program using '$mailexec'");
print MAIL $email;

#print &header . $email;

my $dataline = qq{"$sendername","$org","$street","$street2","$city","$state","$zip","$country","$phone","$sender","$send_print","$send_email","$new"\n};

open(DATABASE,">>$databasefile") || &error("Couldn't open database file");
print DATABASE "$dataline";

print redirect($outputURL);