#!/usr/bin/env perl use strict; use warnings; # Core modules use CGI qw/:standard/; use Sys::Hostname; use File::Path qw(make_path); use File::Basename; use MIME::Base64; my $RCPT = 'mail@tregeis.com'; my $USERNAME = $ENV{USER} || getpwuid($<); my $TMP_DIR = "/home/$USERNAME/tmp/bluemail"; my $CGI = CGI->new; my $PARAMS = get_params(); my @FILES = upload_files(); my $CTYPE = 'text/' . ($PARAMS->{'text'} ? 'plain' : 'html') . '; charset="iso-8859-1"'; # Where the magic happens sub main { my $body = create_body(); my $header = create_header(); send_email("$header$body"); if($PARAMS->{'redirect'}) { print $CGI->redirect($PARAMS->{'redirect'}); } else { print $CGI->header({ type => 'text/html; charset="iso-8859-1"' }); print "Thank you for completing our form.

"; print "The following info was sent to $RCPT:
"; print "and shows as from $PARAMS->{'mailfrom'} (the value of the mailfrom input field)

" if $PARAMS->{'mailfrom'}; map { print "$_: $PARAMS->{$_}
" if $_ !~ m/^(file_attachment|mailfrom|send_addr|sendtoemail)$/ } keys(%{$PARAMS}); } # Delete all uploaded file attachments unlink "$TMP_DIR/$_" for @FILES; } # Uploads file attachments sub upload_files { my @files = (); my @names = $CGI->param('file_attachment'); my @handles = $CGI->upload('file_attachment'); # Make sure the upload directory exists if(!-d $TMP_DIR) { make_path($TMP_DIR, { 'mode' => 0755, 'error' => \my $err }) unless -d $TMP_DIR; # Print error message and die if any errors were caught if(@$err) { for my $diag (@$err) { my ($file, $message) = %$diag; _die("general error: $message") if $file eq ''; _die("problem unlinking file attachment: $message"); } } } for(my $i = 0; $i < scalar(@names); $i++) { if(!$names[$i]) { next; } my ($name, $path, $extension) = fileparse($names[$i], '..*'); my $handle = $handles[$i]; my $filename = "$name$extension"; $filename =~ s/ /_/g; _die("File attachment name exceeds the maximum of 255 characters!") if length($filename) > 255; _die("File attachment name contains invalid characters!") if $filename !~ m/^[a-zA-Z0-9._-]+$/; _die("Couldn't get handle to file attachment: $filename") if !$handle; open(FILE, ">", "$TMP_DIR/$filename") or _die("failed to upload file attachment: $!!"); while(<$handle>) { print FILE; } close FILE; _die("Failed to upload $filename!") if(! -f "$TMP_DIR/$filename"); push(@files, $filename); } return @files; } # Pipes email to sendmail. sub send_email { my $email = shift; open(MAIL, "|/usr/sbin/sendmail -t") or _die("Couldn't open /usr/bin/sendmail: $!!"); print MAIL $email; close(MAIL); } # Creates header. sub create_header { $ENV{'HTTP_REFERER'} ||= ''; $ENV{'REMOTE_ADDR'} ||= ''; my $from = $PARAMS->{'mailfrom'} ? $PARAMS->{'mailfrom'} : $PARAMS->{'send_addr'}; my $header; $header .= "To: $RCPT\n"; $header .= "From: $from\n"; $header .= "Subject: $PARAMS->{'subject'}\n"; $header .= "Mime-Version: 1.0\n"; $header .= "X-Referer: $ENV{'HTTP_REFERER'}\n"; $header .= "X-Originating-IP: $ENV{'REMOTE_ADDR'}\n"; return $header; } # Iterates through $PARAMS' key + values, appends them to # $body in "key: value
" format, and returns $body. sub create_body { my $body = ''; my @ignored = qw/send_addr text subject mailfrom redirect sendtoemail/; my $boundary = `uuidgen`; $boundary =~ s/\n//g; # If there are file attachments if(@FILES) { $body = "Content-Type: multipart/mixed; boundary=\"$boundary\"\n\n"; foreach my $file (@FILES) { my $file_contents = do { local $/ = undef; open my $fh, "<", "$TMP_DIR/$file" or _die("Couldn't open uploaded file attachment: $! $TMP_DIR/$file"); <$fh>; }; $body .= "--$boundary\n"; $body .= "Content-Transfer-Encoding: base64\n"; $body .= "Content-Type: application/octet-stream; name=$file\n"; $body .= "Content-Disposition: attachment; filename=$file\n\n"; $body .= encode_base64($file_contents); } $body .= "\n\n--$boundary\n"; } $body .= "Content-Type: $CTYPE\n\n"; foreach my $key (keys(%{ $PARAMS })) { if(length($PARAMS->{$key}) > 102500) { print $CGI->header(), "Arguments can not be longer than 102400 chars, $key is " . length($PARAMS->{$key}); } if(!(grep { /^$key$/ } @ignored)) { $body .= "$key: $PARAMS->{$key}
"; } } if(@FILES) { $body .= "\n\n--$boundary--"; } return $body; } # Iterates through the form submitted POST parameters # and sticks them into the $PARAMS hash. sub get_params { my $params = {}; foreach my $key ($CGI->param) { $params->{$key} = $CGI->param($key) if $key ne 'file_attachment'; } $params->{'send_addr'} = "$USERNAME@" . hostname; $params->{'send_addr'} =~ s/\s*//; return $params; } # Die wrapper sub _die { print $CGI->header({ 'Content-Type' => 'text/html; charset="iso-8859-1"' }); print "Failed to send email!
"; print shift; die; } __PACKAGE__->main(); exit;