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