Perl脚本使用Net::Ping检测部分域名时超时逻辑不生效

根本原因 #

两种超时方案（Time::Out模块、原生ALRM信号）均基于Perl信号机制实现，Perl 5.8+引入的安全信号机制要求信号必须在Perl解释器完成当前操作码执行后才会触发。Net::Ping的ping方法核心逻辑由XS层C函数实现，当C函数处于阻塞状态未返回时，ALRM信号会一直处于待处理状态，无法触发超时回调，最终表现为脚本卡住。

ping方法的两个阶段都可能触发长期阻塞：

• DNS解析阶段：调用系统C库的域名解析函数默认阻塞，且不响应信号，ping方法的第二个超时参数仅作用于探测阶段，不包含DNS解析耗时
• ICMP探测阶段：部分系统下ICMP探测的底层系统调用会进入不可中断睡眠状态，无法响应信号

可行解决方案 #

方案1：拆分DNS解析与探测逻辑 #

提前使用带超时控制的DNS解析模块获取域名IP，再将IP传入ping方法，避免解析阶段阻塞：

use Net::DNS::Resolver;
# 配置带超时的DNS解析
my $res = Net::DNS::Resolver->new(
    udp_timeout => 2,
    tcp_timeout => 2,
    retry => 1,
);
my $query = $res->search($domain);
my $ip;
if ($query) {
    for my $rr ($query->answer) {
        next unless $rr->type eq 'A';
        $ip = $rr->address;
        last;
    }
}
unless ($ip) {
    print "DNS解析失败，域名不可达\n";
    # 自定义失败逻辑
}
# 直接传入IP进行探测，ping方法无需再做解析
my $ping_result = $p->ping($ip, 3);

方案2：更换Net::Ping探测协议为TCP #

默认ICMP协议的系统调用容易进入不可中断状态，切换为TCP协议后探测逻辑更容易响应信号，同时可自定义探测端口（如80、443）更贴合业务场景：

# 初始化时指定TCP协议，默认超时3秒
my $p = Net::Ping->new('tcp', 3);
# 可选：指定探测端口为443，验证HTTPS服务可用性
$p->port_number(443);
my $ping_result = $p->ping($domain);

方案3：fork子进程实现超时（兼容性最高） #

完全绕开Perl安全信号限制，父进程监控超时，超时直接终止子进程，即使子进程C函数长期阻塞也能正常触发超时：

my $TIMEOUT = 5;
my $pid = fork();
die "fork失败: $!" unless defined $pid;

if ($pid == 0) {
    # 子进程执行ping逻辑
    my $res = $p->ping($domain, 5);
    exit $res ? 0 : 1;
} else {
    # 父进程监控超时
    my $is_timeout = 0;
    local $SIG{ALRM} = sub {
        $is_timeout = 1;
        kill 'KILL', $pid;
    };
    alarm($TIMEOUT);
    waitpid($pid, 0);
    alarm(0);
    
    if ($is_timeout) {
        print "ping操作超时\n";
        # 超时处理逻辑
    } else {
        my $exit_code = $? >> 8;
        if ($exit_code == 0) {
            print "ping成功\n";
        } else {
            print "ping失败\n";
        }
    }
}

内容的提问来源于stack exchange，提问作者Andrew Newby