rd = $dat{'Password'}; # --------- Trim trailing blanks & convert to upper case --------- $password =~ s/^\s+//g; $password =~ tr/a-z/A-Z/; $text = "#000000"; $bgcolor = "#FFFFFF"; $success_text = "Successful Login "; $fail_text = "Invalid Login Attempt "; $expired_text = ""; # --------- Don't let password field be blank --------- if ($password eq "") { print "Content-type: text/html\n\n"; print "\n"; print "\n"; print "\n"; close(STDOUT); exit 0; } # &showerror("$passwordfile"); # ------- Make $log_file name ----- $log_file = $prefix . $studyname . '.log'; # Full or relative address to the log file # $log_file = "/usr/statpac/public_html/cgi-bin/$studyname.txt"; # $log_file = "../cgi-bin/$studyname.log"; # $log_file = "log.txt"; # --------- Search password file for password --------- $key_match = 0; $counter = 0; if ($PasswordType == "1") { open (DB,"<$passwordfile") || die "Could not access passwords file!"; $line = ; # convert line to upper case chomp ($line); # Remove trailing new line. # Trim trailing blanks & convert to upper case $line =~ s/^\s+//g; $line =~ tr/a-z/A-Z/; if ($line eq $password) {$key_match = 1;} close DB; } else { $db_delimit = "\t"; open (DB,"<$passwordfile") || die "Could not access password file!"; LINE: while () { if ($key_match == 0) { (/^#/) and next LINE; # Skip comment Lines. (/^\s*$/) and next LINE; # Skip blank lines. $line = $_; chomp ($line); # Remove trailing new line. $input = $line; $input =~ s/\Q$db_delimit\E$/$db_delimit /o; # Add space if delim new line @array = split (/\Q$db_delimit\E/o, $input); for ($i = 0; $i <= $#array; $i++) { $array[$i] =~ s/~~/$db_delimit/og; # Retrieve Delimiter.. $array[$i] =~ s/``/\n/g; # Change '' back to newlines.. } $recpassword = $array[$passwordfield-1]; # password $recpassword =~ tr/a-z/A-Z/; # Convert to upper case $recpassword =~ s/^\s*(.*?)\s*$/$1/; # Trim any white space if ($IDfield != 0) { $IDnumber = $array[$IDfield-1]; # ID Number for url $IDnumber =~ s/^\s*(.*?)\s*$/$1/; # Trim any white space } if ($recpassword eq $password) {$key_match = 1;} } } close DB; } if (($key_match == 0) || ($IDfield == 0)) { $IDnumber = "None"; } if ($key_match == 0) { $subject = $fail_text; } else { $subject = $success_text; } $time=time(); # &showerror("Debug Flag:","$time"); @months = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'); ($sec,$min,$hour,$day,$month,$year,$wday) = (localtime(time))[0,1,2,3,4,5,6]; $time = sprintf("%02d:%02d:%02d",$hour,$min,$sec); $year += 1900; $month = $month + 1; $today = sprintf("%04d%02d%02d",$year,$month,$day); $body = "--- $subject ---\n"; $body .= "Survey Name: $studyname\n"; $body .= "Respondent ID: $IDnumber\n"; $body .= "IP Address: $IPAddress\n"; $body .= "Date & Time: $today $time\n"; $body .= "Password: $password\n\n"; $subject = $subject.': '.$studyname; # -------- Login failed --------- if ($key_match == 0) { # send email if necessary if (($send_mail == 2) || ($send_mail == 3)) { &sendemail; } # write to log if necessary if (($log == 2) || ($log == 3)) { &writelog; } print "Content-type: text/html\n\n"; print "\n"; print "\n"; print "Login Failed\n"; print '\n"; print "\n"; print "\n"; print '

Invalid Password

' . "\n"; print '
' . "\n"; print '

' . "\n"; print "\n"; print "\n"; close(STDOUT); exit 0; } # -------- Login was successful --------- if ($IDnumber eq "") {$IDnumber = "None";} if (($send_mail == 1) || ($send_mail == 3)) { &sendemail; } if (($log == 1) || ($log == 3)) { &writelog; } # ------- Add the ID Number (password) to the forwarding url ------- if ($IDnumber eq "None") {$IDnumber = "";} if ($PasswordType eq "1") { $finalurl = "$firstsurveypage"; if ($IDnumber ne "") {$finalurl = "$firstsurveypage?id=$IDnumber";} } else { $finalurl = "$firstsurveypage"; if (($IDfield != 0) && ($IDnumber ne "")) {$finalurl = "$firstsurveypage?id=$IDnumber";} } # &showerror("$finalurl"); # --------- Create page that forwards to the survey ------------ print "Content-type: text/html\n\n"; print "\n"; print "\n"; print "\n"; sub sendemail { if ($MailMethod eq '1') { # ------------- Unix Sendmail -------------- open(MAILOUT, "| $mailprog -t") || &showerror("Cannot start mail program: ","$mailprog"); print MAILOUT "To: $email\n"; print MAILOUT "From: $email\n"; print MAILOUT "Subject: $subject\n\n"; print MAILOUT "$body"; print MAILOUT "\n"; close(MAILOUT); } elsif ($MailMethod eq '2') { # ------------- Perl Module Mail::Sendmail -------------- $fromuser = $email; $to = $email; $subject = $subject; %mail = ( To => $to, From => $fromuser, Message => $body ); sendmail(%mail); } elsif ($MailMethod eq '3') { # ---------- DIRECTLY ACCESS PORT 25 ($SMTPPort) --------- $emailfrom = $email; $recipient = $email; $subject = $subject; ($x,$x,$x,$x, $here) = gethostbyname($null); ($x,$x,$x,$x, $there) = gethostbyname($SMTPMailServer); $thisserver = pack('S n a4 x8',2,0,$here); $remoteserver = pack('S n a4 x8',2,$SMTPPort,$there); if ($NTServer eq 'N') { (!(socket(S,2,2,6))) && (&showerror("Connect error!")); # Solaris } else { (!(socket(S,2,1,6))) && (&showerror("Connect error!")); # NT } (!(bind(S,$thisserver))) && (&showerror("Connect error! bind")); (!(connect(S,$remoteserver))) && (&showerror("Connection to $SMTPMailServer has failed!")); select(S); $| = 1; select(STDOUT); $DATA_IN = ; ($DATA_IN !~ /^220/) && (&showerror("Connect error - 220")); # If NT, wait for '220 ESTMP spoken here' message if ($NTServer eq 'Y') { $DATA_IN = ; ($DATA_IN !~ /^220/) && (&showerror("Connect error - 220")); } $user = 'statpac'; print S "HELO $user\r\n"; $DATA_IN = ; ($DATA_IN !~ /^250/) && (&showerror("Connect error - 250")); print S "MAIL FROM:<$emailfrom>\r\n"; $DATA_IN = ; ($DATA_IN !~ /^250/) && (&showerror("'From' address not valid")); print S "RCPT TO:<$recipient>\r\n"; $DATA_IN = ; ($DATA_IN !~ /^250/) && (&showerror("'Recipient' address not valid")); print S "DATA\r\n"; $DATA_IN = ; ($DATA_IN !~ /^354/) && (&showerror("Message send failed - 354")); print S "From: $emailfrom\r\n"; print S "To: $recipient\r\n"; print S "Subject: $subject\r\n\r\n"; print S "$body"; print S "\r\n.\r\n"; $DATA_IN = ; ($DATA_IN !~ /^250/) && (&showerror("Message send failed - 250")); print S "QUIT\r\n"; } elsif ($MailMethod eq '4') { # ------------- Net::SMTP -------------- $smtp = Net::SMTP->new($SMTPMailServer); $from = $email; $subject = $subject; $smtp->mail($from); $smtp->to($email); $smtp->data(); $smtp->datasend("To: ", $email, "\n"); $smtp->datasend("Subject: ", $subject, "\n"); $smtp->datasend("\n"); $smtp->datasend("$body"); $smtp->dataend(); $smtp->quit; } elsif ($MailMethod eq '5') { # ------------- Blat -------------- $subject = $subject; open(outfile,">$tempfilename"); print outfile "$body"; close(outfile); system("$blatpathname $tempfilename -s $subject -t $email -server $SMTPMailServer -f $email"); # Some servers are slow and you may have to increase the timeout parameter by adding the -ti switch # Some servers require a username and password, added with the -u and -pw switches # An example of the blat system call with these parameters set would be: # system("$blatpathname $tempfilename -s $subject -t $email -server $SMTPMailServer -f $email -ti 100 -u username -pw password"); } return 1; } sub writelog { srand; $counter = 0; while ((!open(MAIL,">>$log_file")) && ($counter < 200)) {$counter = $counter + 1;} if ($counter < 200) { print MAIL "$IDnumber\t$password\t$IPAddress\t$today\t$time\t$subject\n"; close(MAIL); return 1; } } # -------------------- Show A Perl Script Error ------------------- sub showerror { # &showerror("Debug Flag:","$recpassword $password $IDnumber $key_match"); print "Content-type: text/html\n\n"; print ""; print ""; print "$studyname"; print ""; print ""; print ""; print ""; print "
"; print "Error in the perl script:
"; print "
"; print ""; print "$ENV{'SCRIPT_FILENAME'}

"; print "
"; print ""; foreach (@_) { print "$_
"; } print "
"; print ""; print ""; print ""; print ""; close(STDOUT); exit 0; }