Perl：CGI脚本重试发送请求

问题描述

我有一个旧的CGI Perl脚本，该脚本用于重试向目标服务器发送请求，直到成功为止。它可以在CentOS 5上运行（perl 5.8.8）。现在，我想在CentOS 7（perl 5.16.3）上使用它-但据我所知它不能正常工作。而且我不知道为什么。

• 它不会从请求中读取参数
• 它没有从请求中读取POSTDATA
• 它不会将任何日志写入给定文件

在httpd错误日志中，我可以看到此日志（行引用可能不准确。）：

[星期五10月9日16：24：57.360265 2020] [cgi：error] [pid 9574] [客户端 x.x.x.x：39058] AH01215：使用未初始化的值$ postdata 串联（。）或/var/www/cgi-bin/xcg.cgi第41行的字符串。

所以我要：

• 或修复脚本
• 或找到另一个CGI脚本进行重试

脚本为：

#!/usr/bin/perl -wT
use strict;
use warnings;

use CGI;
use LWP::UserAgent;
use POSIX qw(strftime);
use IO::Handle;

my $today = strftime "%F",localtime();
open(my $log,'>>',"/tmp/forwarder.log.$today");
select((select($log),$| = 1)[0]);
sub logg {
    print $log strftime "%F %T @_\n",localtime();
}

my $xcgClientUrl = "http://myserver/";
my $retryTime = 600; # seconds
my $retryCount = 10;

my $q = CGI->new;

my $postdata = $q->param('POSTDATA');

my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(POST => $xcgClientUrl);

my $reqString = '';
# quite accurate request ID made of PID and current time
my $reqID = $$ . ' ' . (strftime "%F %T",localtime());

foreach my $key (sort(keys(%ENV))) {
    if ($key =~ m/^HTTP_(.+)$/) {
        $req->header( $1 => $ENV{$key} );
        $reqString .= "$1: $ENV{$key}\n";
    }
}

$req->content_type($q->content_type);
$req->content($postdata);
$reqString .= "\n$postdata\n";

logg("Received request ID ($reqID):\n$reqString\n");

my $stop = 0;
my $tries = 1;
my $pid = 1;
my $resp;

do {
    $resp = $ua->request($req);

    my $code = $resp->{_rc};
    if ($code == 200) {
        print $q->header(-type => $resp->header("Content-Type"));
        print $resp->{_content};
        logg("Processing request ID ($reqID) try #$tries SUCCEEDED\n");
        $stop = 1;
    } else {
        $pid = fork();
        if ($pid == 0) {
            open (STDIN,"</dev/null");
            open (STDOUT,">/dev/null");
            sleep($retryTime);
            ++$tries;
            if ($tries > $retryCount) {
                $stop = 1;
            }
        } else {
            $stop = 1;
            print $q->header(-status => 200);
            print '<?xml version="1.0" encoding="UTF-8" standalone="yes"?><response xmlns="xcg2/api/http/xcg1/response">sth else</response>';
            logg("Processing request ID ($reqID) try #$tries BUFFERED. Server responce code: $code\n");
       }
    }
} while ($stop == 0);

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）