#!/usr/bin/perl -w use strict; =pod AUTHOR Tommy Butler phone: (817)-468-7716 6711 Forest Park Dr Arlington, TX 76001-8403 COPYRIGHT Tommy Butler, all rights reserved. LISCENCE This library is free software, you may redistribute and/or modify it under the same terms as Perl itself. =cut require 5.6.0; use CGI qw( header param ); my($cgi) = CGI->new(); print(header, &email_form) and exit unless param('message'); my($eml) = { # defaults to 'text/plain', but you can set it to 'text/html' if you # want to send an email in formatted html by assigning a value of # 'text/html' to this argument 'contype' => param('contype'), # email address for the sender of this message 'from' => mail_field(param('from name'),param('from')), # the email address at which you wish receive replies to this message 'reply to' => mail_field(param('reply to'),param('reply to name')), # email address for the recipient of this message 'to' => mail_field(param('to name'),param('to')), # you can specify an email address of someone to whom you wish to # direct a 'carbon copy' of the email. 'cc' => mail_field(param('cc name'),param('cc')), # you can specify an email address of someone to whom you wish to # direct a 'blind carbon copy' of the email. 'bcc' => mail_field(param('bcc name'),param('bcc')), # subject of the message 'subject' => param('subject'), # message body 'message' => param('message'), # the number of columns at which to wrap plain-text email. # defaults to a value of '80' 'wrap at' => param('wrap at'), }; Mailer::Simple->new()->send(%$eml); map { $eml->{ $_ } = html_escape($eml->{ $_ }) } keys(%$eml); print(header, mail_sent($eml)); # -------------------------------------------------------- # subroutine declarations # -------------------------------------------------------- sub mail_field { $_[0] && $_[1] ? qq["${\$_[0]}" <${\$_[1]}>] : '' } sub html_escape { my(@chars) = split(//,(${\myargs(@_)}||return(undef))); my($c) = ''; my($i) = 0; # need to escape ascii 33-47, 58-64, 91-96, 123+ for ($i = 0; $i < @chars; ++$i) { $c = ord($chars[$i]); if ( ($c > 32 and $c < 48) || ($c > 57 and $c < 65) || ($c > 90 and $c < 97) || ($c > 123) ) { $chars[$i] = qq[\046\043] . $c . qq[\073] } } return(join('',@chars)) } sub email_form { <<__HTML__ } Mailman
 
the Mailman
 
recipient's name  
recipient's email  
sender's name  
sender's email  
reply to name  
reply to email  
CC name  
CC email  
BCC name  
BCC email  
subject  
content-type   html   plain-text  

message
 

send message  

 

__HTML__ sub mail_sent { <<__SENT__ } Error
 
the Mailman
 
recipient   ${\($_[0]->{'to'}||'')}
sender   ${\($_[0]->{'from'}||'')}
reply-to   ${\($_[0]->{'reply to'}||'')}
CC   ${\($_[0]->{'cc'}||'')}
BCC   ${\($_[0]->{'bcc'}||'')}
subject   ${\($_[0]->{'subject'}||'')}
content-type   ${\($_[0]->{'contype'}||'')}

message
 
${\($_[0]->{'message'}||'')}

 

__SENT__ sub error { <<__ERR__ } Error

 

An error has occurred.
 
@_

 

__ERR__ package Mailer::Simple; use strict; use vars qw/ $VERSION /; $VERSION = 0.00_1; sub new { bless({ }, shift(@_)) } sub send { my($this) = shift(@_); my($args) = $this->coerce_array(@_); my($email) = ''; $args->{'app'} ||= ($args->{'sendmail'} || q[/usr/sbin/sendmail -oi -t]); if ($args->{'raw'}) { $this->do_send($args->{'app'}, $args->{'raw'}); return($args->{'raw'}); } foreach (keys(%$args)) { delete($$args{$_}) unless (length($$args{$_})) } $args->{'contype'} = 'text/plain' unless ($args->{'contype'}); my($headers) = $this->headers($args); $email = $args->{'message'}||''; $this->do_send($args->{'app'}, $headers . $email); return($headers,$email); } sub do_send { my($this,$app,$email) = @_; # begin conversation with the server's sendmail program through a pipe. # open sendmail with arguments instructing it to send our message # immediately rather than place it in que local(*MAIL); open(MAIL, qq[|$app]) or die split(/(?:\r|\n)+/,<<__STAT__); ${\__FILE__} Couldn't pipe to mail app "$app". system returned: "$!" exit status @{[ $? >> 8 ]}, signal @{[ $? & 127 ]} error occured at @{[ scalar localtime ]} __STAT__ # give our email over to sendmail program which will handle sending # it to the recipient(s) for us print(MAIL $email); # we end our conversion with sendmail by closing the pipe close(MAIL) or warn(qq[couldn't close pipe to $app $!]); $this->{'mailstat'} = [($? >> 8), ($? & 127)]; $email } sub mailstat { $_->[0]->{'mailstat'} ? @{ $_->[0]->{'mailstat'} } : () } sub headers { my($this,$args)= @_; my($headers) = ''; my($defaults) = { 'contype' => 'text/plain', 'charset' => 'ISO-8859-1', 'x-mailer' => __PACKAGE__ . ' v. ' . $VERSION, 'status' => 'RO', }; my($header_objects) = [ ['to' => 'To: '], ['cc' => 'Cc: '], ['bcc' => 'Bcc: '], ['news' => 'Newsgroups: '], ['from' => 'From: '], ['reply to' => 'Reply-To: '], ['follow up to' => 'Followup-To: '], ['subject' => 'Subject: '], ['sender' => 'Sender: '], ['in reply to' => 'In-Reply-To: '], ['contype' => 'Content-Type: '], ['charset' => 'MIME-Version: 1.0; charset='], ['x-mailer' => 'X-Mailer: '], ['summary' => 'Summary: '], ['keywords' => 'Keywords: '], ['organization' => 'Organization: '], ['precedence' => 'Precedence: '], ['importance' => 'Importance: '], ['priority' => 'X-Priority: '], ['ms-priority' => 'X-MSMail-Priority: '], ['class' => 'Class: '], ['status' => 'Status: '], ['request reciept'=> 'Disposition-Notification-To: '], ]; foreach (@{$header_objects}) { my($property,$syntax) = @{$_}; $property ||= ''; $syntax ||= ''; my($spec) = $args->{$property}||''; my($line) = ''; $spec ||= $defaults->{$property}; $spec ||= ''; $line = $syntax.$spec.qq[\n] if (length($spec) > 0); $headers .= $line; } return($headers.qq[\n]); } sub coerce_array { my($this) = shift(@_); my($hashref) = {}; my($i) = 0; my(@shadow) = @_; while (@shadow) { my($name,$val) = splice(@shadow,0,2); if (defined $name) { $hashref->{ $name } = defined $val ? $val : '' } else { $hashref->{ 'anonymous key ' . ++$i } = defined $val ? $val : '' } } $hashref } 1; package main; BEGIN { ++$| } BEGIN { local(*ERR); open(ERR,'>>./' . [( split(/\/|\\|\:/,__FILE__) )]->[-1] . '-error.log'); open(STDERR,'>&ERR') } BEGIN { $SIG{'__WARN__'} = sub { $SIG{'__WARN__'} = sub { warn @_ }; warn substr(<<__WARN__, 0, -1) } } WARNINGS found in @{[ __FILE__ ]} at ${\ scalar localtime }\012@_ __WARN__ 1;