File Coverage

blib/lib/Shadowd/Connector.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Shadowd::Connector;
2              
3 1     1   14822 use strict;
  1         3  
  1         45  
4              
5 1     1   619 use JSON;
  1         10732  
  1         5  
6 1     1   614 use Switch;
  1         34450  
  1         6  
7 1     1   76973 use Config::IniFiles;
  0            
  0            
8             use IO::Socket;
9             use IO::Socket::SSL;
10             use Crypt::Mac::HMAC qw(hmac_hex);
11             use Attribute::Abstract;
12             use POSIX qw(strftime);
13              
14             use constant {
15             SHADOWD_CONNECTOR_VERSION => '1.0.2-perl',
16             SHADOWD_CONNECTOR_CONFIG => '/etc/shadowd/connectors.ini',
17             SHADOWD_CONNECTOR_CONFIG_SECTION => 'shadowd_perl',
18             SHADOWD_LOG => '/var/log/shadowd.log',
19             STATUS_OK => 1,
20             STATUS_BAD_REQUEST => 2,
21             STATUS_BAD_SIGNATURE => 3,
22             STATUS_BAD_JSON => 4,
23             STATUS_ATTACK => 5
24             };
25              
26             =head1 NAME
27              
28             Shadowd::Connector - Shadow Daemon Connector (Base)
29              
30             =head1 VERSION
31              
32             Version 1.0.2
33              
34             =cut
35              
36             our $VERSION = '1.0.2';
37              
38             =head1 SYNOPSIS
39              
40             B is a collection of tools to I, I and I I on I.
41             Technically speaking, Shadow Daemon is a B that intercepts requests and filters out malicious parameters.
42             It is a modular system that separates web application, analysis and interface to increase security, flexibility and expandability.
43              
44             I is the base class to connect Perl applications with the Shadow Daemon background server. It is not possible
45             to use this module directly, because there are abstract methods that have to be implemented.
46              
47             =cut
48              
49             =head1 METHODS
50              
51             =head2 new()
52              
53             This method is a simple constructor for an object oriented interface.
54              
55             =cut
56              
57             sub new {
58             my ($class) = @_;
59             my $self = {};
60              
61             bless $self, $class;
62             return $self;
63             }
64              
65             =head2 get_client_ip()
66              
67             This is an abstract method that has to be implemented by a subclass. It has to return the IP address of the client.
68              
69             =cut
70              
71             sub get_client_ip: Abstract;
72              
73             =head2 get_caller()
74              
75             This is an abstract method that has to be implemented by a subclass. It has to return the caller, i.e. the requested resource.
76              
77             =cut
78              
79             sub get_caller: Abstract;
80              
81             =head2 gather_input()
82              
83             This is an abstract method that has to be implemented by a subclass. It has to save the user input in the class attribute I<_input>.
84              
85             =cut
86              
87             sub gather_input: Abstract;
88              
89             =head2 defuse_input($threats)
90              
91             This is an abstract method that has to be implemented by a subclass. It has to remove threats from the user input.
92              
93             =cut
94              
95             sub defuse_input: Abstract;
96              
97             =head2 error()
98              
99             This is an abstract method that has to be implemented by a subclass. It has to display an error message.
100              
101             =cut
102              
103             sub error: Abstract;
104              
105             =head2 init_config()
106              
107             This method initializes and loads the configuration.
108              
109             =cut
110              
111             sub init_config {
112             my ($self) = @_;
113              
114             if (defined $ENV{'SHADOWD_CONNECTOR_CONFIG'}) {
115             $self->{'_config_file'} = $ENV{'SHADOWD_CONNECTOR_CONFIG'};
116             } else {
117             $self->{'_config_file'} = SHADOWD_CONNECTOR_CONFIG;
118             }
119              
120             $self->{'_config'} = Config::IniFiles->new(-file => $self->{'_config_file'});
121              
122             if (!$self->{'_config'}) {
123             die('config error');
124             }
125              
126             if (defined $ENV{'SHADOWD_CONNECTOR_CONFIG_SECTION'}) {
127             $self->{'_config_section'} = $ENV{'SHADOWD_CONNECTOR_CONFIG_SECTION'};
128             } else {
129             $self->{'_config_section'} = SHADOWD_CONNECTOR_CONFIG_SECTION;
130             }
131             }
132              
133             =head2 get_config($key, $required, $default)
134              
135             This method returns values from the configuration.
136              
137             =cut
138              
139             sub get_config {
140             my ($self, $key, $required, $default) = @_;
141              
142             if (!$self->{'_config'}->exists($self->{'_config_section'}, $key)) {
143             if ($required) {
144             die($key . ' in config missing');
145             } else {
146             return $default;
147             }
148             } else {
149             return $self->{'_config'}->val($self->{'_config_section'}, $key);
150             }
151             }
152              
153             =head2 get_input()
154              
155             This method returns the user input that is brought together by I.
156              
157             =cut
158              
159             sub get_input {
160             my ($self) = @_;
161              
162             return $self->{'_input'}
163             }
164              
165             =head2 remove_ignored($file)
166              
167             The method removes user input that should be ignored from the class attribute I<_input>.
168              
169             =cut
170              
171             sub remove_ignored {
172             my ($self, $file) = @_;
173              
174             local $/ = undef;
175             open my $handler, $file or die('could not open ignore file: ' . $!);
176             binmode $handler;
177              
178             my $content = <$handler>;
179             my $json = decode_json($content);
180              
181             foreach my $entry (@$json) {
182             if (!defined $entry->{'path'} && defined $entry->{'caller'}) {
183             if ($self->{'_caller'} eq $entry->{'caller'}) {
184             $self->{'_input'} = {};
185              
186             last;
187             }
188             } else {
189             if (defined $entry->{'caller'}) {
190             if ($self->{'_caller'} ne $entry->{'caller'}) {
191             next;
192             }
193             }
194              
195             if (defined $entry->{'path'}) {
196             delete $self->{'_input'}->{$entry->{'path'}};
197             }
198             }
199             }
200              
201             close $handler;
202             }
203              
204             =head2 send_input($host, $port, $profile, $key, $ssl)
205              
206             This method sends the user input to the background server and return the parsed response.
207              
208             =cut
209              
210             sub send_input {
211             my ($self, $host, $port, $profile, $key, $ssl) = @_;
212              
213             my $connection;
214              
215             if ($ssl) {
216             $connection = IO::Socket::SSL->new(
217             PeerHost => $host,
218             PeerPort => $port,
219             SSL_verify_mode => SSL_VERIFY_PEER,
220             SSL_ca_file => $ssl
221             ) or die('network error (ssl): ' . $!);
222             } else {
223             $connection = IO::Socket::INET->new(
224             PeerAddr => $host,
225             PeerPort => $port
226             ) or die('network error: ' . $!);
227             }
228              
229             $connection->autoflush(1);
230              
231             my %input_data = (
232             'version' => SHADOWD_CONNECTOR_VERSION,
233             'client_ip' => $self->get_client_ip,
234             'caller' => $self->get_caller,
235             'input' => $self->get_input
236             );
237              
238             my $json = encode_json(\%input_data);
239             print $connection $profile . "\n" . $self->sign($key, $json) . "\n" . $json . "\n";
240              
241             my $output = <$connection>;
242              
243             close $connection;
244              
245             return $self->parse_output($output);
246             }
247              
248             =head2 parse_output($output)
249              
250             This method parses the response of the background server.
251              
252             =cut
253              
254             sub parse_output {
255             my ($self, $output) = @_;
256              
257             my $output_data = decode_json($output);
258              
259             switch ($output_data->{'status'}) {
260             case STATUS_OK { return 0; }
261             case STATUS_BAD_REQUEST { die('bad request'); }
262             case STATUS_BAD_SIGNATURE { die('bad signature'); }
263             case STATUS_BAD_JSON { die('bad json'); }
264             case STATUS_ATTACK { return $output_data->{'threats'}; }
265             else { die('processing error'); }
266             }
267             }
268              
269             =head2 sign($key, $json)
270              
271             This method signs the input with a secret key to authenticate requests without having to send the password.
272              
273             =cut
274              
275             sub sign {
276             my ($self, $key, $json) = @_;
277              
278             return hmac_hex('SHA256', $key, $json);
279             }
280              
281             =head2 log($message)
282              
283             This method writes messages to a log file.
284              
285             =cut
286              
287             sub log {
288             my ($self, $message) = @_;
289              
290             my $file = $self->get_config('log', 0, SHADOWD_LOG);
291             open my $handler, '>>' . $file or die('could not open log file: ' . $!);
292              
293             my $datetime = strftime('%Y-%m-%d %H:%M:%S', localtime);
294             print $handler $datetime . "\t" . $message;
295              
296             close $handler;
297             }
298              
299             =head2 escape_key($key)
300              
301             This method escapes keys, i.e. single elements of a path.
302              
303             =cut
304              
305             sub escape_key {
306             my ($self, $key) = @_;
307              
308             $key =~ s/\\/\\\\/g;
309             $key =~ s/\|/\\|/g;
310              
311             return $key;
312             }
313              
314             =head2 unescape_key($key)
315              
316             This method unescapes keys, i.e. single elements of a path.
317              
318             =cut
319              
320             sub unescape_key {
321             my ($self, $key) = @_;
322              
323             $key =~ s/\\\\/\\/g;
324             $key =~ s/\\\|/|/g;
325              
326             return $key;
327             }
328              
329             =head2 split_path($path)
330              
331             This method splits a path into keys.
332              
333             =cut
334              
335             sub split_path {
336             my ($self, $path) = @_;
337              
338             return split(/\\.(*SKIP)(*FAIL)|\|/s, $path);
339             }
340              
341             =head2 start()
342              
343             This method connects the different components of the module and starts the complete protection process.
344              
345             =cut
346              
347             sub start {
348             my ($self) = @_;
349              
350             eval {
351             $self->init_config;
352              
353             $self->gather_input;
354              
355             my $ignored = $self->get_config('ignore');
356             if ($ignored) {
357             $self->remove_ignored($ignored);
358             }
359              
360             my $threats = $self->send_input(
361             $self->get_config('host', 0, '127.0.0.1'),
362             $self->get_config('port', 0, '9115'),
363             $self->get_config('profile', 1),
364             $self->get_config('key', 1),
365             $self->get_config('ssl')
366             );
367              
368             if (!$self->get_config('observe') && $threats) {
369             $self->defuse_input($threats);
370             }
371              
372             if ($self->get_config('debug') && $threats) {
373             $self->log('shadowd: removed threat from client: ' . $self->get_client_ip . "\n");
374             }
375             };
376              
377             if ($@) {
378             if ($self->get_config('debug')) {
379             $self->log($@);
380             }
381              
382             unless ($self->get_config('observe')) {
383             $self->error;
384              
385             return undef;
386             }
387             }
388              
389             return 1;
390             }
391              
392             =head1 AUTHOR
393              
394             Hendrik Buchwald, C<< >>
395              
396             =head1 BUGS
397              
398             Please report any bugs or feature requests to C, or through the web interface at
399             L. I will be notified, and then you'll automatically
400             be notified of progress on your bug as I make changes.
401              
402             It is also possible to report bugs via Github at L.
403              
404             =head1 SUPPORT
405              
406             You can find documentation for this module with the perldoc command.
407              
408             perldoc Shadowd::Connector
409              
410              
411             You can also look for information at:
412              
413             =over 4
414              
415             =item * RT: CPAN's request tracker (report bugs here)
416              
417             L
418              
419             =item * AnnoCPAN: Annotated CPAN documentation
420              
421             L
422              
423             =item * CPAN Ratings
424              
425             L
426              
427             =item * Search CPAN
428              
429             L
430              
431             =back
432              
433             =head1 LICENSE AND COPYRIGHT
434              
435             Shadow Daemon -- Web Application Firewall
436              
437             Copyright (C) 2014-2015 Hendrik Buchwald C<< >>
438              
439             This file is part of Shadow Daemon. Shadow Daemon is free software: you can
440             redistribute it and/or modify it under the terms of the GNU General Public
441             License as published by the Free Software Foundation, version 2.
442              
443             This program is distributed in the hope that it will be useful, but WITHOUT
444             ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
445             FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
446             details.
447              
448             You should have received a copy of the GNU General Public License
449             along with this program. If not, see L.
450              
451             =cut
452              
453             1; # End of Shadowd::Connector