File Coverage

blib/lib/Metabrik/Network/Read.pm
Criterion Covered Total %
statement 9 115 7.8
branch 0 54 0.0
condition 0 22 0.0
subroutine 3 14 21.4
pod 2 11 18.1
total 14 216 6.4


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # network::read Brik
5             #
6             package Metabrik::Network::Read;
7 2     2   17 use strict;
  2         4  
  2         56  
8 2     2   10 use warnings;
  2         4  
  2         63  
9              
10 2     2   11 use base qw(Metabrik::Network::Frame);
  2         4  
  2         1903  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable ethernet ip raw socket) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             device => [ qw(device) ],
20             rtimeout => [ qw(seconds) ],
21             family => [ qw(ipv4|ipv6) ],
22             protocol => [ qw(tcp|udp) ],
23             layer => [ qw(2|3|4) ],
24             filter => [ qw(pcap_filter) ],
25             filter_code_optimizer => [ qw(0|1) ],
26             count => [ qw(count) ],
27             _dump => [ qw(INTERNAL) ],
28             },
29             attributes_default => {
30             layer => 2,
31             count => 0,
32             family => 'ipv4',
33             protocol => 'tcp',
34             rtimeout => 5,
35             filter => '',
36             filter_code_optimizer => 0,
37             },
38             commands => {
39             open => [ qw(layer|OPTIONAL device|OPTIONAL filter|OPTIONAL) ],
40             read => [ ],
41             read_next => [ qw(count) ],
42             read_until_timeout => [ qw(count timeout|OPTIONAL) ],
43             close => [ ],
44             has_timeout => [ ],
45             reset_timeout => [ ],
46             reply => [ qw(frame) ],
47             to_simple => [ qw(frame|$frame_list) ],
48             },
49             require_modules => {
50             'Net::Frame::Dump' => [ ],
51             'Net::Frame::Dump::Online2' => [ ],
52             },
53             };
54             }
55              
56             sub brik_use_properties {
57 0     0 1   my $self = shift;
58              
59             return {
60 0   0       attributes_default => {
61             device => defined($self->global) && $self->global->device || 'eth0',
62             },
63             };
64             }
65              
66             sub open {
67 0     0 0   my $self = shift;
68 0           my ($layer, $device, $filter) = @_;
69              
70 0 0         $self->brik_help_run_must_be_root('open') or return;
71              
72 0   0       $layer ||= 2;
73 0   0       $device ||= $self->device;
74 0   0       $filter ||= $self->filter;
75              
76 0 0         my $family = $self->family eq 'ipv6' ? 'ip6' : 'ip';
77              
78 0 0         my $protocol = defined($self->protocol) ? $self->protocol : 'tcp';
79              
80 0           my $dump;
81 0 0         if ($layer == 2) {
    0          
82 0           $self->log->debug("open: timeoutOnNext: ".$self->rtimeout);
83 0           $self->log->debug("open: filter: ".$filter);
84              
85 0 0         $dump = Net::Frame::Dump::Online2->new(
86             dev => $device,
87             timeoutOnNext => $self->rtimeout,
88             filter => $filter,
89             filterCodeOptimizer => $self->filter_code_optimizer,
90             ) or return $self->log->error("open: Net::Frame::Dump::Online2->new failed");
91             }
92             elsif ($self->layer != 3) {
93 0           return $self->log->error("open: not implemented");
94             }
95              
96             $dump->start
97 0 0         or return $self->log->error("open: Net::Frame::Dump::Online2->start ".
98             "failed with device [$device], filter [$filter] and layer [$layer]");
99              
100 0           return $self->_dump($dump);
101             }
102              
103             sub read {
104 0     0 0   my $self = shift;
105              
106 0           my $dump = $self->_dump;
107 0 0         $self->brik_help_run_undef_arg('open', $dump) or return;
108              
109 0           my @next = ();
110 0           my $count = 0;
111 0           while (my $next = $dump->next) {
112 0           $self->log->verbose("read: read ".++$count." packet(s)");
113 0 0         if (ref($next) eq 'ARRAY') {
114 0           push @next, @$next;
115             }
116             else {
117 0           push @next, $next;
118             }
119             }
120              
121 0           return \@next;
122             }
123              
124             sub read_next {
125 0     0 0   my $self = shift;
126 0           my ($count) = @_;
127              
128 0   0       $count ||= $self->count;
129 0           my $dump = $self->_dump;
130 0 0         $self->brik_help_run_undef_arg('open', $dump) or return;
131              
132 0           my @next = ();
133 0           my $read_count = 0;
134 0           while (1) {
135 0           my $next = $dump->next;
136 0 0         if (defined($next)) {
137 0           $read_count++;
138 0           push @next, $next;
139 0           $self->log->debug("read_next: read $read_count packet(s)");
140 0 0         last if $read_count >= $count;
141             }
142             }
143              
144 0           return \@next;
145             }
146              
147             sub read_until_timeout {
148 0     0 0   my $self = shift;
149 0           my ($count, $rtimeout) = @_;
150              
151 0   0       $count ||= $self->count;
152 0   0       $rtimeout ||= $self->rtimeout;
153 0           my $dump = $self->_dump;
154 0 0         $self->brik_help_run_undef_arg('open', $dump) or return;
155              
156 0           my $prev = $dump->timeoutOnNext;
157 0           $dump->timeoutOnNext($rtimeout);
158              
159 0           $self->log->debug("next_until_timeout: will read until [$rtimeout] ".
160             "seconds or [$count] packet(s) have been read");
161              
162 0           my $read_count = 0;
163 0           my @next = ();
164 0           while (! $dump->timeout) {
165 0 0 0       if ($count && $read_count >= $count) {
166 0           last;
167             }
168            
169 0 0         if (my $next = $dump->next) {
170 0           push @next, $next;
171 0           $read_count++;
172             }
173             }
174              
175 0 0         if ($self->log->level > 2) {
176 0 0         if ($dump->timeout) {
177 0           $self->log->debug("next_until_timeout: timeout reached after [$rtimeout]");
178             }
179             else {
180 0           $self->log->debug("next_until_timeout: packet count reached after [$read_count]");
181             }
182             }
183              
184 0           $dump->timeoutOnNext($prev);
185              
186 0           return \@next;
187             }
188              
189             sub reply {
190 0     0 0   my $self = shift;
191 0           my ($frame) = @_;
192              
193 0           my $dump = $self->_dump;
194 0 0         $self->brik_help_run_undef_arg('open', $dump) or return;
195 0 0         $self->brik_help_run_undef_arg('reply', $frame) or return;
196 0 0         $self->brik_help_run_invalid_arg('reply', $frame, 'Net::Frame::Simple') or return;
197              
198 0           return $dump->getFramesFor($frame);
199             }
200              
201             sub has_timeout {
202 0     0 0   my $self = shift;
203              
204 0           my $dump = $self->_dump;
205             # We do not check for openness, simply returns 0 is ok to say we don't have a timeout now.
206 0 0         if (! defined($dump)) {
207 0           $self->log->debug("has_timeout: here: has_timeout [0]");
208 0           return 0;
209             }
210              
211 0           my $has_timeout = $dump->timeout;
212 0           $self->log->debug("has_timeout: has_timeout [$has_timeout]");
213              
214 0           return $has_timeout;
215             }
216              
217             sub reset_timeout {
218 0     0 0   my $self = shift;
219              
220 0           my $dump = $self->_dump;
221             # We do not check for openness, simply returns 1 is ok to say no need for timeout reset.
222 0 0         if (! defined($dump)) {
223 0           return 1;
224             }
225              
226 0           return $dump->timeoutReset;
227             }
228              
229             sub close {
230 0     0 0   my $self = shift;
231              
232 0           my $dump = $self->_dump;
233 0 0         if (! defined($dump)) {
234 0           return 1;
235             }
236              
237             # Free saved frames.
238 0           $self->log->debug("close: flush frames");
239 0           $dump->flush;
240              
241 0           $self->log->debug("close: closing dump...");
242 0           $dump->stop;
243 0           $self->_dump(undef);
244 0           $self->log->debug("close: closing dump...done");
245              
246 0           return 1;
247             }
248              
249             sub to_simple {
250 0     0 0   my $self = shift;
251 0           my ($frames) = @_;
252              
253 0 0         $self->brik_help_run_undef_arg('to_simple', $frames) or return;
254 0 0         my $ref = $self->brik_help_run_invalid_arg('to_simple', $frames, 'ARRAY', 'SCALAR')
255             or return;
256 0 0         if ($ref eq 'ARRAY') {
257 0 0         $self->brik_help_run_empty_array_arg('to_simple', $frames) or return;
258             }
259              
260 0           return $self->from_read($frames);
261             }
262              
263             1;
264              
265             __END__