line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package XAS::Lib::Mixins::Keepalive; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
our $TCP_KEEPCNT = 0; |
6
|
|
|
|
|
|
|
our $TCP_KEEPIDLE = 0; |
7
|
|
|
|
|
|
|
our $TCP_KEEPINTVL = 0; |
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
844
|
use Try::Tiny; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
49
|
|
10
|
1
|
|
|
1
|
|
5
|
use Socket ':all'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
930
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
use XAS::Class |
13
|
1
|
|
|
|
|
9
|
debug => 0, |
14
|
|
|
|
|
|
|
version => $VERSION, |
15
|
|
|
|
|
|
|
base => 'XAS::Base', |
16
|
|
|
|
|
|
|
utils => ':validation', |
17
|
|
|
|
|
|
|
accessors => 'tcp_keepidle tcp_keepcnt tcp_keepintvl', |
18
|
|
|
|
|
|
|
mixins => 'init_keepalive enable_keepalive tcp_keepidle tcp_keepcnt tcp_keepintvl', |
19
|
1
|
|
|
1
|
|
5
|
; |
|
1
|
|
|
|
|
1
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# ---------------------------------------------------------------------- |
22
|
|
|
|
|
|
|
# Public Methods |
23
|
|
|
|
|
|
|
# ---------------------------------------------------------------------- |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub enable_keepalive { |
26
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
27
|
0
|
|
|
|
|
|
my ($socket) = validate_params(\@_, [1]); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# turn keepalive on, this should send a keepalive |
30
|
|
|
|
|
|
|
# packet once every 2 hours according to the RFC. |
31
|
|
|
|
|
|
|
|
32
|
0
|
|
|
|
|
|
setsockopt($socket, SOL_SOCKET, SO_KEEPALIVE, 1); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# adjust the system defaults, all values are in seconds. |
35
|
|
|
|
|
|
|
# so this does the following: |
36
|
|
|
|
|
|
|
# every 15 minutes send up to 3 packets at 5 second intervals |
37
|
|
|
|
|
|
|
# if no reply, the connection is down. |
38
|
|
|
|
|
|
|
|
39
|
0
|
|
|
|
|
|
setsockopt($socket, IPPROTO_TCP, $TCP_KEEPINTVL, $self->tcp_keepintvl); |
40
|
0
|
|
|
|
|
|
setsockopt($socket, IPPROTO_TCP, $TCP_KEEPIDLE, $self->tcp_keepidle); |
41
|
0
|
|
|
|
|
|
setsockopt($socket, IPPROTO_TCP, $TCP_KEEPCNT, $self->tcp_keepcnt); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# ---------------------------------------------------------------------- |
46
|
|
|
|
|
|
|
# Private Methods |
47
|
|
|
|
|
|
|
# ---------------------------------------------------------------------- |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub init_keepalive { |
50
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
51
|
0
|
|
|
|
|
|
my $p = validate_params(\@_, { |
52
|
|
|
|
|
|
|
-tcp_keepcnt => { optional => 1, default => 3 }, # number of packets |
53
|
|
|
|
|
|
|
-tcp_keepidle => { optional => 1, default => 900 }, # 15 minutes |
54
|
|
|
|
|
|
|
-tcp_keepintvl => { optional => 1, default => 5 }, # interval seconds |
55
|
|
|
|
|
|
|
}); |
56
|
|
|
|
|
|
|
|
57
|
0
|
|
|
|
|
|
$self->{'tcp_keepcnt'} = $p->{'tcp_keepcnt'}; |
58
|
0
|
|
|
|
|
|
$self->{'tcp_keepidle'} = $p->{'tcp_keepidle'}; |
59
|
0
|
|
|
|
|
|
$self->{'tcp_keepintvl'} = $p->{'tcp_keepintvl'}; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# implement socket level keepalive, what a mess... |
62
|
|
|
|
|
|
|
|
63
|
0
|
0
|
|
|
|
|
if ( $] < 5.014 ) { # check perl's version |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# at this point we can only support the below. if you have |
66
|
|
|
|
|
|
|
# access to your systems header files, you could provide |
67
|
|
|
|
|
|
|
# the following values. I would be happy to include them. |
68
|
|
|
|
|
|
|
|
69
|
0
|
0
|
|
|
|
|
if ($^O eq "aix") { # from /usr/include/netinet/tcp.h |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
70
|
|
|
|
|
|
|
|
71
|
0
|
|
|
|
|
|
$TCP_KEEPIDLE = 0x11; |
72
|
0
|
|
|
|
|
|
$TCP_KEEPINTVL = 0x12; |
73
|
0
|
|
|
|
|
|
$TCP_KEEPCNT = 0x13; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
} elsif ($^O eq "linux") { # from /usr/include/netinet/tcp.h |
76
|
|
|
|
|
|
|
|
77
|
0
|
|
|
|
|
|
$TCP_KEEPIDLE = 4; |
78
|
0
|
|
|
|
|
|
$TCP_KEEPINTVL = 5; |
79
|
0
|
|
|
|
|
|
$TCP_KEEPCNT = 6; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
} elsif ($^O eq 'vms') { # from TCP in sys$library:decc$rtldef.tlb |
82
|
|
|
|
|
|
|
|
83
|
0
|
|
|
|
|
|
$TCP_KEEPIDLE = 0x04; |
84
|
0
|
|
|
|
|
|
$TCP_KEEPINTVL = 0x05; |
85
|
0
|
|
|
|
|
|
$TCP_KEEPCNT = 0x06; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
} else { |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
try { |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# hmmm, maybe perl will do it for us. checking to see if the |
94
|
|
|
|
|
|
|
# platform implements these macros. |
95
|
|
|
|
|
|
|
|
96
|
0
|
0
|
|
0
|
|
|
$TCP_KEEPCNT = Socket::TCP_KEEPCNT() if (UNIVERSAL::can('Socket', 'TCP_KEEPCNT')); |
97
|
0
|
0
|
|
|
|
|
$TCP_KEEPIDLE = Socket::TCP_KEEPIDLE() if (UNIVERSAL::can('Socket', 'TCP_KEEPIDLE')); |
98
|
0
|
0
|
|
|
|
|
$TCP_KEEPINTVL = Socket::TCP_KEEPINTVL() if (UNIVERSAL::can('Socket', 'TCP_KEEPINTVL')); |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
} catch { |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# nope, guess not... |
103
|
|
|
|
|
|
|
|
104
|
0
|
|
|
0
|
|
|
my $ex = $_; |
105
|
0
|
|
|
|
|
|
my ($err) = m/(.*,)/; |
106
|
0
|
|
|
|
|
|
chop($err); |
107
|
|
|
|
|
|
|
|
108
|
0
|
|
|
|
|
|
$self->log->warn(lcfirst($err)); |
109
|
|
|
|
|
|
|
|
110
|
0
|
|
|
|
|
|
}; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
1; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
__END__ |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=head1 NAME |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
XAS::Lib::Mixin::Keepalive - A mixin to implement TCP keepalive |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head1 SYNOPSIS |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
use XAS::Class |
127
|
|
|
|
|
|
|
version => '0.01', |
128
|
|
|
|
|
|
|
base => 'XAS::Base', |
129
|
|
|
|
|
|
|
mixin => 'XAS::Lib::Mixin::Keepalive' |
130
|
|
|
|
|
|
|
; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head1 DESCRIPTION |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
This module is a mixin class to share code for initializing TCP level |
135
|
|
|
|
|
|
|
keepalives. |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=head1 METHODS |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=head2 init_keepalive |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
This will attempt to define the necessary variables to allow TCP keepalive |
142
|
|
|
|
|
|
|
to function. Not all Perl's and OS's define the necessary values. |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=head2 enable_keepalive($socket) |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
This will enable keepalive on the given socket. By default this will |
147
|
|
|
|
|
|
|
initialize keepalive to the RFC minimal, i.e. send a keepalive packet |
148
|
|
|
|
|
|
|
once every 2 hours. If the OS supports it, this will be modified to |
149
|
|
|
|
|
|
|
send up to 3 keepalive packets once every 15 minutes. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
This should fix those pesky firewalls... |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=over 4 |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=item B<$socket> |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
The socket to enable keepalive on. |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=back |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head1 SEE ALSO |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=over 4 |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=item L<XAS|XAS> |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=back |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=head1 AUTHOR |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
Kevin L. Esteb, E<lt>kevin@kesteb.usE<gt> |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
Copyright (C) 2014 Kevin L. Esteb |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
178
|
|
|
|
|
|
|
the terms of the Artistic License 2.0. For details, see the full text |
179
|
|
|
|
|
|
|
of the license at http://www.perlfoundation.org/artistic_license_2_0. |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=cut |