File Coverage

blib/lib/File/PCAP/ACAP2PCAP.pm
Criterion Covered Total %
statement 72 83 86.7
branch 22 34 64.7
condition 1 3 33.3
subroutine 17 20 85.0
pod 2 2 100.0
total 114 142 80.2


line stmt bran cond sub pod time code
1             package File::PCAP::ACAP2PCAP;
2              
3 2     2   134301 use 5.006;
  2         20  
4 2     2   8 use strict;
  2         3  
  2         43  
5 2     2   16 use warnings;
  2         4  
  2         47  
6              
7 2     2   704 use File::PCAP::Writer;
  2         7  
  2         61  
8 2     2   851 use Time::Local;
  2         3904  
  2         142  
9              
10             =head1 NAME
11              
12             File::PCAP::ACAP2PCAP - convert ASA capture to PCAP
13              
14             =head1 VERSION
15              
16             Version v0.0.7
17              
18             =cut
19              
20 2     2   14 use version; our $VERSION = qv('v0.0.7');
  2         4  
  2         10  
21              
22             =head1 SYNOPSIS
23              
24             This module converts Cisco ASA packet capture outputs to PCAP files.
25              
26             use File::PCAP::ACAP2PCAP;
27              
28             my $a2p = File::PCAP::ACAP2PCAP->new( $args );
29              
30             $a2p->parse(\*STDIN);
31              
32             =head1 SUBROUTINES/METHODS
33              
34             =head2 new( $args )
35              
36             Creates a new object, takes a hash reference as argument with
37             the following keys:
38              
39             my $a2p = File::PCAP::ACAP2PCAP( {
40             dlt => $dlt, # data link type, see below
41             output => $fname, # filename for PCAP output
42             } );
43              
44             The data link type is put in the PCAP global header.
45             It defaults to 1 (Ethernet).
46             There are some versions of Cisco software that output raw IP headers.
47             For these use 101 (Raw IP) and for more information on data link types, see
48             L.
49              
50             =cut
51              
52             sub new {
53 2     2 1 1109 my ($self,$args) = @_;
54 2   33     16 my $type = ref($self) || $self;
55            
56 2         6 my $now = time;
57 2         66 my @today = localtime($now);
58 2         8 $today[0] = $today[1] = $today[2] = 0;
59              
60 2         6 my $fpwargs = {};
61 2 50       10 if (exists $args->{dlt}) {
62 2         7 $fpwargs->{dlt} = $args->{dlt};
63             }
64 2 50       6 if (exists $args->{output}) {
65 2         6 $fpwargs->{fname} = $args->{output};
66             }
67             else {
68 0         0 $fpwargs->{fname} = 'asa.pcap';
69             }
70            
71 2         15 my $fpw = File::PCAP::Writer->new($fpwargs);
72            
73 2         12 $self = bless {
74             state => 'unknown',
75             sot => timegm(@today), # start of today
76             last_sec => 0,
77             now => $now,
78             fpw => $fpw,
79             packet_bytes => "",
80             }, $type;
81 2         106 return $self;
82             } # new()
83              
84             =head2 parse( $fd )
85              
86             This function does the parsing of the ASA output from an IO stream.
87              
88             To parse STDIN, you would do something like the following:
89              
90             $a2p->parse(\*STDIN);
91              
92             To parse a file given by name, you open it and take the file handle:
93              
94             if (open(my $input,'<',$filename)) {
95             $a2p->parse($input);
96             close $input;
97             }
98              
99             To write the packets into the PCAP file this function uses
100             L<< File::PCAP::Writer->packet()|File::PCAP::Writer >>.
101              
102             =cut
103              
104             sub parse {
105 2     2 1 85 my ($self,$fd) = @_;
106            
107 2         47 while (my $line = <$fd>) {
108 40         92 $self->_read_line($line);
109             }
110 2         8 $self->_write_packet();
111             } # parse()
112              
113             # internal functions and variables
114              
115             my $r_strt = qr/^([0-9]+) packets? captured$/;
116             my $r_empt = qr/^$/;
117             my $r_dscr = qr/^\s*([0-9]+): ([0-9]{2}):([0-9]{2}):([0-9]{2})\.([0-9]+)\s+(.+)$/;
118             my $r_mdsc = qr/^\s+(\S.*)$/;
119             my $r_stop = qr/^([0-9]+) packets? shown$/;
120             my $r_dump = qr/^(0x[0-9a-f]+)\s+([0-9a-f][0-9a-f ]{38})\s{8}(.+)$/;
121              
122             # The function _read_line() reads the input one line at a time and
123             # decides what to do with that line.
124             #
125             # The basic knowledge (a state machine driven by the input line) is encoded
126             # in the hash $states.
127             #
128             sub _read_line {
129 40     40   118 my ($self,$line) = @_;
130             my $states = {
131             unknown => sub {
132 11 100   11   54 return ($line =~ $r_strt) ? $self->_l_strt($1)
133             : 'unknown'
134             ;
135             },
136             strt => sub {
137 3 50   3   40 return ($line =~ $r_empt) ? 'strt'
    100          
138             : ($line =~ $r_dscr) ? $self->_l_dscr($1,$2,$3,$4,$5,$6)
139             : 'unknown'
140             ;
141             },
142             dscr => sub {
143 5 50   5   66 return ($line =~ $r_dscr) ? $self->_l_dscr($1,$2,$3,$4,$5,$6)
    50          
    100          
    50          
    50          
144             : ($line =~ $r_mdsc) ? $self->_l_mdsc($1)
145             : ($line =~ $r_dump) ? $self->_l_dump($1,$2,$3)
146             : ($line =~ $r_stop) ? $self->_l_stop()
147             : ($line =~ $r_empt) ? 'dump'
148             : 'unknown'
149             ;
150             },
151             dump => sub {
152 21 0   21   125 return ($line =~ $r_dump) ? $self->_l_dump($1,$2,$3)
    50          
    100          
153             : ($line =~ $r_dscr) ? $self->_l_dscr($1,$2,$3,$4,$5,$6)
154             : ($line =~ $r_stop) ? $self->_l_stop()
155             : 'unknown'
156             ;
157             },
158             stop => sub {
159 0     0   0 return 'unknown';
160             },
161 40         264 };
162 40         77 my $state = $self->{state};
163 40         65 $self->{state} = $states->{$state}->($line);
164 40 50       408 if ($self->{debug}) {
165 0         0 print "$state -> $self->{state}: $line";
166             }
167             } # _read_line()
168              
169             # The _l_*() functions are called, when a corresponding regular
170             # expression $_r_* matches the input.
171             #
172             sub _l_strt {
173 2     2   10 my ($self,$count) = @_;
174 2         10 $self->{captured} = $count;
175 2         5 return 'strt';
176             } # _l_strt()
177              
178             sub _l_dscr {
179 5     5   41 my ($self,$nr,$hour,$min,$sec,$usec,$dscr) = @_;
180 5         18 $self->_write_packet();
181 5         11 $self->{packet_number} = $nr;
182 5         7 $self->{packet_dscr} = $dscr;
183 5         31 $self->{packet_secs} = $self->{sot} + 3600 * $hour + 60 * $min + $sec;
184 5         9 $self->{packet_usec} = $usec;
185 5         14 return 'dscr';
186             } # _l_dscr()
187              
188             sub _l_mdsc {
189 0     0   0 my ($self,$dscr) = @_;
190 0         0 $self->{packet_dscr} .= " $dscr";
191 0         0 return 'dscr';
192             } # _l_mdsc()
193              
194             sub _l_dump {
195 22     22   72 my ($self,$offset,$hex,$printable) = @_;
196 22         34 my $bytes = $hex;
197 22         77 $bytes =~ s/ //g;
198 22         34 my $len = length $self->{packet_bytes};
199 22 50       348 if ($len == 2 * hex($offset)) {
200 22         42 $self->{packet_bytes} .= $bytes;
201             } else {
202 0         0 $len = sprintf( "0x%x", $len / 2);
203 0         0 my $pn = $self->{packet_number};
204 0         0 die "Bad things happened: have $len bytes and offset is $offset in packet $pn";
205             }
206 22         43 return 'dump';
207             } # _l_dump()
208              
209             sub _l_stop {
210 0     0   0 _write_packet(@_);
211 0         0 return 'stop';
212             } # _l_stop()
213              
214             # _write_packet() writes the actual datagram data including the packet
215             # header at the end of the PCAP file.
216             #
217             sub _write_packet {
218 7     7   15 my ($self) = @_;
219 7 100       20 if (my $len = length($self->{packet_bytes})) {
220 5 100       15 if ($self->{last_sec} > $self->{packet_secs}) {
221             # we have probably crossed midnight
222 1         3 $self->{packet_secs} += 86400;
223 1         2 $self->{sot} += 86400;
224             }
225 5         8 my $sec = $self->{packet_secs};
226 5         9 my $usec = $self->{packet_usec};
227 5         23 my $buf = pack('H*', $self->{packet_bytes});
228 5         10 $len /= 2;
229 5         21 $self->{fpw}->packet($sec,$usec,$len,$len,$buf);
230 5         17 $self->{packet_bytes} = "";
231 5         16 $self->{last_sec} = $sec;
232             }
233             } # _write_packet()
234              
235             =head1 SEE ALSO
236              
237             Libpcap File Format
238             L
239              
240             Link-Layer Header Types
241             L
242              
243             =head1 AUTHOR
244              
245             Mathias Weidner, C<< >>
246              
247             =head1 BUGS
248              
249             Please report any bugs or feature requests to C, or through
250             the web interface at L. I will be notified, and then you'll
251             automatically be notified of progress on your bug as I make changes.
252              
253             =head1 SUPPORT
254              
255             You can find documentation for this module with the perldoc command.
256              
257             perldoc File::PCAP
258              
259             You can also look for information at:
260              
261             =over 4
262              
263             =item * RT: CPAN's request tracker (report bugs here)
264              
265             L
266              
267             =item * AnnoCPAN: Annotated CPAN documentation
268              
269             L
270              
271             =item * CPAN Ratings
272              
273             L
274              
275             =item * Search CPAN
276              
277             L
278              
279             =back
280              
281             =head1 LICENSE AND COPYRIGHT
282              
283             Copyright 2017 Mathias Weidner.
284              
285             This program is free software; you can redistribute it and/or modify it
286             under the terms of the the Artistic License (2.0). You may obtain a
287             copy of the full license at:
288              
289             L
290              
291             Any use, modification, and distribution of the Standard or Modified
292             Versions is governed by this Artistic License. By using, modifying or
293             distributing the Package, you accept this license. Do not use, modify,
294             or distribute the Package, if you do not accept this license.
295              
296             If your Modified Version has been derived from a Modified Version made
297             by someone other than you, you are nevertheless required to ensure that
298             your Modified Version complies with the requirements of this license.
299              
300             This license does not grant you the right to use any trademark, service
301             mark, tradename, or logo of the Copyright Holder.
302              
303             This license includes the non-exclusive, worldwide, free-of-charge
304             patent license to make, have made, use, offer to sell, sell, import and
305             otherwise transfer the Package with respect to any patent claims
306             licensable by the Copyright Holder that are necessarily infringed by the
307             Package. If you institute patent litigation (including a cross-claim or
308             counterclaim) against any party alleging that the Package constitutes
309             direct or contributory patent infringement, then this Artistic License
310             to you shall terminate on the date that such litigation is filed.
311              
312             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
313             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
314             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
315             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
316             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
317             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
318             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
319             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
320              
321             =cut
322              
323             # vim: set sw=4 ts=4 et:
324             1; # End of File::PCAP