Question

我目前正在我的主机上运行此脚本并尝试连接到我自己的SMTP服务器，以便在提交后发送调查结果。

但是，运行此Perl脚本时，我收到500内部服务器错误。该脚本位于GoDaddy服务器上，并尝试连接到我的邮件服务器。

以下是代码：

#!/usr/bin/perl

#First released with snap 10

$port = 25; #SMTP PORT NUMBER
$smtpServer = 'SMTP_SERVER';
$domain = 'DOMAIN';
$sWebMaster='WEBMASTER';
$sReturnURL='http://alliancesurveys.org';
$sReturnText='Back to surveys';

use Socket;
use URI::Escape;

$SIG{'INT'} = 'dokill';
sub dokill {
    kill 9,$child if $child;
}

($name,$aliases,$proto) = getprotobyname('tcp');
($name,$aliases,$port) = getservbyname($port,'tcp')
    unless $port =~ /^\d+$/;;
($name,$aliases,$type,$len,$thataddr) = gethostbyname($smtpServer); #get host records from server

my $iaddr = inet_aton($smtpServer);  
$that = sockaddr_in($port, $iaddr);

read(STDIN , $buffer , $ENV{'CONTENT_LENGTH'}); 
@pairs = split(/&/ , $buffer); 
foreach $pair (@pairs)
{
    ($name,  $value) = split(/=/, $pair);
    $value =~ tr/+/ /;              #Translate + to <space>
    $value =~ s/%0D/ /g;
    $value =~ s/%0A/ /g;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;    #Convert Hex values
    $value =~ s/~!/ ~!/g;
    $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; #Do the same for the names
    $name =~ s/~!/ ~!/g;
    $FORM{$name} .= ';' if (defined($FORM{$name})); #Seperate multi values with ;
    $FORM{$name} .= $value;             #Add the value to the control name key
}

if($FORM{':COOKIE:'})
{
    if($ENV{'HTTP_COOKIE'} =~ /\QSURVEY=$FORM{':SURVEY:'}/)   {
        print "Content-type:text/html\n\n";
            print "\n\n";
        print "<HTML>\n";
        print "<HEAD><TITLE>Data Received</TITLE></HEAD>\n";
            print "<BODY BGCOLOR=\"#FFFFFF\">\n";
        print "<FONT FACE=ARIAL>\n";
            print "<CENTER><H2>Repeat Submission</H2>\n";
            print "<P>You have already submitted data to this survey.Only one submission is allowed.\n";
        print "<P><a href=\"$sReturnURL\">$sReturnText</a>\n";
        print "</CENTER>\n";
        print "</FONT></BODY></HTML>\n";
            exit;
    }
}
$recipient = $FORM{':EMAIL:'};              #Get address from hidden Email control
#Check for malicous use of recipient
if ($recipient =~ />|<|;|\\|\// ) {
#Change this message to change the page returned when the email address cannot be used
    print "Content-type:text/html\n\n";
    print "\n\n";
        print "<HEAD><TITLE>Invalid Email Address</TITLE></HEAD>\n";
        print "<BODY BGCOLOR=\"#FFFFFF\">\n";
        print "<CENTER><H2>The system is unable to process the</H2><BR><BR>\n";
    print "<CENTER><H2>email address in this form.</H2><BR><BR>\n";
        print "Please report this error to $sWebMaster.</center>\n";
        print "</BODY>\n";
        exit;
}

if($FORM{':RECEIPT:'})
{
    $theQ = $FORM{':RECEIPT:'};
    $sender = $FORM{$theQ};             #Get address from hidden Email control
    #Check for malicous use of sender email
    if(length($sender)==0)
    {
        print "\n\n";
            #print "Content-type:text/html\n\n";
            print "<HEAD><TITLE>No Email Address</TITLE></HEAD>\n";
            print "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\" LINK=\"#0000ff\" VLINK=\"0000ff\">\n";
        if($FORM{':RECEIPTLBL:'})
        {
            print "<CENTER><H2>You have not given a contact email in $FORM{':RECEIPTLBL:'}.</H2><BR><BR>\n";
        }
        else
        {
                print "<CENTER><H2>You have not given a contact email.</H2><BR><BR>\n";
        }
        print "<CENTER><H2>The address must be given so a receipt can be sent</H2><BR><BR>\n";
            print "Please use the back button on your browser to return to the questionnaire and enter an address.</center>\n";
            print "</BODY>\n";
            exit;
    }
}

if (!socket(S, PF_INET, SOCK_STREAM, $proto)) {
    die $!;
}

if (!connect(S,$that)) {
    die $!;
}

select (S);
$|=1;               # flush
select (STDOUT);
$|=1;               # flush

#set up ESMTP session here
$stat = <S>;
die("500 fatal: bad message on connect: $stat") if ($stat !~ /^2/);
print S "HELO $domain\r\n";
$stat = <S>;
die("500 fatal: bad message on HELO: $stat") if ($stat !~ /^2/);
print S "MAIL FROM:<surveyScript\@$domain>\r\n";
$stat = <S>;
die("500 fatal: bad message on MAIL FROM: $stat") if ($stat !~ /^2/);
print S "RCPT TO:<$FORM{':EMAIL:'}>";
print S "\r\n";
$stat = <S>;
die("500 fatal: bad message on RCPT TO: $stat") if ($stat !~ /^2/);
print S "DATA\r\n";
$stat= <S>;
print S "To: $FORM{':EMAIL:'} \n";

print S"Subject: Internet submission of $FORM{':SURVEY:'} data\n\n";

print S "***START SURVEY DATA***\n";
my $doEscape = $FORM{':MSGENCODE:'} ? 1 : 0;
if ($doEscape)
{
    $FORM{':MSGENCODE:'} = "2";
}
foreach $key (keys(%FORM))
{
    if ($key !~ /^:OKPAGE:$/)
    {
        my $val = $FORM{$key};
        if ($doEscape)
        {
            $val = uri_escape($val, "^A-Za-z0-9\-_.!~*'()\x20@");
        }
        print S "$key=$val\n";
    }
}
print S "***END SURVEY DATA***\n";
print S "\r\n.\r\n";
$stat= <S>;
die("500 fatal: bad message on DATA END: $stat") if ($stat !~ /^2/);
print S "QUIT\r\n";
#close socket here
close(S);

if($FORM{':COOKIE:'})
{
    print "Set-Cookie: SURVEY=$FORM{':SURVEY:'} ; expires=$FORM{':COOKIE:'}\n";
}
if($FORM{':OKPAGE:'})
{
    print "Location: $FORM{':OKPAGE:'}\n\n";
}else{
    print "Content-type:text/html\n\n";
    print "<HEAD><TITLE>Thank-you</TITLE></HEAD>\n";
    print "<BODY BGCOLOR=\"#FFFFFF\">\n";
    print "<center>\n";
    print "<h2>Thank You</h2>\n";
    print "Thank you for taking the time to answer this survey.<p>\n";
    print "Your response has been submitted succesfully to $FORM{':EMAIL:'}.<p>\n";
    print "<a href=\"$sReturnURL\">$sReturnText</a></center>\n";
    print "</body>\n";
}

错误日志显示“AH01215：Subques.pl拒绝连接”并引用此行：

if (!connect(S,$that)) {
    die $!;
}

据我所知，我的SMTP服务器和端口是可访问的，它只是拒绝连接。可能是什么问题？在进行连接时，我是否需要进行身份验证？我假设（可能是错的）它可能是我的服务器的问题。任何帮助/建议将不胜感激！

Perl脚本连接问题（Snap Surveys）

0 个答案: