File Coverage

blib/lib/Parse/Log/Smbd.pm
Criterion Covered Total %
statement 44 44 100.0
branch 6 8 75.0
condition n/a
subroutine 9 9 100.0
pod 3 3 100.0
total 62 64 96.8


line stmt bran cond sub pod time code
1             package Parse::Log::Smbd;
2              
3 2     2   27785 use warnings;
  2         6  
  2         83  
4 2     2   12 use strict;
  2         2  
  2         72  
5 2     2   10 use Carp;
  2         8  
  2         168  
6 2     2   2049 use IO::File;
  2         32781  
  2         339  
7 2     2   1923 use Devel::CheckOS qw/ os_is die_unsupported /;
  2         2550  
  2         1637  
8              
9             die_unsupported() if os_is('MicrosoftWindows');
10              
11             =head1 NAME
12              
13             Parse::Log::Smbd - parse log.smbd files to fetch usernames and connections to network shares
14              
15             =head1 VERSION
16              
17             Version 0.02
18              
19             =cut
20              
21             our $VERSION = '0.02_01';
22              
23             =head1 SYNOPSIS
24              
25             This module retrieves users successfully authenticated and connections to SMB/CIFS network shares from Samba C files.
26              
27             use Parse::Log::Smbd;
28              
29             my $log = Parse::Log::Smbd->new( '/var/log/log.smbd' );
30              
31             my @users = $log->users;
32             my @shares = $log->shares;
33              
34             =head1 SUBROUTINES/METHODS
35              
36             =head2 new
37              
38             Creates a new C object, with the intended log filename as argument.
39              
40             =cut
41              
42             sub new {
43 1     1 1 798 my ( $class, $file ) = @_;
44 1 50       4 croak "Log filename missing" unless defined $file;
45              
46 1         3 my $self = {};
47              
48 1         9 my $fh = IO::File->new("< $file");
49 1 50       95 croak "Can't read from $file: $!" unless $fh;
50              
51 1         3 $self->{fh} = $fh;
52              
53 1         3 _parse_log($self);
54              
55 1         9 bless( $self, $class );
56 1         7 return $self;
57             }
58              
59             sub _parse_log {
60 1     1   2 my $self = shift;
61 1         3 my $fh = $self->{fh};
62              
63 1         30 while (<$fh>) {
64 2123 100       4106 if (/authentication for user \[(\w+)\].*?/) {
65 153         146 push @{ $self->{users} }, $1;
  153         360  
66             }
67 2123 100       6416 if (/connect to service (\w+).*?/) {
68 316         308 push @{ $self->{shares} }, $1;
  316         1366  
69             }
70             }
71 1         7 return;
72             }
73              
74             =head2 users
75              
76             Lists users that authenticated successfully to the smbd server. Returns a sorted list of unique usernames.
77              
78             =cut
79              
80             sub users {
81 1     1 1 735 my $self = shift;
82              
83 1         4 undef my %seen;
84 1         2 return sort grep { !$seen{$_}++ } @{ $self->{users} };
  153         260  
  1         66  
85             }
86              
87             =head2 shares
88              
89             Lists successful connections to network shares. Returns a sorted list of unique shares.
90              
91             =cut
92              
93             sub shares {
94 1     1 1 3 my $self = shift;
95              
96 1         2 undef my %seen;
97 1         2 return sort grep { !$seen{$_}++ } @{ $self->{shares} };
  316         456  
  1         5  
98             }
99              
100             =head1 AUTHOR
101              
102             Ari Constancio, C<< >>
103              
104             =head1 BUGS
105              
106             Please report any bugs or feature requests to C, or through
107             the web interface at L. I will be notified, and then you'll
108             automatically be notified of progress on your bug as I make changes.
109              
110             =head1 SUPPORT
111              
112             You can find documentation for this module with the perldoc command.
113              
114             perldoc Parse::Log::Smbd
115              
116              
117             You can also look for information at:
118              
119             =over 4
120              
121             =item * RT: CPAN's request tracker
122              
123             L
124              
125             =item * AnnoCPAN: Annotated CPAN documentation
126              
127             L
128              
129             =item * CPAN Ratings
130              
131             L
132              
133             =item * Search CPAN
134              
135             L
136              
137             =back
138              
139              
140             =head1 ACKNOWLEDGEMENTS
141              
142             Thanks to the Samba Team (L) for a great software.
143              
144             =head1 LICENSE AND COPYRIGHT
145              
146             Copyright 2010-2011 Ari Constancio.
147              
148             This program is free software; you can redistribute it and/or modify it
149             under the terms of either: the GNU General Public License as published
150             by the Free Software Foundation; or the Artistic License.
151              
152             See http://dev.perl.org/licenses/ for more information.
153              
154             =cut
155              
156             1; # End of Parse::Log::Smbd