File Coverage

blib/lib/Log/Saftpresse/Input/Server.pm
Criterion Covered Total %
statement 12 58 20.6
branch 0 4 0.0
condition n/a
subroutine 4 13 30.7
pod 0 9 0.0
total 16 84 19.0


line stmt bran cond sub pod time code
1             package Log::Saftpresse::Input::Server;
2              
3 1     1   433 use Moose;
  1         3  
  1         5  
4              
5 1     1   4446 use Log::Saftpresse::Log4perl;
  1         2  
  1         126  
6              
7             # ABSTRACT: udp/tcp network server input plugin for saftpresse
8             our $VERSION = '1.5'; # VERSION
9              
10              
11             extends 'Log::Saftpresse::Input';
12              
13 1     1   527 use IO::Socket::INET;
  1         9358  
  1         5  
14 1     1   602 use IO::Select;
  1         2  
  1         1041  
15              
16             has 'port' => ( is => 'ro', isa => 'Int', default => 514 );
17             has 'proto' => ( is => 'ro', isa => 'Str', default => 'tcp' );
18             has 'listen' => ( is => 'ro', isa => 'Str', default => '127.0.0.1' );
19              
20             has 'connection_queue_size' => ( is => 'ro', isa => 'Int', default => 10 );
21              
22             has 'listener' => (
23             is => 'ro', isa => 'IO::Socket::INET', lazy => 1,
24             default => sub {
25             my $self = shift;
26             $log->info('setting up listener on '.$self->listen.':'.$self->port.'...');
27             my $l = IO::Socket::INET->new(
28             Listen => $self->connection_queue_size,
29             LocalAddr => $self->listen,
30             LocalPort => $self->port,
31             Proto => $self->proto,
32             Blocking => 0,
33             ) or die("error creating network listener socket: ".$@);
34             return $l;
35             },
36             );
37              
38             has 'listener_select' => (
39             is => 'ro', isa => 'IO::Select', lazy => 1,
40             default => sub {
41             my $self = shift;
42             my $s = IO::Select->new();
43             $s->add( $self->listener );
44             return $s;
45             },
46             );
47              
48             sub accept_new_connections {
49 0     0 0   my $self = shift;
50 0           while( $self->listener_select->can_read(0) ) {
51 0           my $conn = $self->listener->accept;
52 0           $conn->blocking(0);
53 0           $self->io_select->add( $conn );
54 0           $self->handle_new_connection( $conn );
55 0           $log->info('accepted new connection '.$conn->fileno.' from '.$conn->peerhost.':'.$conn->peerport);
56             }
57 0           return;
58             }
59              
60             sub handle_new_connection {
61 0     0 0   my ( $self, $conn ) = @_;
62 0           return;
63             }
64              
65             sub io_handles {
66 0     0 0   my $self = shift;
67 0           return( $self->listener, $self->io_select->handles );
68             }
69              
70             has 'io_select' => (
71             is => 'ro', isa => 'IO::Select', lazy => 1,
72             default => sub {
73             my $self = shift;
74             my $s = IO::Select->new();
75             return $s;
76             },
77             );
78              
79              
80             sub read_events {
81 0     0 0   my ( $self ) = @_;
82 0           my @events;
83              
84 0           $self->accept_new_connections;
85              
86 0           my @ready = $self->io_select->can_read(0);
87 0           foreach my $conn ( @ready ) {
88 0 0         if( $conn->eof ) {
89 0           $log->info('connection '.$conn->fileno.' closed by peer');
90 0           $self->shutdown_connection( $conn );
91             }
92 0           eval {
93 0           push( @events, $self->handle_data($conn) );
94             };
95 0 0         if( $@ ) {
96 0           $log->error('error reading from connection '.$conn->fileno.': '.$@);
97 0           $self->shutdown_connection( $conn );
98             }
99             }
100 0           return @events;
101             }
102              
103             sub shutdown_connection {
104 0     0 0   my ( $self, $conn ) = @_;
105              
106 0           $log->info('removing connection '.$conn->fileno.'...');
107 0           eval {
108 0           $self->handle_cleanup_connection( $conn );
109 0           $self->io_select->remove( $conn );
110 0           $conn->close;
111             };
112              
113 0           return;
114             }
115              
116             sub handle_cleanup_connection {
117 0     0 0   my ( $self, $conn ) = @_;
118 0           return;
119             }
120              
121             sub handle_data {
122 0     0 0   my ( $self, $conn ) = @_;
123 0           my @events;
124 0           while( defined( my $line = $conn->getline ) ) {
125 0           $line =~ s/[\r\n]*$//;
126 0           my $event = {
127             'message' => $line,
128             };
129 0           push( @events, $event );
130             }
131 0           return @events;
132             }
133              
134             sub can_read {
135 0     0 0   my ( $self ) = @_;
136 0           my @can_read = (
137             $self->io_select->can_read(0),
138             $self->listener_select->can_read(0),
139             );
140 0           return( scalar @can_read );
141             }
142              
143             sub eof {
144 0     0 0   return 0; # we're never at EOF
145             }
146              
147             1;
148              
149             __END__
150              
151             =pod
152              
153             =encoding UTF-8
154              
155             =head1 NAME
156              
157             Log::Saftpresse::Input::Server - udp/tcp network server input plugin for saftpresse
158              
159             =head1 VERSION
160              
161             version 1.5
162              
163             =head1 Description
164              
165             This plugin implements a TCP input server.
166              
167             Together with the Syslog plugin it could be used to build a syslog server.
168              
169             It could also be used as a base for building other tcp input servers.
170             For example see the RELP server.
171              
172             =head1 Synopsis
173              
174             # read syslog lines from network
175             <Input syslog>
176             module = "Server"
177             port = "514"
178             proto = "tcp"
179             listen = "192.168.0.1"
180             connection_queue_size = "10"
181             </Input>
182              
183             # decode syslog line format
184             <Plugin syslog>
185             module = "syslog"
186             </Plugin>
187              
188             =head1 Input Format
189              
190             This plugin will output an event for each recieved line with only the field
191              
192             =over
193              
194             =item message
195              
196             The line recieved.
197              
198             =back
199              
200             Use a plugin to decode the content of the line.
201              
202             For example the Syslog plugin could be used to decode the syslog line format.
203              
204             =head1 AUTHOR
205              
206             Markus Benning <ich@markusbenning.de>
207              
208             =head1 COPYRIGHT AND LICENSE
209              
210             This software is Copyright (c) 1998 by James S. Seymour, 2015 by Markus Benning.
211              
212             This is free software, licensed under:
213              
214             The GNU General Public License, Version 2, June 1991
215              
216             =cut