File Coverage

blib/lib/Metabrik/Network/Write.pm
Criterion Covered Total %
statement 9 101 8.9
branch 0 60 0.0
condition 0 21 0.0
subroutine 3 12 25.0
pod 2 9 22.2
total 14 203 6.9


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # network::write Brik
5             #
6             package Metabrik::Network::Write;
7 1     1   699 use strict;
  1         2  
  1         29  
8 1     1   7 use warnings;
  1         2  
  1         28  
9              
10 1     1   5 use base qw(Metabrik);
  1         2  
  1         1299  
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             target => [ qw(ipv4_address|ipv6_address) ],
21             family => [ qw(ipv4|ipv6) ],
22             protocol => [ qw(tcp|udp) ],
23             layer => [ qw(2|3|4) ],
24             _fd => [ qw(INTERNAL) ],
25             },
26             commands => {
27             open => [ qw(layer|OPTIONAL arg2|OPTIONAL arg3|OPTIONAL) ],
28             send => [ qw($data) ],
29             lsend => [ qw($data) ],
30             nsend => [ qw($data) ],
31             tsend => [ qw($data) ],
32             fnsend_reply => [ qw($frame target_address|OPTIONAL) ],
33             close => [ ],
34             },
35             require_modules => {
36             'Net::Write::Layer' => [ ],
37             'Net::Write::Layer2' => [ ],
38             'Net::Write::Layer3' => [ ],
39             'Net::Write::Layer4' => [ ],
40             'Metabrik::Network::Read' => [ ],
41             },
42             };
43             }
44              
45             sub brik_use_properties {
46 0     0 1   my $self = shift;
47              
48             return {
49 0   0       attributes_default => {
      0        
      0        
50             layer => 2,
51             device => defined($self->global) && $self->global->device || 'eth0',
52             family => defined($self->global) && $self->global->family || 'ipv4',
53             protocol => defined($self->global) && $self->global->protocol || 'tcp',
54             },
55             };
56             }
57              
58             sub open {
59 0     0 0   my $self = shift;
60 0           my ($layer, $arg2, $arg3) = @_;
61              
62 0 0         $self->brik_help_run_must_be_root('open') or return;
63              
64 0   0       $layer ||= $self->layer;
65              
66 0 0         my $family = $self->family eq 'ipv6'
67             ? Net::Write::Layer::NW_AF_INET6()
68             : Net::Write::Layer::NW_AF_INET();
69              
70 0 0         my $protocol = $self->protocol eq 'udp'
71             ? Net::Write::Layer::NW_IPPROTO_UDP()
72             : Net::Write::Layer::NW_IPPROTO_TCP();
73              
74 0           my $fd;
75 0 0         if ($self->layer == 2) {
    0          
    0          
76 0   0       $arg2 ||= $self->device;
77              
78 0 0         $fd = Net::Write::Layer2->new(
79             dev => $arg2
80             ) or return $self->log->error("open: layer2: error");
81              
82 0           $self->log->verbose("open: layer2: success. Will use device [$arg2]");
83             }
84             elsif ($self->layer == 3) {
85 0   0       $arg2 ||= $self->target;
86 0 0         if (! defined($arg2)) {
87 0           return $self->log->error($self->brik_help_set('target'));
88             }
89              
90 0 0         $fd = Net::Write::Layer3->new(
91             dst => $arg2,
92             protocol => Net::Write::Layer::NW_IPPROTO_RAW(),
93             family => $family,
94             ) or return $self->log->error("open: layer3: error");
95              
96 0           $self->log->verbose("open: layer3: success");
97             }
98             elsif ($self->layer == 4) {
99 0   0       $arg2 ||= $self->target;
100 0 0         if (! defined($self->target)) {
101 0           return $self->log->error($self->brik_help_set('target'));
102             }
103              
104 0 0         $fd = Net::Write::Layer4->new(
105             dst => $arg2,
106             protocol => $protocol,
107             family => $family,
108             ) or return $self->log->error("open: layer4: error");
109              
110 0           $self->log->verbose("open: layer4: success");
111             }
112              
113 0 0         $fd->open or return $self->log->error("open: error");
114              
115 0           $self->_fd($fd);
116              
117 0           return $fd;
118             }
119              
120             sub send {
121 0     0 0   my $self = shift;
122 0           my ($data) = @_;
123              
124 0           my $fd = $self->_fd;
125 0 0         $self->brik_help_run_undef_arg('open', $fd) or return;
126 0 0         $self->brik_help_run_undef_arg('send', $data) or return;
127              
128 0           $fd->send($data);
129              
130 0           return 1;
131             }
132              
133             sub close {
134 0     0 0   my $self = shift;
135              
136 0           my $fd = $self->_fd;
137 0 0         if (! defined($fd)) {
138 0           return 1;
139             }
140              
141 0           $fd->close;
142 0           $self->_fd(undef);
143              
144 0           return 1;
145             }
146              
147             sub lsend {
148 0     0 0   my $self = shift;
149 0           my ($data) = @_;
150              
151 0 0         $self->brik_help_run_undef_arg('lsend', $data) or return;
152              
153             # Save state
154 0           my $layer = $self->layer;
155 0           $self->layer(2);
156              
157 0 0         $self->open or return;
158 0 0         $self->send($data) or return;
159 0           $self->close;
160              
161             # Restore state
162 0           $self->layer($layer);
163              
164 0           return length($data);
165             }
166              
167             sub nsend {
168 0     0 0   my $self = shift;
169 0           my ($data) = @_;
170              
171 0 0         $self->brik_help_run_undef_arg('nsend', $data) or return;
172              
173             # Save state
174 0           my $layer = $self->layer;
175 0           $self->layer(3);
176              
177 0 0         $self->open or return;
178 0 0         $self->send($data) or return;
179 0           $self->close;
180              
181             # Restore state
182 0           $self->layer($layer);
183              
184 0           return length($data);
185             }
186              
187             sub fnsend_reply {
188 0     0 0   my $self = shift;
189 0           my ($frame, $target) = @_;
190              
191 0 0         $self->brik_help_run_undef_arg('fnsend_reply', $frame) or return;
192 0 0         $self->brik_help_run_invalid_arg('fnsend_reply', $frame, 'Net::Frame::Simple') or return;
193              
194             # Try to find the target by myself
195 0 0         if (! defined($target)) {
196 0   0       my $ip = $frame->ref->{'IPv4'} || $frame->ref->{'IPv6'};
197 0 0         if (! defined($ip)) {
198 0           return $self->log->error($self->brik_help_run('fnsend_reply'));
199             }
200 0           $target = $ip->dst;
201             }
202              
203 0 0         my $nr = Metabrik::Network::Read->new_from_brik_init($self) or return;
204 0           $nr->layer(2);
205 0           $nr->device($self->device);
206 0           $nr->rtimeout($self->global->rtimeout);
207              
208 0           $self->log->verbose("fnsend_reply: using device [".$nr->device."]");
209              
210 0 0         my $in = $nr->open or return;
211              
212             # Save state
213 0           my $saved_layer = $self->layer;
214 0           my $saved_target = $self->target;
215 0           $self->layer(3);
216 0           $self->target($target);
217              
218 0 0         my $out = $self->open or return;
219              
220 0 0         $frame->send($out) or return;
221              
222 0           my $reply;
223 0           until ($in->timeout) {
224 0 0         if ($reply = $frame->recv($in)) {
225 0           last;
226             }
227             }
228              
229 0           $self->close;
230 0           $nr->close;
231              
232             # Restore state
233 0           $self->layer($saved_layer);
234 0           $self->target($saved_target);
235              
236 0           return $reply;
237             }
238              
239             sub tsend {
240 0     0 0   my $self = shift;
241             }
242              
243             1;
244              
245             __END__