File Coverage

blib/lib/Net/Write/Layer.pm
Criterion Covered Total %
statement 65 77 84.4
branch 10 24 41.6
condition 14 53 26.4
subroutine 18 18 100.0
pod n/a
total 107 172 62.2


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__