| #!/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; | |
| } |