#!/usr/bin/perl -wT | |
use Fcntl ':flock'; | |
# START USER EDITS | |
# absolute path to folder files will be uploaded to. | |
# WINDOWS users, your path would like something like : images\\uploads | |
# UNIX users, your path would like something like : /home/www/images/uploads | |
# do not end the path with any slashes and if you're on a UNIX serv, make sure | |
# you CHMOD each folder in the path to 777 | |
$lockfileName = ".lock"; | |
$logFile = "/.../uploadLog.txt"; | |
$uidMapFile = "/.../mylarUidMap.txt"; | |
$nextUidFile = "/.../mylarNextUid.txt"; | |
$allConsentedUsers = "/.../mylarUsers.txt"; | |
# if you would like to be notified of uploads, enter your email address | |
# between the SINGLE quotes. leave this blank if you would not like to be notified | |
#$notify = ''; | |
# UNIX users, if you entered a value for $notify, you must also enter your | |
# server's sendmail path. It usually looks something like : /usr/sbin/sendmail | |
#$send_mail_path = ""; | |
# WINDOWS users, if you entered a value for $notify, you must also enter your | |
# server's SMTP path. It usually looks something like : mail.servername.com | |
#$smtp_path = ""; | |
#################################################################### | |
# END USER EDITS | |
#################################################################### | |
$OS = $^O; # operating system name | |
if($OS =~ /darwin/i) { $isUNIX = 1; } | |
elsif($OS =~ /win/i) { $isWIN = 1; } | |
else {$isUNIX = 1;} | |
if($isWIN){ $S{S} = "\\\\"; } | |
else { $S{S} = "/";} # seperator used in paths | |
use CGI; # load the CGI.pm module | |
my $GET = new CGI; # create a new object | |
my @VAL = $GET->param; #get all form field names | |
my($query_string) = ""; | |
$query_string = $ENV{'QUERY_STRING'}; | |
my($firstName); | |
my($lastName); | |
my($email_address); | |
my($job_function); | |
my($company_size); | |
my($company_buisness); | |
my($anonymousStr); | |
my($uid) = -1; | |
my($anonymous) = 0; | |
my($first); | |
my($second); | |
my($third); | |
my($fourth); | |
my($fifth); | |
my($sixth); | |
my($seventh); | |
if($query_string =~ m/^(.+)\&(.+)\&(.+)\&(.+)\&(.+)\&(.+)\&(.+)$/) | |
{ | |
$first = $1; | |
$second = $2; | |
$third = $3; | |
$fourth = $4; | |
$fifth = $5; | |
$sixth = $6; | |
$seventh = $7; | |
} | |
else | |
{ | |
# error, query string is wrong | |
print "Content-type: text/plain", "\n"; | |
print "Status: 501 Not Implemented", "\n\n"; | |
exit; | |
} | |
if($first =~ m/^firstName\=(.+)$/){ | |
$firstName = $1; | |
} | |
elsif($second =~ m/^firstName\=(.+)$/){ | |
$firstName = $1; | |
} | |
elsif ($third =~ m/^firstName\=(.+)$/){ | |
$firstName = $1; | |
} | |
elsif ($fourth =~ m/^firstName\=(.+)$/){ | |
$firstName = $1; | |
} | |
elsif ($fifth =~ m/^firstName\=(.+)$/){ | |
$firstName = $1; | |
} | |
elsif ($sixth =~ m/^firstName\=(.+)$/){ | |
$firstName = $1; | |
} | |
elsif ($seventh =~ m/^firstName\=(.+)$/){ | |
$firstName = $1; | |
} | |
if($first =~ m/^lastName\=(.+)$/){ | |
$lastName = $1; | |
} | |
elsif($second =~ m/^lastName\=(.+)$/){ | |
$lastName = $1; | |
} | |
elsif ($third =~ m/^lastName\=(.+)$/){ | |
$lastName = $1; | |
} | |
elsif ($fourth =~ m/^lastName\=(.+)$/){ | |
$lastName = $1; | |
} | |
elsif ($fifth =~ m/^lastName\=(.+)$/){ | |
$lastName = $1; | |
} | |
elsif ($sixth =~ m/^lastName\=(.+)$/){ | |
$lastName = $1; | |
} | |
elsif ($seventh =~ m/^lastName\=(.+)$/){ | |
$lastName = $1; | |
} | |
if($first =~ m/^email\=(.+)$/){ | |
$email_address = $1; | |
} | |
elsif($second =~ m/^email\=(.+)$/){ | |
$email_address = $1; | |
} | |
elsif ($third =~ m/^email\=(.+)$/){ | |
$email_address = $1; | |
} | |
elsif ($fourth =~ m/^email\=(.+)$/){ | |
$email_address= $1; | |
} | |
elsif ($fifth =~ m/^email\=(.+)$/){ | |
$email_address= $1; | |
} | |
elsif ($sixth =~ m/^email\=(.+)$/){ | |
$email_address = $1; | |
} | |
elsif ($seventh =~ m/^email\=(.+)$/){ | |
$email_address= $1; | |
} | |
if($first =~ m/^jobFunction\=(.+)$/){ | |
$job_function = $1; | |
} | |
elsif($second =~ m/^jobFunction\=(.+)$/){ | |
$job_function = $1; | |
} | |
elsif ($third =~ m/^jobFunction\=(.+)$/){ | |
$job_function = $1; | |
} | |
elsif ($fourth =~ m/^jobFunction\=(.+)$/){ | |
$job_function= $1; | |
} | |
elsif ($fifth =~ m/^jobFunction\=(.+)$/){ | |
$job_function = $1; | |
} | |
elsif ($sixth =~ m/^jobFunction\=(.+)$/){ | |
$job_function = $1; | |
} | |
elsif ($seventh =~ m/^jobFunction\=(.+)$/){ | |
$job_function = $1; | |
} | |
if($first =~ m/^companySize\=(.+)$/){ | |
$company_size = $1; | |
} | |
elsif($second =~ m/^companySize\=(.+)$/){ | |
$company_size = $1; | |
} | |
elsif ($third =~ m/^companySize\=(.+)$/){ | |
$company_size = $1; | |
} | |
elsif ($fourth =~ m/^companySize\=(.+)$/){ | |
$company_size = $1; | |
} | |
elsif ($fifth =~ m/^companySize\=(.+)$/){ | |
$company_size = $1; | |
} | |
elsif ($sixth =~ m/^companySize\=(.+)$/){ | |
$company_size = $1; | |
} | |
elsif ($seventh =~ m/^companySize\=(.+)$/){ | |
$company_size = $1; | |
} | |
if($first =~ m/^companyBuisness\=(.+)$/){ | |
$company_buisness = $1; | |
} | |
elsif($second =~ m/^companyBuisness\=(.+)$/){ | |
$company_buisness = $1; | |
} | |
elsif ($third =~ m/^companyBuisness\=(.+)$/){ | |
$company_buisness = $1; | |
} | |
elsif ($fourth =~ m/^companyBuisness\=(.+)$/){ | |
$company_buisness = $1; | |
} | |
elsif ($fifth =~ m/^companyBuisness\=(.+)$/){ | |
$company_buisness = $1; | |
} | |
elsif ($sixth =~ m/^companyBuisness\=(.+)$/){ | |
$company_buisness = $1; | |
} | |
elsif ($seventh =~ m/^companyBuisness\=(.+)$/){ | |
$company_buisness = $1; | |
} | |
if($first =~ m/^anonymous\=(.+)$/){ | |
$anonymousStr = $1; | |
} | |
elsif($second =~ m/^anonymous\=(.+)$/){ | |
$anonymousStr = $1; | |
} | |
elsif ($third =~ m/^anonymous\=(.+)$/){ | |
$anonymousStr = $1; | |
} | |
elsif ($fourth =~ m/^anonymous\=(.+)$/){ | |
$anonymousStr = $1; | |
} | |
elsif ($fifth =~ m/^anonymous\=(.+)$/){ | |
$anonymousStr = $1; | |
} | |
elsif ($sixth =~ m/^anonymous\=(.+)$/){ | |
$anonymousStr = $1; | |
} | |
elsif ($seventh =~ m/^anonymous\=(.+)$/){ | |
$anonymousStr = $1; | |
} | |
if ($anonymousStr =~ "true") { | |
$anonymous = 1; | |
} | |
open(USERS, "+<$allConsentedUsers ") || die "Can't open Log File: $!\n"; | |
seek USERS, 0, 2; | |
print USERS "$firstName\t$lastName\t$email_address\t$job_function\t$company_size\t$company_buisness\n"; | |
close USERS; | |
if($anonymous != 1){ | |
# give them the same id as before | |
my($old) = &checkExistance($firstName, $lastName, $email_address); | |
if($old == -1){ | |
$uid = &getNewUID($firstName, $lastName, $email_address); | |
} | |
else{ | |
$uid = $old; | |
} | |
} | |
else | |
{ | |
$uid = &getNewUID("anonymous", "anonymous", "anonymous"); | |
} | |
if($uid != -1) | |
{ | |
print "Content-type: text/plain", "\n"; | |
print "Status: 200 OK", "\n\n"; | |
print "UID: $uid" . "\n"; | |
exit; | |
} | |
else | |
{ | |
print "Content-type: text/plain", "\n"; | |
print "Status: 501 Not Implemented", "\n\n"; | |
print "COULD NOT GET UID" . "\n"; | |
exit; | |
} | |
#################################################################### | |
#################################################################### | |
sub send_mail { | |
my ($from_email, $from_name, $to_email, $to_name, $subject, $message ) = @_; | |
if(open(MAIL, "|$CONFIG{mailprogram} -t")) { | |
print MAIL "From: $from_email ($from_name)\n"; | |
print MAIL "To: $to_email ($to_name)\n"; | |
print MAIL "Subject: $subject\n"; | |
print MAIL "$message\n\nSubmitter's IP Address : $ENV{REMOTE_ADDR}"; | |
close MAIL; | |
return(1); | |
} else { | |
return; | |
} | |
} | |
#################################################################### | |
#################################################################### | |
sub send_mail_NT { | |
my ($from_email, $from_name, $to_email, $to_name, $subject, $message ) = @_; | |
my ($SMTP_SERVER, $WEB_SERVER, $status, $err_message); | |
use Socket; | |
$SMTP_SERVER = "$CONFIG{smtppath}"; | |
# correct format for "\n" | |
local($CRLF) = "\015\012"; | |
local($SMTP_SERVER_PORT) = 25; | |
local($AF_INET) = ($] > 5 ? AF_INET : 2); | |
local($SOCK_STREAM) = ($] > 5 ? SOCK_STREAM : 1); | |
# local(@bad_addresses) = (); | |
$, = ', '; | |
$" = ', '; | |
$WEB_SERVER = "$CONFIG{smtppath}\n"; | |
chop ($WEB_SERVER); | |
local($local_address) = (gethostbyname($WEB_SERVER))[4]; | |
local($local_socket_address) = pack('S n a4 x8', $AF_INET, 0, $local_address); | |
local($server_address) = (gethostbyname($SMTP_SERVER))[4]; | |
local($server_socket_address) = pack('S n a4 x8', $AF_INET, $SMTP_SERVER_PORT, $server_address); | |
# Translate protocol name to corresponding number | |
local($protocol) = (getprotobyname('tcp'))[2]; | |
# Make the socket filehandle | |
if (!socket(SMTP, $AF_INET, $SOCK_STREAM, $protocol)) { | |
return; | |
} | |
# Give the socket an address | |
bind(SMTP, $local_socket_address); | |
# Connect to the server | |
if (!(connect(SMTP, $server_socket_address))) { | |
return; | |
} | |
# Set the socket to be line buffered | |
local($old_selected) = select(SMTP); | |
$| = 1; | |
select($old_selected); | |
# Set regex to handle multiple line strings | |
$* = 1; | |
# Read first response from server (wait for .75 seconds first) | |
select(undef, undef, undef, .75); | |
sysread(SMTP, $_, 1024); | |
#print "<P>1:$_"; | |
print SMTP "HELO $WEB_SERVER$CRLF"; | |
sysread(SMTP, $_, 1024); | |
#print "<P>2:$_"; | |
while (/(^|(\r?\n))[^0-9]*((\d\d\d).*)$/g) { $status = $4; $err_message = $3} | |
if ($status != 250) { | |
return; | |
} | |
print SMTP "MAIL FROM:<$from_email>$CRLF"; | |
sysread(SMTP, $_, 1024); | |
#print "<P>3:$_"; | |
if (!/[^0-9]*250/) { | |
return; | |
} | |
# Tell the server where we're sending to | |
print SMTP "RCPT TO:<$to_email>$CRLF"; | |
sysread(SMTP, $_, 1024); | |
#print "<P>4:$_"; | |
/[^0-9]*(\d\d\d)/; | |
# Give the server the message header | |
print SMTP "DATA$CRLF"; | |
sysread(SMTP, $_, 1024); | |
#print "<P>5:$_"; | |
if (!/[^0-9]*354/) { | |
return; | |
} | |
$message =~ s/\n/$CRLF/ig; | |
print SMTP qq~From: $from_email ($from_name)$CRLF~; | |
print SMTP qq~To: $to_email ($to_name)$CRLF~; | |
# if($cc){ | |
# print SMTP "CC: $cc ($cc_name)\n"; | |
# } | |
print SMTP qq~Subject: $subject$CRLF$CRLF~; | |
print SMTP qq~$message~; | |
print SMTP "$CRLF.$CRLF"; | |
sysread(SMTP, $_, 1024); | |
#print "<P>6:$_"; | |
if (!/[^0-9]*250/) { | |
return; | |
} else { | |
return(1); | |
} | |
if (!shutdown(SMTP, 2)) { | |
return; | |
} | |
} | |
#################################################################### | |
#################################################################### | |
sub check_email { | |
my($fe_email) = $_[0]; | |
if($fe_email) { | |
if(($fe_email =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)|(\.$)/) || | |
($fe_email !~ /^.+@\[?(\w|[-.])+\.[a-zA-Z]{2,3}|[0-9]{1,3}\]?$/)) { | |
return; | |
} else { return(1) } | |
} else { | |
return; | |
} | |
} | |
#################################################################### | |
#################################################################### | |
sub getNewUID { | |
my($firstName, $lastName, $email_address) = @_; | |
open(LOCKFILE, $lockfileName); | |
flock(LOCKFILE, LOCK_EX); | |
open(NEXTUID, "<$nextUidFile") || die "Can't open Log File: $!\n"; | |
my($uid) = -1; | |
my(@lines) = <NEXTUID>; | |
my($line) = ""; | |
foreach $line (@lines) | |
{ | |
if($line =~ m/^(\d+)$/) | |
{ | |
$uid = $1; | |
last; | |
} | |
} | |
close NEXTUID; | |
my($nextUid) = $uid + 17; | |
open(NEXTUID, ">$nextUidFile") || die "Can't open Log File: $!\n"; | |
print NEXTUID $nextUid; | |
close NEXTUID; | |
open(UIDMAP, "+<$uidMapFile") || die "Can't open Log File: $!\n"; | |
seek UIDMAP, 0, 2; | |
print UIDMAP "$uid\t$firstName\t$lastName\t$email_address\n"; | |
close UIDMAP; | |
flock(LOCKFILE, LOCK_UN); | |
close LOCKFILE; | |
return $uid; | |
} | |
#################################################################### | |
#################################################################### | |
sub checkExistance { | |
my($firstName, $lastName, $email_address) = @_; | |
my($uid) = -1; | |
open(LOCKFILE, $lockfileName); | |
flock(LOCKFILE, LOCK_EX); | |
open(UIDMAP, $uidMapFile) || die "Can't open Log File: $!\n"; | |
my(@lines) = <UIDMAP>; | |
my($line) = ""; | |
foreach $line (@lines) | |
{ | |
if($line =~ m/^(\d+)\t$firstName\t$lastName\t$email_address$/) | |
{ | |
$uid = $1; | |
last; | |
} | |
} | |
close UIDMAP; | |
flock(LOCKFILE, LOCK_UN); | |
close LOCKFILE; | |
return $uid; | |
} | |
#################################################################### | |
#################################################################### | |
sub log { | |
open(LOCKFILE, $lockfileName); | |
flock(LOCKFILE, LOCK_EX); | |
open(LOG, "+<$logFile") || die "Can't open Log File: $!\n"; | |
seek LOG, 0, 2; | |
print LOG $_[0] . "\t\t"; | |
my ($sec,$min,$hour,$mday,$mon,$year, $wday,$yday,$isdst) = localtime time; | |
# update the year so that it is correct since it perl | |
# has a 1900 yr offset | |
$year += 1900; | |
# update the month since it is 0 based in perl | |
$mon += 1; | |
printf LOG "%02d/%02d/%04d %02d:%02d:%02d\n", $mday, $mon, $year, $hour, $min, $sec; | |
close LOG; | |
flock(LOCKFILE, LOCK_UN); | |
close LOCKFILE; | |
} |