line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# $Id: Layer.pm 2005 2015-01-23 06:56:13Z gomor $ |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
package Net::Write::Layer; |
5
|
1
|
|
|
1
|
|
368
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
6
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
21
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
3
|
use base qw(Exporter Class::Gomor::Array); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
541
|
|
9
|
|
|
|
|
|
|
our @AS = qw( |
10
|
|
|
|
|
|
|
dev |
11
|
|
|
|
|
|
|
dst |
12
|
|
|
|
|
|
|
protocol |
13
|
|
|
|
|
|
|
family |
14
|
|
|
|
|
|
|
_io |
15
|
|
|
|
|
|
|
_sockaddr |
16
|
|
|
|
|
|
|
); |
17
|
|
|
|
|
|
|
__PACKAGE__->cgBuildIndices; |
18
|
|
|
|
|
|
|
__PACKAGE__->cgBuildAccessorsScalar(\@AS); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub _setIpProtoIpConstant { |
21
|
1
|
|
|
1
|
|
1
|
my $val = 0; |
22
|
1
|
50
|
33
|
|
|
18
|
if (defined(&IPPROTO_IP)) { |
|
|
50
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
23
|
0
|
|
|
|
|
0
|
$val = &IPPROTO_IP; |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
elsif ($^O eq 'darwin' |
26
|
|
|
|
|
|
|
|| $^O eq 'linux' |
27
|
|
|
|
|
|
|
|| $^O eq 'freebsd' |
28
|
|
|
|
|
|
|
|| $^O eq 'openbsd' |
29
|
|
|
|
|
|
|
|| $^O eq 'netbsd' |
30
|
|
|
|
|
|
|
|| $^O eq 'aix') { |
31
|
1
|
|
|
|
|
1
|
$val = 0; |
32
|
|
|
|
|
|
|
} |
33
|
1
|
|
|
1
|
|
4
|
eval "use constant NW_IPPROTO_IP => $val;"; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
48
|
|
|
1
|
|
|
|
|
96
|
|
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub _setIpProtoIpv6Constant { |
37
|
1
|
|
|
1
|
|
1
|
my $val = 0; |
38
|
1
|
50
|
33
|
|
|
8
|
if (defined(&IPPROTO_IPv6)) { |
|
|
50
|
|
|
|
|
|
39
|
0
|
|
|
|
|
0
|
$val = &IPPROTO_IPv6; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
elsif ($^O eq 'linux' |
42
|
|
|
|
|
|
|
|| $^O eq 'freebsd') { |
43
|
1
|
|
|
|
|
1
|
$val = 41; |
44
|
|
|
|
|
|
|
} |
45
|
1
|
|
|
1
|
|
6
|
eval "use constant NW_IPPROTO_IPv6 => $val;"; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
44
|
|
|
1
|
|
|
|
|
56
|
|
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub _setIpProtoRawConstant { |
49
|
1
|
|
|
1
|
|
1
|
my $val = 255; |
50
|
1
|
50
|
33
|
|
|
12
|
if (defined(&IPPROTO_RAW)) { |
|
|
50
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
51
|
0
|
|
|
|
|
0
|
$val = &IPPROTO_RAW; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
elsif ($^O eq 'darwin' |
54
|
|
|
|
|
|
|
|| $^O eq 'linux' |
55
|
|
|
|
|
|
|
|| $^O eq 'freebsd' |
56
|
|
|
|
|
|
|
|| $^O eq 'openbsd' |
57
|
|
|
|
|
|
|
|| $^O eq 'netbsd' |
58
|
|
|
|
|
|
|
|| $^O eq 'aix') { |
59
|
1
|
|
|
|
|
3
|
$val = 255; |
60
|
|
|
|
|
|
|
} |
61
|
1
|
|
|
1
|
|
3
|
eval "use constant NW_IPPROTO_RAW => $val;"; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
26
|
|
|
1
|
|
|
|
|
59
|
|
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub _setIpHdrInclConstant { |
65
|
1
|
|
|
1
|
|
1
|
my $val = 2; |
66
|
1
|
50
|
33
|
|
|
22
|
if (defined(&IP_HDRINCL)) { |
|
|
50
|
33
|
|
|
|
|
|
|
0
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
67
|
0
|
|
|
|
|
0
|
$val = &IP_HDRINCL; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
elsif ($^O eq 'darwin' |
70
|
|
|
|
|
|
|
|| $^O eq 'freebsd' |
71
|
|
|
|
|
|
|
|| $^O eq 'openbsd' |
72
|
|
|
|
|
|
|
|| $^O eq 'netbsd' |
73
|
|
|
|
|
|
|
|| $^O eq 'linux' |
74
|
|
|
|
|
|
|
|| $^O eq 'aix' |
75
|
|
|
|
|
|
|
|| $^O eq 'cygwin') { |
76
|
1
|
|
|
|
|
2
|
$val = 2; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
elsif ($^O eq 'hpux') { |
79
|
0
|
|
|
|
|
0
|
$val = 0x1002; |
80
|
|
|
|
|
|
|
} |
81
|
1
|
|
|
1
|
|
4
|
eval "use constant NW_IP_HDRINCL => $val;"; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
43
|
|
|
1
|
|
|
|
|
47
|
|
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# |
85
|
|
|
|
|
|
|
# ACF - This could result in NW_AF_INET6 => 0 if neither |
86
|
|
|
|
|
|
|
# Socket6::AF_INET6 nor Socket::AF_INET6 is defined. My change |
87
|
|
|
|
|
|
|
# doesn't preserve that, but it isn't clear that was an intended or |
88
|
|
|
|
|
|
|
# useful feature. |
89
|
|
|
|
|
|
|
# |
90
|
|
|
|
|
|
|
#sub _setAfinet6Constant { |
91
|
|
|
|
|
|
|
# require Socket6; |
92
|
|
|
|
|
|
|
# require Socket; |
93
|
|
|
|
|
|
|
# my $val = 0; |
94
|
|
|
|
|
|
|
# if (defined(&Socket6::AF_INET6)) { |
95
|
|
|
|
|
|
|
# $val = &Socket6::AF_INET6; |
96
|
|
|
|
|
|
|
# } |
97
|
|
|
|
|
|
|
# elsif (defined(&Socket::AF_INET6)) { |
98
|
|
|
|
|
|
|
# $val = &Socket::AF_INET6; |
99
|
|
|
|
|
|
|
# } |
100
|
|
|
|
|
|
|
# eval "use constant NW_AF_INET6 => $val;"; |
101
|
|
|
|
|
|
|
#} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
BEGIN { |
104
|
1
|
|
|
1
|
|
4
|
my $osname = { |
105
|
|
|
|
|
|
|
cygwin => \&_checkWin32, |
106
|
|
|
|
|
|
|
MSWin32 => \&_checkWin32, |
107
|
|
|
|
|
|
|
}; |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
{ |
110
|
1
|
|
|
1
|
|
10096
|
no strict 'refs'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
59
|
|
|
1
|
|
|
|
|
2
|
|
111
|
1
|
|
50
|
|
|
10
|
*{ __PACKAGE__ . "::_check" } = $osname->{$^O} || \&_checkOther; |
|
1
|
|
|
|
|
4
|
|
112
|
|
|
|
|
|
|
} |
113
|
1
|
|
|
|
|
3
|
_setIpProtoIpConstant(); |
114
|
1
|
|
|
|
|
2
|
_setIpProtoIpv6Constant(); |
115
|
1
|
|
|
|
|
3
|
_setIpProtoRawConstant(); |
116
|
1
|
|
|
|
|
2
|
_setIpHdrInclConstant(); |
117
|
|
|
|
|
|
|
#_setAfinet6Constant(); |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
1
|
|
|
1
|
|
513
|
use Socket qw(:DEFAULT AF_INET); |
|
1
|
|
|
|
|
2939
|
|
|
1
|
|
|
|
|
858
|
|
121
|
|
|
|
|
|
|
BEGIN { |
122
|
|
|
|
|
|
|
# imports that may or may not be in Socket. |
123
|
1
|
|
|
1
|
|
3
|
my @imports = (qw(AF_INET6 getaddrinfo)); |
124
|
1
|
|
|
|
|
1
|
my @socket6_imports; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# This might be overkill, but I'm not certain that all these imports |
127
|
|
|
|
|
|
|
# were added to Socket at the same time. |
128
|
1
|
|
|
|
|
1
|
for my $import (@imports) { |
129
|
2
|
|
|
|
|
2
|
eval { Socket->import($import); }; |
|
2
|
|
|
|
|
43
|
|
130
|
2
|
50
|
|
|
|
5
|
if ($@) { |
131
|
0
|
|
|
|
|
0
|
push @socket6_imports, $import; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
1
|
50
|
|
|
|
20
|
if (@socket6_imports) { |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# something we want wasn't found in Socket time to try Socket6 |
138
|
0
|
|
|
|
|
0
|
eval { require Socket6 }; |
|
0
|
|
|
|
|
0
|
|
139
|
0
|
0
|
|
|
|
0
|
die $@ if $@; |
140
|
0
|
|
|
|
|
0
|
Socket6->import(@socket6_imports); |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
1
|
|
|
1
|
|
6
|
no strict 'vars'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
21
|
|
145
|
|
|
|
|
|
|
|
146
|
1
|
|
|
1
|
|
451
|
use IO::Socket; |
|
1
|
|
|
|
|
14712
|
|
|
1
|
|
|
|
|
5
|
|
147
|
1
|
|
|
1
|
|
1770
|
use Net::Pcap; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
use constant NW_AF_INET => AF_INET(); |
150
|
|
|
|
|
|
|
use constant NW_AF_INET6 => AF_INET6(); |
151
|
|
|
|
|
|
|
use constant NW_AF_UNSPEC => AF_UNSPEC(); |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
use constant NW_IPPROTO_ICMPv4 => 1; |
154
|
|
|
|
|
|
|
use constant NW_IPPROTO_TCP => 6; |
155
|
|
|
|
|
|
|
use constant NW_IPPROTO_UDP => 17; |
156
|
|
|
|
|
|
|
use constant NW_IPPROTO_ICMPv6 => 58; |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( |
159
|
|
|
|
|
|
|
constants => [qw( |
160
|
|
|
|
|
|
|
NW_AF_INET |
161
|
|
|
|
|
|
|
NW_AF_INET6 |
162
|
|
|
|
|
|
|
NW_AF_UNSPEC |
163
|
|
|
|
|
|
|
NW_IPPROTO_IP |
164
|
|
|
|
|
|
|
NW_IPPROTO_IPv6 |
165
|
|
|
|
|
|
|
NW_IPPROTO_ICMPv4 |
166
|
|
|
|
|
|
|
NW_IPPROTO_TCP |
167
|
|
|
|
|
|
|
NW_IPPROTO_UDP |
168
|
|
|
|
|
|
|
NW_IPPROTO_ICMPv6 |
169
|
|
|
|
|
|
|
NW_IP_HDRINCL |
170
|
|
|
|
|
|
|
NW_IPPROTO_RAW |
171
|
|
|
|
|
|
|
)], |
172
|
|
|
|
|
|
|
); |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
our @EXPORT_OK = ( |
175
|
|
|
|
|
|
|
@{$EXPORT_TAGS{constants}}, |
176
|
|
|
|
|
|
|
); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
sub _checkWin32 { |
179
|
|
|
|
|
|
|
return 1; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub _checkOther { |
183
|
|
|
|
|
|
|
if ($>) { |
184
|
|
|
|
|
|
|
print STDERR "[-] Must be EUID 0 (or equivalent) to open a device for ". |
185
|
|
|
|
|
|
|
"writing.\n"; |
186
|
|
|
|
|
|
|
return; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
return 1; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
sub new { |
193
|
|
|
|
|
|
|
my $self = shift->SUPER::new( |
194
|
|
|
|
|
|
|
@_, |
195
|
|
|
|
|
|
|
); |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
_check() or return; |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
return $self; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub _croak { |
203
|
|
|
|
|
|
|
my ($msg) = @_; |
204
|
|
|
|
|
|
|
print STDERR "[-] $msg\n"; |
205
|
|
|
|
|
|
|
return; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub open { |
209
|
|
|
|
|
|
|
my $self = shift; |
210
|
|
|
|
|
|
|
my ($hdrincl) = @_; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
my @res = getaddrinfo($self->[$__dst], 0, $self->[$__family], SOCK_STREAM) |
213
|
|
|
|
|
|
|
or return _croak("@{[(caller(0))[3]]}: getaddrinfo: $!"); |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
my ($family, $saddr) = @res[0, 3] if @res >= 5; |
216
|
|
|
|
|
|
|
$self->[$___sockaddr] = $saddr; |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
socket(my $s, $family, SOCK_RAW, $self->[$__protocol]) |
219
|
|
|
|
|
|
|
or return _croak("@{[(caller(0))[3]]}: socket: $!"); |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
my $fd = fileno($s) |
222
|
|
|
|
|
|
|
or return _croak("@{[(caller(0))[3]]}: fileno: $!"); |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
if ($hdrincl) { |
225
|
|
|
|
|
|
|
$self->_setIpHdrincl($s, $self->[$__family]) |
226
|
|
|
|
|
|
|
or return _croak("@{[(caller(0))[3]]}: setsockopt: $!"); |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
my $io = IO::Socket->new; |
230
|
|
|
|
|
|
|
$io->fdopen($fd, 'w') |
231
|
|
|
|
|
|
|
or return _croak("@{[(caller(0))[3]]}: fdopen: $!"); |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
$self->[$___io] = $io; |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
return 1; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub send { |
239
|
|
|
|
|
|
|
my $self = shift; |
240
|
|
|
|
|
|
|
my ($raw) = @_; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
while (1) { |
243
|
|
|
|
|
|
|
my $ret = CORE::send($self->_io, $raw, 0, $self->_sockaddr); |
244
|
|
|
|
|
|
|
unless ($ret) { |
245
|
|
|
|
|
|
|
if ($!{ENOBUFS}) { |
246
|
|
|
|
|
|
|
$self->cgDebugPrint(2, "ENOBUFS returned, sleeping for 1 second"); |
247
|
|
|
|
|
|
|
sleep 1; |
248
|
|
|
|
|
|
|
next; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
elsif ($!{EHOSTDOWN}) { |
251
|
|
|
|
|
|
|
$self->cgDebugPrint(2, "host is down"); |
252
|
|
|
|
|
|
|
last; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
print STDERR "[!] @{[(caller(0))[3]]}: $!\n"; |
255
|
|
|
|
|
|
|
return; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
last; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
return 1; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub close { shift->_io->close } |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
1; |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
__END__ |