File Coverage

blib/lib/Metabrik/Client/Tcp.pm
Criterion Covered Total %
statement 9 177 5.0
branch 0 58 0.0
condition 0 30 0.0
subroutine 3 16 18.7
pod 2 13 15.3
total 14 294 4.7


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # client::tcp Brik
5             #
6             package Metabrik::Client::Tcp;
7 2     2   714 use strict;
  2         5  
  2         58  
8 2     2   11 use warnings;
  2         3  
  2         56  
9              
10 2     2   10 use base qw(Metabrik);
  2         4  
  2         3904  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable socket netcat) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             host => [ qw(host) ],
20             port => [ qw(port) ],
21             protocol => [ qw(tcp) ],
22             eof => [ qw(0|1) ],
23             timeout => [ qw(0|1) ],
24             size => [ qw(size) ],
25             rtimeout => [ qw(read_timeout) ],
26             use_ipv6 => [ qw(0|1) ],
27             _socket => [ qw(INTERNAL) ],
28             },
29             attributes_default => {
30             protocol => 'tcp',
31             eof => 0,
32             timeout => 0,
33             size => 1024,
34             use_ipv6 => 0,
35             },
36             commands => {
37             connect => [ qw(host|OPTIONAL port|OPTIONAL) ],
38             read => [ qw(stdin|OPTIONAL) ],
39             read_size => [ qw(size stdin|OPTIONAL) ],
40             read_line => [ qw(stdin|OPTIONAL) ],
41             write => [ qw($data stdout|OPTIONAL) ],
42             loop => [ qw(stdin|OPTIONAL stdout|OPTIONAL stderr|OPTIONAL) ],
43             disconnect => [ ],
44             is_connected => [ ],
45             chomp => [ qw($data) ],
46             reset_timeout => [ ],
47             reset_eof => [ ],
48             },
49             require_modules => {
50             'IO::Socket::INET' => [ ],
51             'IO::Socket::INET6' => [ ],
52             'IO::Select' => [ ],
53             },
54             };
55             }
56              
57             sub brik_use_properties {
58 0     0 1   my $self = shift;
59              
60             return {
61 0   0       attributes_default => {
62             rtimeout => defined($self->global) && $self->global->rtimeout || 3,
63             },
64             };
65             }
66              
67             sub connect {
68 0     0 0   my $self = shift;
69 0           my ($host, $port) = @_;
70              
71 0   0       $host ||= $self->host;
72 0   0       $port ||= $self->port;
73 0 0         $self->brik_help_run_undef_arg('connect', $host) or return;
74 0 0         $self->brik_help_run_undef_arg('connect', $port) or return;
75              
76 0 0         my $mod = $self->use_ipv6 ? 'IO::Socket::INET6' : 'IO::Socket::INET';
77              
78 0           my $socket = $mod->new(
79             PeerHost => $host,
80             PeerPort => $port,
81             Proto => $self->protocol,
82             Timeout => $self->rtimeout,
83             ReuseAddr => 1,
84             );
85 0 0         if (! defined($socket)) {
86 0           return $self->log->error("connect: failed connecting to target [$host:$port]: $!");
87             }
88            
89 0           $socket->blocking(1);
90 0           $socket->autoflush(1);
91              
92 0 0         my $select = IO::Select->new or return $self->log->error("connect: IO::Select failed: $!");
93 0           $select->add($socket);
94              
95 0           $self->_socket($socket);
96              
97 0           $self->log->verbose("connect: successfully connected to [$host:$port]");
98              
99 0           my $conn = {
100             ip => $socket->peerhost,
101             port => $socket->peerport,
102             my_ip => $socket->sockhost,
103             my_port => $socket->sockport,
104             };
105              
106 0           return $conn;
107             }
108              
109             sub disconnect {
110 0     0 0   my $self = shift;
111              
112 0 0         if ($self->_socket) {
113 0           $self->_socket->close;
114 0           $self->_socket(undef);
115 0           $self->log->verbose("disconnect: successfully disconnected");
116             }
117             else {
118 0           $self->log->verbose("disconnect: nothing to disconnect");
119             }
120              
121 0           return 1;
122             }
123              
124             sub is_connected {
125 0     0 0   my $self = shift;
126              
127 0 0         if ($self->_socket) {
128 0           return 1;
129             }
130              
131 0           return 0;
132             }
133              
134             sub write {
135 0     0 0   my $self = shift;
136 0           my ($data, $stdout) = @_;
137              
138 0 0         if (! $self->is_connected) {
139 0           return $self->log->error($self->brik_help_run('connect'));
140             }
141 0 0         $self->brik_help_run_undef_arg('write', $data) or return;
142              
143 0           my $socket = $self->_socket;
144 0   0       $stdout ||= $socket;
145              
146 0           my $ret = $stdout->syswrite($data, length($data));
147 0 0         if (! $ret) {
148 0           return $self->log->error("write: syswrite failed with error [$!]");
149             }
150              
151 0           return $ret;
152             }
153              
154             sub reset_timeout {
155 0     0 0   my $self = shift;
156              
157 0           $self->timeout(0);
158              
159 0           return 1;
160             }
161              
162             sub reset_eof {
163 0     0 0   my $self = shift;
164              
165 0           $self->eof(0);
166              
167 0           return 1;
168             }
169              
170             sub read_size {
171 0     0 0   my $self = shift;
172 0           my ($size, $stdin) = @_;
173              
174 0   0       $size ||= $self->size;
175 0 0         if (! $self->is_connected) {
176 0           return $self->log->error($self->brik_help_run('connect'));
177             }
178              
179 0           my $socket = $self->_socket;
180 0   0       $stdin ||= $socket;
181              
182 0           my $select = IO::Select->new;
183 0           $select->add($stdin);
184              
185 0           my $read = 0;
186 0           my $eof = 0;
187 0           my $data = '';
188 0           my @ready = ();
189 0           while (@ready = $select->can_read($self->rtimeout)) {
190 0           my $ret = $stdin->sysread($data, $size);
191 0 0         if (! defined($ret)) {
    0          
    0          
192 0           return $self->log->error("read_size: sysread failed with error [$!]");
193             }
194             elsif ($ret == 0) { # EOF
195 0           $self->eof(1);
196 0           $eof++;
197 0           last;
198             }
199             elsif ($ret > 0) { # Read stuff
200 0           $read++;
201 0           last;
202             }
203             else {
204 0           return $self->log->fatal("read_size: What?!?");
205             }
206             }
207              
208 0 0         if (@ready == 0) {
209 0           $self->timeout(1);
210 0           $self->log->verbose("read_size: timeout occured");
211             }
212              
213 0           return $data;
214             }
215              
216             sub read_line {
217 0     0 0   my $self = shift;
218 0           my ($stdin) = @_;
219              
220 0 0         if (! $self->is_connected) {
221 0           return $self->log->error($self->brik_help_run('connect'));
222             }
223              
224 0           my $socket = $self->_socket;
225 0   0       $stdin ||= $socket;
226              
227 0           my $select = IO::Select->new;
228 0           $select->add($stdin);
229              
230 0           my $read = 0;
231 0           my $eof = 0;
232 0           my $data = '';
233 0           my @ready = ();
234 0           while (@ready = $select->can_read($self->rtimeout)) {
235 0           $data = $stdin->getline;
236 0 0         if (! defined($data)) {
237 0           return $self->log->error("read_line: getline failed with error [$!]");
238             }
239 0           last;
240             }
241              
242 0 0         if (@ready == 0) {
243 0           $self->timeout(1);
244 0           $self->log->verbose("read_line: timeout occured");
245             }
246              
247 0           return $data;
248             }
249              
250             sub read {
251 0     0 0   my $self = shift;
252 0           my ($stdin) = @_;
253              
254 0 0         if (! $self->is_connected) {
255 0           return $self->log->error($self->brik_help_run('connect'));
256             }
257              
258 0           my $socket = $self->_socket;
259 0   0       $stdin ||= $socket;
260              
261 0           my $select = IO::Select->new;
262 0           $select->add($stdin);
263              
264 0           my $read = 0;
265 0           my $eof = 0;
266 0           my $data = '';
267 0           my $chunk = 500;
268 0           my @ready = ();
269 0           while (@ready = $select->can_read($self->rtimeout)) {
270 0           AGAIN:
271             my $buf = '';
272 0           my $ret = $stdin->sysread($buf, $chunk);
273 0 0         if (! defined($ret)) {
    0          
    0          
274 0           return $self->log->error("read: sysread failed with error [$!]");
275             }
276             elsif ($ret == 0) { # EOF
277 0           $self->log->debug("read: eof");
278 0           $self->eof(1);
279 0           $eof++;
280 0           last;
281             }
282             elsif ($ret > 0) { # Read stuff
283 0           $read++;
284 0           $data .= $buf;
285 0           $self->log->debug("read: stuff len[$ret]");
286 0 0         if ($ret == $chunk) {
287 0           $self->log->debug("read: AGAIN");
288 0           goto AGAIN;
289             }
290 0           last;
291             }
292             else {
293 0           return $self->log->fatal("read: What?!?");
294             }
295             }
296              
297 0 0         if (@ready == 0) {
298 0           $self->timeout(1);
299 0           $self->log->verbose("read: timeout occured");
300             }
301              
302 0           return $data;
303             }
304              
305             sub loop {
306 0     0 0   my $self = shift;
307 0           my ($stdin, $stdout, $stderr) = @_;
308              
309 0 0         if (! $self->is_connected) {
310 0           return $self->log->error($self->brik_help_run('connect'));
311             }
312              
313 0           my $socket = $self->_socket;
314 0   0       $stdin ||= \*STDIN;
315 0   0       $stdout ||= $socket;
316 0   0       $stderr ||= \*STDERR;
317              
318 0           my $select = IO::Select->new;
319 0           $select->add($stdin); # Client
320 0           $select->add($stdout); # Server
321              
322 0           my @ready = ();
323 0           my $data = '';
324 0           while (@ready = $select->can_read($self->rtimeout)) {
325 0           my $eof = 0;
326 0           for my $std (@ready) {
327 0 0         if ($std == $stdin) { # client $stdin has sent stuff we can read
328 0           $data = $self->read_line($stdin);
329 0           $self->write($data, $stdout);
330             }
331             else { # server $stdout has sent stuff we can read
332 0           $data = $self->read($stdout);
333 0 0         if ($self->eof) {
334 0           $self->log->verbose("loop: server sent eof");
335 0           $eof++;
336 0           last;
337             }
338 0           print $data;
339             }
340             }
341 0 0         last if $eof;
342             }
343              
344 0 0         if (@ready == 0) {
345 0           $self->log->verbose("loop: timeout occured");
346             }
347              
348 0           return $data;
349             }
350              
351             sub chomp {
352 0     0 0   my $self = shift;
353 0           my ($data) = @_;
354              
355 0           $data =~ s/\r\n$//;
356 0           $data =~ s/\r$//;
357 0           $data =~ s/\n$//;
358              
359 0           $data =~ s/\r/\\x0d/g;
360 0           $data =~ s/\n/\\x0a/g;
361              
362 0           return $data;
363             }
364              
365             1;
366              
367             __END__