#! /usr/local/bin/perl
##############################################################################
# FileMail                                                                   #
# By Mike Wheeler, mwheeler@gladstone.uoregon.edu                            #
# Archiving routine by Jim Martin, writeway@c2.org                           #
#                                                                            #
# Available from http://gladstone.uoregon.edu/~mwheeler/cgi                  #
# Based on:                                                                  #
# FormMail                      Version 1.5                                  #
# Copyright 1996 Matt Wright    mattw@misha.net                              #
# Created 6/9/95                Last Modified 2/5/96                         #
# Scripts Archive at:           http://www.worldwidemart.com/scripts/        #
##############################################################################
# COPYRIGHT NOTICE                                                           #
# Copyright 1996 Matthew M. Wright  All Rights Reserved.                     #
#                                                                            #
# FormMail may be used and modified free of charge by anyone so long as this #
# copyright notice and the comments above remain intact.  By using this      #
# code you agree to indemnify Matthew M. Wright from any liability that      #
# might arise from it's use.                                                 #
#                                                                            #
# Selling the code for this program without prior written consent is         #
# expressly forbidden.  In other words, please ask first before you try and  #
# make money off of my program.                                              #
##############################################################################
# Define Variables

$mailprog = '/usr/lib/sendmail';
# The location of your sendmail program

$newurl = 'http://www.cabinessence.com/cgi';
# Where you send people after running the script

$fromaddr = 'mwheeler@cabinessence.com';
# The e-mail address from which the files are sent

$organization = 'Cabinessence';
# Your organization

$fromname = 'Mike Wheeler';
# The name from which the files are sent

$filebase = '/usr/home/cabiness/usr/local/etc/httpd/htdocs/cgi';
# The base path to all files you want sent. If the files are coming from
# multiple directories you must show this in the filename part of the
# form such as chat/chat.cgi. If you use the archiving feature all files in
# this directory (and only this directory) will be listed.

$form_letter = '';
# The file you want sent out with every request for files (it will be 
# sent as a seperate message. Leave blank if you don't want one. This
# must follow the same rules set by $filebase

@referers = ("www.cabinessence.com");
# @referers allows forms to be located only on servers which are defined
# in this field.  This fixes a security hole in the last version which
# allowed anyone on any server to use your FormMail script.
#
# Done
##########################
# Check Referring URL
&check_url;

#Make archive page if needed
if ($ENV{'QUERY_STRING'} eq "archive") {
&archive;
}

# Retrieve Date
&get_date;

# Parse Form Contents
&parse_form;

# Get Variables
&get_variables;

# Send E-Mail
&send_mail;

# Return HTML Page or Redirect User
&return_html;

exit;

sub check_url {

   if ($ENV{'HTTP_REFERER'}) {
      foreach $referer (@referers) {
         if ($ENV{'HTTP_REFERER'} =~ /$referer/i) {
            $check_referer = '1';
            last;
         }
      }
   }
   else {
      $check_referer = '1';
   }

   if ($check_referer != 1) {
      &error('bad_referer');
   }
}

sub get_date {

   @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
   @months = ('January','February','March','April','May','June','July',
              'August','September','October','November','December');

   ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
   if ($hour < 10) { $hour = "0$hour"; }
   if ($min < 10) { $min = "0$min"; }
   if ($sec < 10) { $sec = "0$sec"; }

   $date = "$days[$wday], $months[$mon] $mday, 19$year at $hour\:$min\:$sec";

}

sub parse_form {
   read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});

   # Split the name-value pairs
   @pairs = split(/&/, $buffer);

   foreach $pair (@pairs) {
      ($name, $value) = split(/=/, $pair);

      # Un-Webify plus signs and %-encoding
      $value =~ tr/+/ /;
      $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      $value =~ s/<!--(.|\n)*-->//g;
      $value =~ s/<([^>]|\n)*>//g;

      if ($name eq "filename") {
         push (@files,$value);
      }
      else {
         $FORM{$name} = $value;
      }
   }
}

sub get_variables {
   if ($FORM{'realname'}) {
      $realname = $FORM{'realname'};
   }
   if ($FORM{'email'} =~ /.*\@.*\..*/) {
      $email = $FORM{'email'};
   }
   if ($FORM{'comments'}) {
      $comments = $FORM{'comments'};
   }
}

sub return_html {
   if ($email eq "" || $files[0] eq "") {
      print "Content-type: text/html\n\n";
      print "<html><head><title>Sorry</title></head>\n";
      print "<body bgcolor=ffffff><center><h1>Sorry</h1></center>\n";
      print "Sorry, you provided insufficient information. Either you\n"; 
      print "didn't include an acceptable e-mail address or you didn't\n";
      print "select any files to be mailed to you. Please go back\n";
      print "and try again.</body></html>\n";
      exit;
   }
   else {
      print "Location: $newurl\n\n";
   }
}

sub send_mail {
   if ($form_letter ne "") {
      push (@files,$form_letter);
   }
   foreach $file (@files) {
      if (-e "$filebase/$file") {
         open(MAIL,"|$mailprog -t");

         print MAIL "To: $email ($realname)\n";
         print MAIL "From: $fromaddr ($fromname)\n";
         if ($organization) {
            print MAIL "Organization: $organization\n";
         }
         else {
            print MAIL "Organization: Auto Sent File\n";
         }
         print MAIL "Subject: $file\n";
         print MAIL "X-Courtesy-Of: SendIt! 1.0\n\n";
         open(INPUT,"$filebase/$file")||&error;
         while (<INPUT>) {
            chop $_;
            print MAIL $_,"\n";
         }
         close (INPUT);
         close (MAIL);
      }
      else {
         print "Content-type: text/html\n\n";
         print "<head><title>Sorry</title></head>\n";
         print "<body bgcolor=ffffff><center><h1>Sorry</h1></center>\n";
         print "Sorry, your request for files could not be completed\n";
         print "because at least one of the files was not available.<p>\n";
         print "This file: $file could not be found.</body></html>\n";
         open(REMAIL,"|$mailprog -t");
         print REMAIL "To: $fromaddr\n";
         print REMAIL "From: $email ($realname)\n";
         if ($organization) {
            print REMAIL "Organization: $organization\n";
         }
         else {
            print REMAIL "Organization: Auto Sent File\n";
         }
         print REMAIL "Subject: File Unavailable\n";
         print REMAIL "X-Courtesy-Of: SendIt!\n\n";
         print REMAIL "$email ($realname)\n";
         print REMAIL "requested the file(s) @files\n";
         print REMAIL "but the file: $file could not be found\n";
         print REMAIL "so their request could not be fulfilled.\n\n";
         print REMAIL "$comments\n";
         close (REMAIL);
         exit;
      }
   }
   &mail_owner;
}

sub mail_owner {
   if($files[0] ne "") {
      open(REMAIL,"|$mailprog -t");

      print REMAIL "To: $fromaddr\n";
      print REMAIL "From: $email ($realname)\n";
      if ($organization) {
         print REMAIL "Organization: $organization\n";
      }
      else {
         print REMAIL "Organization: Auto Sent File\n";
      }
      if ($CONFIG{'subject'}) {
         print REMAIL "Subject: $subject\n";
      }
      else {
         print REMAIL "Subject: Auto Sent File\n";
      }
      print REMAIL "X-Courtesy-Of: SendIt!\n\n";
      print REMAIL "$email ($realname)\n";
      print REMAIL " requested the file(s) @files\n";
      print REMAIL "$comments";
      close (REMAIL);
   }
}

##################
# Print archive page
sub archive {
   print "Content-type: text/html\n\n";
   print "<html><head><title>File Archive</title></head>\n";
   print "<body bgcolor=ffffff><center><h1>File Archive</h1></center>\n";
   print "<form method=\"post\" action=\"$ENV{'SCRIPT_NAME'}\">\n";
   print "<table><tr valign=top><Td>Files:</td><td>\n";
   opendir(FILES,"$filebase");
   @allfiles = sort(grep(!/^\.\.?$/,readdir(FILES)));
   closedir(FILES);
   foreach$file(@allfiles) {
      print "<input type=checkbox name=\"filename\" value=\"$file\">$file<br>\n";
   }
   print "</td></tr><tr valign=top><td>Comments:</td><td>\n";
   print "<textarea wrap name=\"comments\" rows=5 cols=36></textarea><br>\n";
   print "</td></tr><tr><td>Name:</td><td>\n";
   print "<input type=text size=40 name=\"realname\"><br>\n";
   print "</td></tr><tr><td>E-mail:</td><td>\n";
   print "<input type=text size=40 name=\"email\"><br>\n";
   print "</td></tr><tr><td></td><td>\n";
   print "<input type=submit value=\"Send Files\">\n";
   print "</td></tr></table></form></body></html>\n";
   exit;
}