home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 18
/
amigaformatcd18.iso
/
+look_here_1st!+
/
af_on_the_web
/
websites
/
weirdscience
/
weird-cgi
/
mailfile.pl
< prev
next >
Wrap
Perl Script
|
1997-06-16
|
10KB
|
278 lines
#! /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;
}