File Coverage

blib/lib/Net/PcapWriter.pm

Criterion	Covered	Total	%
statement	47	52	90.3
branch	5	10	50.0
condition	1	2	50.0
subroutine	14	14	100.0
pod	6	7	85.7
total	73	85	85.8

use strict;
use warnings;
package Net::PcapWriter;
use Time::HiRes 'gettimeofday';
use Net::PcapWriter::TCP;
use Net::PcapWriter::UDP;
use Net::PcapWriter::ICMP_Echo;

our $VERSION = '0.722';

sub new {
    my ($class,$file) = @_;
    my $self = bless { fh => undef },$class;
    $self->reopen($file);
    return $self;
}

sub reopen {
    my ($self,$file) = @_;
    my $fh;
    if ( $file ) {
	if ( ref($file)) {
	    $fh = $file
	} else {
	    open($fh,'>',$file) or die "open $file: $!";
	    binmode($fh);
	}
    } else {
	$fh = \*STDOUT;
    }
    $self->{fh} = $fh;
    $self->_header;
}

# write pcap header
sub _header {
    my $self = shift;

    # struct pcap_file_header {
    #     bpf_u_int32 magic;
    #     u_short version_major;
    #     u_short version_minor;
    #     bpf_int32 thiszone; /* gmt to local correction */
    #     bpf_u_int32 sigfigs;    /* accuracy of timestamps */
    #     bpf_u_int32 snaplen;    /* max length saved portion of each pkt */
    #     bpf_u_int32 linktype;   /* data link type (LINKTYPE_*) */
    # };

    print {$self->{fh}} pack('LSSlLLL',
	0xa1b2c3d4, # magic
	2,4,        # major, minor
	0,0,        # timestamps correction and accuracy
	0xffff,     # snaplen
	1,          # DLT_EN10MB
    );
}

sub layer2prefix {
    my $ip = pop;
    return pack("NnNnn",
	0,1,0,1, # all macs 0:*
	$ip =~m{:} ? 0x86dd: 0x0800, # ETH_TYPE_IP6 | ETH_TYPE_IP
    );
}

# write pcap packet
sub packet {
    my ($self,$data,$timestamp) = @_;
    $timestamp ||= [ gettimeofday() ];

    # struct pcap_pkthdr {
    #     struct timeval ts;  /* time stamp */
    #     bpf_u_int32 caplen; /* length of portion present */
    #     bpf_u_int32 len;    /* length this packet (off wire) */
    # };

    my ($tsec,$tmsec);
    if (ref($timestamp)) {
	# array like in Time::HiRes
	($tsec,$tmsec) = @$timestamp;
    } else {
	$tsec = int($timestamp);
	$tmsec = int(($timestamp - $tsec)*1_000_000);
    }

    print {$self->{fh}} pack('LLLLa*',
	$tsec,$tmsec,       # struct timeval ts
	length($data),      # caplen
	length($data),      # len
	$data,              # data
    );
}


# return new TCP connection object
sub tcp_conn {
    my ($self,$src,$sport,$dst,$dport) = @_;
    return Net::PcapWriter::TCP->new($self,$src,$sport,$dst,$dport);
}

# return new UDP connection object
sub udp_conn {
    my ($self,$src,$sport,$dst,$dport) = @_;
    return Net::PcapWriter::UDP->new($self,$src,$sport,$dst,$dport);
}

# return new ICMP_Echo "connection" object
sub icmp_echo_conn {
    my ($self,$src,$dst,$id) = @_;
    return Net::PcapWriter::ICMP_Echo->new($self,$src,$dst,$id);
}

1;

__END__