#!/usr/bin/perl
# Filename:	Mail.cgi
# Author:	David Ljung Madison <DaveSource.com>
# See License:	http://MarginalHacks.com/License
# Version:	1.01
#
use strict;

umask 0022;

my $HOST = $ENV{HTTP_HOST} || $ENV{SERVER_NAME} || "GetDave.com";
$HOST="lo:3001" if $ENV{PWD} eq "/data/proj/Mail";	# Development kludge!

my $CGI = $ENV{REQUEST_URI} || "/cgi-bin/DaVite.cgi";  # Guess if REFERER not found
   $CGI =~ s/[\&\?][^\/]+$//;

my $URL = "http://$HOST$CGI";

# Theme directory (absolute filesystem path, *not* a URL)
my $THEME_DIR =	"/WWW/cgi-bin/Mail.Themes";

# Theme.  Does %substitution if desired.  If file not found, use Default
# Example:		http://Bob.GetDave.com/Mail.cgi
# %s -> subdomain	Bob
# %d -> domain		GetDave.com
# %h -> host		Bob.GetDave.com
# %c -> CGI		Mail
#
my $THEME =	"%h";

# Now create files: (To, Header, Footer) in $THEME_DIR/$THEME/
# Header and Footer contain exactly what you would expect.
# 'To' contains the destination and an optional name.  It is of the format:
# <email address>
# <name>
# You can also create a file 'sig' to use as a signature.

#########################
# Where is sendmail? (forge_pipe is best!)
#########################
my $SENDMAIL	= "/usr/local/sbin/forge_pipe";  # See http://MarginalHacks.com/#forge
   $SENDMAIL	= "/usr/bin/forge_pipe" unless -x $SENDMAIL;
   $SENDMAIL	= "/usr/sbin/forge_pipe" unless -x $SENDMAIL;
   $SENDMAIL	= "/usr/sbin/sendmail" unless -x $SENDMAIL;
   $SENDMAIL	= "/usr/lib/sendmail" unless -x $SENDMAIL;
   $SENDMAIL	= "/usr/bin/sendmail" unless -x $SENDMAIL;

# Do we wrap the $SENDMAIL call in sudo?
# Requires an entry in /etc/sudoers:
#   <webuser> <hostname> = NOPASSWD: <path_to_sendmail>
# For example:
#   apache  getdave = NOPASSWD: /usr/local/sbin/forge_pipe
my $USE_SUDO	= 0;

# And where is sudo?
my $SUDO	= "/usr/bin/sudo";
   $USE_SUDO	= 0 unless -x $SUDO;

##################################################
# Query
##################################################
sub from_url($) {
  my ($str) = @_;
  $str =~ s/\+/ /g;
  $str =~ s/%([0-9a-f]{2})/chr(hex($1))/eig;
  $str;
}

sub to_url($) {
  my ($str) = @_;
  $str =~ s/([^ a-zA-Z0-9\.])/"%".sprintf("%0.2x",ord($1))/eg;
  $str =~ s/ /+/g;
  $str;
}

sub parse_query {
  # Get query
  my $query_string;
  if ($ENV{REQUEST_METHOD} eq "POST") {
    read(STDIN,$query_string,$ENV{CONTENT_LENGTH});
  } elsif ($ENV{QUERY_STRING}) {
    $query_string = $ENV{QUERY_STRING};
  }
  chomp($query_string);

  # Split query
  # $query_string is of the form:  "variable=value&var2=val2&.."
  my @querys=split(/[\&\?]/,$query_string);
  my (%query,$var,$val);
  foreach my $str (@querys) {
    $var = $str if (!(($var,$val) = ($str =~ /([^=]*)=(.*)/)));
    $val = 1 unless defined $val;
    $query{$var} = from_url($val) unless $var eq "RAW";
    $query{RAW}{$var} = $val;
  }

#header(1); show_values(\%query);
  \%query;
}

sub show_values {
  my ($query) = @_;
  header();
  print "<p><hr><p>\n\n";
  foreach my $q ( keys %$query ) {
    print "yo $q -> $query->{$q}<br>\n";
  }
}

##################################################
# HTML
##################################################
my $DID_HEADER=0;
sub header {
  my ($theme) = @_;

  return if $DID_HEADER++;
  print <<HEADER;
Content-type: text/html

$theme->{Header}
HEADER
}

sub ERROR { header(); print "<h2>ERROR: @_</h2>\n"; undef; }
sub FATAL { header($_[1]); print "<h2>ERROR: $_[0]</h2>\n"; footer($_[1]); exit(0); }
sub footer {
  my ($theme) = @_;
  my $foot = $theme->{Footer};
  $foot .= "</body>\n</html>\n" unless $foot =~ m|</body|;
  my $me = $CGI; $me =~ s|.*/||;
  my $note = <<NOTE;
<p>
<center>
<a href='http://MarginalHacks.com/'>$me</a>
by <a href='http://GetDave.com/'>Dave's</a>
<a href='http://MarginalHacks.com/'>Marginal Hacks</a>
</center>
NOTE
  $foot =~ s|</body|$note</body|;

  return unless $DID_HEADER;
  print <<GOBBLE_FOOTER;
$foot
GOBBLE_FOOTER
}

# Send mail
sub send_mail {
  my ($to,$cc,$subject,$from,$from_full,$msg) = @_;

  my $sendmail = $USE_SUDO ? "$SUDO $SENDMAIL" : $SENDMAIL;
  return ERROR("Can't open sendmail pipe!")
    unless open(MAIL,"|$sendmail -i -f $from -F \"$from_full\" $to");

  $to.="\nCc: $cc" if $cc && $cc ne $to;

  print MAIL <<MAIL_MESSAGE;
From: "$from_full" <$from>
Subject: $subject
To: $to
X-Mailer: $URL

$msg

MAIL_MESSAGE
  close MAIL;

  return 1;
}

##################################################
# Theme code
##################################################
sub slurp($) {
  my ($file) = @_;
  open(SLURP,"<$file") || return "";
  my @c = <SLURP>;
  close SLURP;
  wantarray ? @c : join("",@c);
}

sub get_theme() {
  my %theme;

  (-d $THEME_DIR) || FATAL("Can't read theme directory!");

  my $theme = $THEME;
  my ($sub,$dom) = ($HOST=~/((.*)\.)?([^\.]+\.[^\.]+)/) ? ($2,$3) : ("",$HOST);
  my $cgi = $CGI;
  $cgi =~ s|.*/||g;
  $cgi =~ s|\.cgi||g;
  $theme =~ s/%s/$sub/g;
  $theme =~ s/%d/$dom/g;
  $theme =~ s/%h/$HOST/g;
  $theme =~ s/%c/$cgi/g;
  my $save = $theme;

  (-d "$THEME_DIR/$theme") || ($theme="Default");
  (-d "$THEME_DIR/$theme") || FATAL("Couldn't find theme or default [$THEME_DIR/$save]!");

  foreach my $slurp ( qw(Header Footer To sig) ) {
    $theme{$slurp} = slurp "$THEME_DIR/$theme/$slurp";
  }
  my @to = split(/\n/,$theme{To});
  $theme{to_mail} = $to[0];
  $theme{to_name} = $to[1] || $to[0];

  $theme{sig} = $theme{sig} || <<SIG;
---------------------------------------------------------------------------
This was delivered by the Mail CGI script running at
  http://$HOST
If you did not request this email, please ignore it, or visit
  $HOST and contact the site admin.
Script created by http://MarginalHacks.com/
---------------------------------------------------------------------------
SIG

  header(\%theme);

  \%theme;
}

##################################################
# Queries
##################################################
sub mail_form {
  my ($query,$theme) = @_;

  my $from = $query->{from};

  my $subject = $query->{subject};
  $subject =~ s/"/&quot;/g;
  my $message = $query->{message};
  $message =~ s|</textarea|&lt;/textarea|g;

  print <<MAIL_FORM;
<p>
<form action='$URL' method='POST' name='mail_form'>
  <table>
    <tr>
      <td>From:</td>
      <td><input type='text' name='from' size='40' value="$query->{from}"></td>
    </tr>
    <tr>
      <td>To:</td>
      <td><i>$theme->{to_name}</i></td>
    </tr>
    <tr>
      <td>Subject:</td>
      <td><input type='text' name='subject' size='40' value="$query->{subject}"></td>
    </tr>
    <tr>
      <td>Message:</td>
      <td align='right'><input type='submit' name='handle_mail_form' value='Send'></td>
    </tr>
    <tr>
      <td colspan='2'>
        <input type='hidden' name='t' value='$query->{t}'>
        <input type='hidden' name='c' value='$query->{c}'>
        <input type='hidden' name='f' value='$query->{f}'>
        <input type='hidden' name='n' value='$query->{n}'>
        <textarea name='message' rows='10' cols='70' wrap='soft'>$message</textarea>
      </td>
    </tr>
    <tr>
      <td colspan='2' align='right'><input type='submit' name='handle_mail_form' value='Send'></td>
    </tr>
  </table>
</form>
MAIL_FORM
}

sub handle_mail {
  my ($query,$theme) = @_;

  # Avoid long emails that can be used to figure out the key
  my $from = $query->{from};
  $from =~ s/^\s+//;  $from =~ s/\s+$//;
  if ($from !~ /(\S+)\@\S+\.\S\S/) {
    ERROR("Please enter a valid email address");
    return mail_form($query,$theme);
  }

  unless ($query->{subject}) {
    ERROR("Please enter a subject");
    return mail_form($query,$theme);
  }
  unless ($query->{message}) {
    ERROR("Please enter a message");
    return mail_form($query,$theme);
  }

  my $n = "&n=".to_url $query->{n};
  send_mail($theme->{to_mail},0,"[Contact] $query->{subject}",$from,"Contact Mailer",<<MESSAGE_URL);

Email message from contact form:  $from

$query->{message}

$theme->{sig}
MESSAGE_URL

  print <<SENT_URL
<h1>Mail sent!</h1>
<p>
You have sent a mail to $theme->{to_name}
<p>
Thanks!
<p>
SENT_URL
}

##################################################
# Do it
##################################################
sub main {
  my $theme = get_theme;

  my $query = parse_query();

  if ($query->{from}) {
    handle_mail($query,$theme);
  } else {
    mail_form($query,$theme);
  }

  footer($theme);	# If we need did the default header
} main();