perl - 本地主机的 AnyEvent tcp 服务器-客户端示例在不使用 TLS 时挂起

问题描述

在 Windows 上调试AnyEvent失败的测试时，我基于测试80_ssltest.t创建了以下脚本：

use feature qw(say);
use strict;
use warnings;
use AnyEvent::Socket;
use AnyEvent::Handle;
use AnyEvent::TLS;

my $ctx = AnyEvent::TLS->new( cert_file => $0 );
my $server_done = AnyEvent->condvar;
my $client_done = AnyEvent->condvar;
my $server_port = AnyEvent->condvar;
my $host = "127.0.0.1";

my $server = tcp_server(
    $host,
    undef,   # service: must be either a service name or a numeric port number
             #   (or 0 or undef, in which case an ephemeral port will be used).
             #
    sub { # This is the accept callback..
        my ($fh, $host, $port) = @_;

        say "server_accept";
        my $hd; $hd = AnyEvent::Handle->new(
            #tls      => "accept",
            #tls_ctx  => $ctx,
            fh       => $fh,
            timeout  => 8,
            on_error => sub {
                say "server_error <$_[2]>";
                $server_done->send; undef $hd;
            },
            on_eof   => sub {
                say "server_eof";
                $server_done->send; undef $hd;
            }
        );

        $hd->push_read (
            line => sub {
                say "server got line <$_[1]>";
            }
        );

    },  # end of accept callback..
    sub {  # This is the prepare callback
        say "server_listen";
        $server_port->send ($_[2]);
   }
);

my $port = $server_port->recv;   # At this point the server should be listening...
my $hd; $hd = AnyEvent::Handle->new(
    connect    => [$host, $port],
    #tls        => "connect",
    #tls_ctx    => $ctx,
    timeout    => 8,
    on_connect => sub {
        say "client_connect";
    },
    on_error   => sub {
        say "client_error <$_[2]>";
        $client_done->send; undef $hd;
    },
    on_eof     => sub {
        say "client_eof";
        $client_done->send; undef $hd;
    }
);

$hd->push_write ("1\n");
say "Sleeping..";
sleep 1;

$hd->on_drain (sub {
   say "client_drain";
   $client_done->send;
   undef $hd;  # For some reason this does not send EOF to the server
});

say "Waiting for client done..";
$client_done->recv;
say "Waiting for server done..";
$server_done->recv;


__END__
-----BEGIN RSA PRIVATE KEY-----
MIIEpAIBAAKCAQEA02VwAqlQzCrPenkxUjawHcXzJreJ9LDhX7Bkg3E/RB6Ilm4D
LBeilCmzkY7avp57+WCiVw2qkg+kH4Ef2sd+r10UCGPh/1diLehRAzp3Ho1bixyg
w+zkDm79OnN3uHxuKigkAxx3GGz9HhQA83U+RUns+39/OnFh0RY6/f5rV2ziA9jD
6HK3Mnsuxocd46YbVdiqlQK430CgiGj8dV44JG6+R6x3r5qXDbbRtGubC29kQOUq
kYslbpTo7ml8ShyqAP6qa8BpeSIaNG1CQQ/7JkAdxSWyFHqMQ0HR3BUiaEfUElZt
DFgXcCkKB5F8jx+wYoLzlPHHZaUvfP2nueYjcwIDAQABAoIBAQCtRDMuu0ByV5R/
Od5nGFP500mcrkrwuBnBqH56DdRhLPWe9sS62xRyhEuePoykOJo8qCvnVlg8J33K
JLfLRkBb09qbleKiuyjJn+Tm1IDWFd62gtxyOjQicG41/nZeS/6vpv79XdNvvcUp
ZhPxeGN1v0XyTWomqNAX5DSuAl5Q5HxkaRYNeuLZaPYkqmEVTgYqNSes/wRLKUb6
MaVrZ9AA/oHJMmmV4evf06s7l7ICjxAWeas7CI6UGkEz8ZFoVRJsLk5xtTsnZLgf
f24/pqHz1vApPs7CsJhK2HsLZcxMPD+hmTNI/Njl51WoH8zGhkv+p88vDzybpNSF
Hpkl+ZlBAoGBAOyfjVLD0OznJKSFksoCZKS4dlPHgXUb47Qb/XchIySQ/DNO6ff9
AA6r6doDFp51A8N1GRtGQN4LKujFPOdZ5ah7zbc2PfuOJGHku0Oby+ydgHJ19eW4
s3CIM20TuzLndFPrEGFgOrt+i5qKisti2OOZhjsDwfd48vsBm9U20lUpAoGBAOS1
Chm+vA7JevPzl+acbDSiyELaNRAXZ73CX4NIxJURjsgDeOurnBtLQEQyagZbNHcx
W4pc59Ql5KDLzu/Sne8oC3pxhaWeIPhc2d3cd/8UyGtQLtN2QnilwkjHgi3x1JGb
RPRsgAV6nwn10qUrze1XLkHsTCRI4QYD/k0uXcs7AoGBAMStJaFag2i2Ax4ArG7e
KFtFu4yNckwtv0kwTrBbScOWAxp+iDiJASgwunJsSLuylUs8JH8oGLi23ZaWgrXl
Yd918BpNqp1Rm2oG3aQndguZKm95Hscvi26Itv39/YYlHeq2omndu1OmrlDowM6m
vZIIRKr+x5Vz4brCro09QPxpAoGARJAdghBTEl/Gc2HgdOsJ6VGvlZMS+0r498NQ
nOvwuvuzgTTBSG1+9BPAJXGzpUosVVs/pSArA8eEXcwbsnvCixLHNiLYPQlFuw8i
5UcV1iul1b4I+63lSYPv1Z+x4BIydqBEsL3iN0JGcVb3mjqilndfT7YGMY6DnykN
UJgI2EcCgYAMfZHnD06XFM8ny+NsFILItpGqjCmAhkEPGwl1Zhy5Hx16CFDPDwGt
CmIbxNSLsDyiiK+i5tuSUFhV2Bw/iT539979INTIdNL1ughfhATR8MVNiOKCvZBa
uoEeE19szmG7Mj2eV2IDH0e8iaikjRFcfN89s39tNn1AjBNmEccUJA==
-----END RSA PRIVATE KEY-----
-----
-----BEGIN CERTIFICATE-----
MIIDHTCCAgWgAwIBAgIJAPASTbY2HCx0MA0GCSqGSIb3DQEBBQUAMBMxETAPBgNV
BAMTCEFueUV2ZW50MB4XDTEyMDQwNTA1NTk1MFoXDTM3MDQwNTA1NTk1MFowEzER
MA8GA1UEAxMIQW55RXZlbnQwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIB
AQDTZXACqVDMKs96eTFSNrAdxfMmt4n0sOFfsGSDcT9EHoiWbgMsF6KUKbORjtq+
nnv5YKJXDaqSD6QfgR/ax36vXRQIY+H/V2It6FEDOncejVuLHKDD7OQObv06c3e4
fG4qKCQDHHcYbP0eFADzdT5FSez7f386cWHRFjr9/mtXbOID2MPocrcyey7Ghx3j
phtV2KqVArjfQKCIaPx1Xjgkbr5HrHevmpcNttG0a5sLb2RA5SqRiyVulOjuaXxK
HKoA/qprwGl5Iho0bUJBD/smQB3FJbIUeoxDQdHcFSJoR9QSVm0MWBdwKQoHkXyP
H7BigvOU8cdlpS98/ae55iNzAgMBAAGjdDByMB0GA1UdDgQWBBTHphJ9Il0PtIWD
DI9aueToXo9DYzBDBgNVHSMEPDA6gBTHphJ9Il0PtIWDDI9aueToXo9DY6EXpBUw
EzERMA8GA1UEAxMIQW55RXZlbnSCCQDwEk22NhwsdDAMBgNVHRMEBTADAQH/MA0G
CSqGSIb3DQEBBQUAA4IBAQA/vY+qg2xjNeOuDySW/VOsStEwcaiAm/t24z3TYoZG
2ZzyKuvFXolhXsalCahNPcyUxZqDAekODPRaq+geFaZrOn41cq/LABTKv5Theukv
H7IruIFARBo1pTPFCKMnDqESBdHvV1xTOcKGxGH5I9iMgiUrd/NnlAaloT/cCNFI
OwhEPsF9kBsZwJBGWrjjVttU2lzMzizS7vaSIWLBuEDObWbSXiU+IdG+nODOe2Dv
W7PL43yd4fz4HQvN4IaZrtwkd7XiKodRR1gWjLjW/3y5kuXL+DA/jkTjrRgiH8K7
lVjm7gvkULRV2POQqtc2DUVXLubQmmGSjmQmxSwFX65t
-----END CERTIFICATE-----

该脚本挂起（Ubuntu 20.04，perl 版本 5.30），但如果我使用 TLS 握手（使用和取消注释代码中的行tls）tls_ctx它工作正常。

没有 TLS 的输出是：

server_listen
Sleeping..
Waiting for client done..
client_drain
server_accept
Waiting for server done..
server got line <1>
server_error <Connection timed out>

tls使用 TLS 的输出（取消注释以and开头的 4 行之后tls_ctx）是：

server_listen
Sleeping..
Waiting for client done..
client_connect
server_accept
client_drain
Waiting for server done..
server got line <1>
server_eof

请注意，不使用 TLS 时on_connect不调用（client_connect输出中缺少），
即使不使用TLS时客户端没有连接，服务器接收到数据并打印server got line <1>……很奇怪。

知道不使用 TLS 时有什么问题吗？

标签： perlanyevent

perl - 本地主机的 AnyEvent tcp 服务器-客户端示例在不使用 TLS 时挂起

问题描述

解决方案

推荐阅读