1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
| | # Net::NNTP::Deflate
#
# Copyright (C) 2019 Eric Wong <e@80x24.org>
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# support NNTP COMPRESS DEFLATE as specified in RFC 8054. This
# is an internal class intended for use by Net::NNTP use, only
#
# This is done via subclassing and SUPER. tie can't seem to work
# since it doesn't seem to stack and layer with IO::Socket::SSL
# (which also uses tie). PerlIO won't work, either, since Net::Cmd
# depends on sysread/syswrite semantics for timeouts.
package Net::NNTP::Deflate;
use 5.008001;
use strict;
use warnings;
use Compress::Raw::Zlib;
use base qw(Net::NNTP);
my %ZOPT = ( -WindowBits => -15, -AppendOutput => 1 );
use Errno qw(ECONNRESET);
sub compression { 'DEFLATE' }
sub wrap {
my ($class, $self) = @_;
my ($zin, $zout, $err);
($zin, $err) = Compress::Raw::Zlib::Inflate->new(%ZOPT);
$err == Z_OK or die "Inflate->new failed: $err\n";
${*$self}{net_nntp_inflate} = [ $zin, '' ];
($zout, $err) = Compress::Raw::Zlib::Deflate->new(%ZOPT);
$err == Z_OK or die "Deflate->new failed: $err\n";
${*$self}{net_nntp_deflate} = [ $zout, '', 0 ];
# We need to capture these methods now, otherwise tied calls via
# IO::Socket::SSL::SSL_HANDLE::* will infinitely recurse.
# XXX sysread/syswrite are obviously needed for wrapping,
# but I don't understand why close and fileno wrappers are needed,
# but infinite recursion ensues without them :<
for my $m (qw(sysread syswrite close fileno)) {
${*$self}{"net_nntp_$m"} = $self->can($m);
}
$class .= 'SSL' if $self->isa('IO::Socket::SSL');
bless $self, $class;
}
sub fileno {
my $self = shift;
${*$self}{net_nntp_fileno}->($self);
}
sub close {
my $self = shift;
${*$self}{net_nntp_close}->($self);
}
sub syswrite {
my ($self, undef, $len, $off) = @_;
my $de = ${*$self}{net_nntp_deflate};
my $zout = $de->[0];
$off = 0 unless defined($off);
$len = bytes::length($_[1]) unless defined($len);
my $err = $zout->deflate(substr($_[1], $off, $len), $de->[1]);
$err == Z_OK or die "->deflate failed: $err";
$err = $zout->flush($de->[1], Z_PARTIAL_FLUSH);
$err == Z_OK or die "->flush failed: $err";
my $olen = length($de->[1]);
my $w = ${*$self}{net_nntp_syswrite}->($self, $de->[1], $olen, $de->[2]);
defined($w) or return;
if ($olen == $w) { # all done!
$de->[1] = '';
$de->[2] = 0;
}
else { # try again, later
$de->[2] += $w;
}
$len;
}
# note: only intended for Net::Cmd use, so returning extra data
# beyond $len won't matter
sub sysread {
my ($self, undef, $len, $off) = @_;
if (!defined($off) || $off != length($_[1])) {
die __PACKAGE__.'::sysread is only intended for Net::Cmd use';
}
my $in = ${*$self}{net_nntp_inflate};
while (1) {
my $ioff = length($in->[1]);
my $r = ${*$self}{net_nntp_sysread}->($self, $in->[1], $len, $ioff);
$r or return $r; # $r may be undef or 0
my $err = $in->[0]->inflate($in->[1], $_[1]); # consumes $in->[1]
if ($err == Z_OK) {
$r = length($_[1]);
return $r if $r;
next;
}
return 0 if $err == Z_STREAM_END;
# some other error from ->inflate, probably not recoverable
warn "Error: $err from ".ref($in->[0])."::inflate\n";
$! = ECONNRESET;
return;
}
}
package Net::NNTP::DeflateSSL;
use base qw(Net::NNTP::Deflate Net::NNTP::_SSL);
1;
|