#!/usr/bin/perl
# Murty's Web Mailer version 1.0   Date: 9/30/2001
# (c) Murty Rompalli     All rights reserved
 
# NOTE: Put this file in /cgi-bin/ directory of your website.
 
use CGI qw(:standard) ;
use Net::SMTP ;
use Net::DNS ;

@allowedto = ( 'joe@yourdomain.com' , 'jane@abcd.net' ) ;
@blockedfrom = ( 'spammer@spam.com' , 'junk@junk.com' ) ;

$debug = 0 ;

$|++ ;
open(STDERR, ">&STDOUT") ; 

$url = url() ;
print header,start_html;

sub dien ;
dien "Error: Bad Usage" unless param('to') ;

$from = param('from') ;
$to = param('to') ;
($todomain) = $to =~ /.+\@(.+)/ ;

if (param('from')) {
   
     $from = param('from') ;
     $body = param('body') ; $body = ' ' unless "$body" ;
     $subject = param('subject') ; $subject = ' ' unless "$subject" ;

     &showinput ;
     &process ;
     print b('Success unless you see any errors above') ;
}
else {
   &putform ;
}

print end_html ;

########################### Begin Functions

# Get all mx records. Note, if A record exists,try them too after mx values.

sub getmx {

my $name = $_[0] ;
my $res = new Net::DNS::Resolver;
my @mx = mx($res, $name);
my $query = $res->search($name);

my @mxlist ;

if (@mx) {
   foreach $rr (@mx) {
       @mxlist = (@mxlist,$rr->exchange) ;
   }
}

if ($query) {
   foreach $rr ($query->answer) {
       next unless $rr->type eq "A";
       @mxlist = (@mxlist,$rr->address) ;
   }
}

dien "Error: No MX records for $name" unless @mxlist ;
return @mxlist ;
}

# Put Form when From address is not given

sub putform {

print start_form(-method=>'post',-action=>$url),
      '<table border=0><tr><td>From: </td><td>',
      textfield(-name=>'from',-size=>40),
      '</td></tr><tr><td>To: </td><td>',
      b($to),hidden(-name=>'to',-default=>$to),
      '</td></tr><tr><td>Sub: </td><td>',
      textfield(-name=>'subject',-size=>40),
      '</td></tr><tr><td>Mesg: </td><td>',
      textarea(-name=>'body',-rows=>10,-columns=>60),
      '</td></tr><tr><td></td><td>',
      submit('Send'),
      '<font color=white>','.'x60,'</font>',
      reset('Reset'),
      '</td></tr></table>',
      end_form ;
}

# Process and send mail

sub process {

foreach (&getmx($todomain)) {
   $smtp = Net::SMTP->new($_, Debug => $debug) ; 
   last if $smtp ;
}
dien "Error connecting" unless $smtp ;

$smtp->mail($from);
$smtp->to($to);
$smtp->data();
$smtp->datasend("To: $to\n");
$smtp->datasend("Subject: $subject\n\n");
$smtp->datasend("$body");
$smtp->dataend();
$smtp->quit;

}

# Show received input before processing

sub showinput {

my @linec = split "\n",$body ;
my $lines = $#linec + 1 ;
$lines = 0  if ($body eq ' ') ;

foreach (@blockedfrom) {
   dien "Access Denied" if ($_ eq $from) ;
}

$myallowed = 0 ;
foreach (@allowedto) {
   if ($_ eq $to) {
         $myallowed++ ;
         last ;
   }
}
dien "Access Denied" unless ($myallowed) ;     

print h3('Received Input:'),p,hr,"<pre>
   From: $from
     To: $to
Subject: $subject
   Body: < $lines Lines ></pre>",hr ;
}

sub dien {
print pre($_[0]) ;
exit ;
}

# END