scripts/l2tpns-capture

   1 #! /usr/bin/perl -w
   2
   3 #
   4 # Accept intercept data from l2tpns, write to a file in pcap format
   5 # (http://wiki.ethereal.com/Development/LibpcapFileFormat) suffixed
   6 # with timestamp.  Killing the process with SIGHUP causes a new file
   7 # to be opened.
   8 #
   9
  10 use strict;
  11 use IO::File;
  12 use IO::Socket;
  13 use Time::HiRes 'gettimeofday';
  14
  15 (my $cmd = $0) =~ s!.*/!!;
  16
  17 die "Usage: $cmd PREFIX PORT\n" unless @ARGV == 2 and $ARGV[1] =~ /^\d+$/;
  18
  19 my ($prefix, $port) = @ARGV;
  20 my $sock = IO::Socket::INET->new(
  21     LocalPort   => $port,
  22     Proto       => 'udp',
  23     Type        => SOCK_DGRAM,
  24 ) or die "$cmd: can't bind to port $port ($!)\n";
  25
  26 my $restart = 0;
  27 $SIG{HUP} = sub { $restart++ };
  28
  29 my $header = pack LSSlLLL =>
  30     0xa1b2c3d4, # magic no
  31     2,          # version maj
  32     4,          # version min
  33     0,          # timezone offset (GMT)
  34     0,          # timestamp accuracy
  35     65536,      # snaplen
  36     12;         # link type (RAW_IP)
  37
  38 my $cap;
  39 my $buf;
  40 my $file;
  41 for (;;)
  42 {
  43     unless ($cap)
  44     {
  45         $file = $prefix . time;
  46         $cap = IO::File->new("> $file")
  47             or die "$0: can't create capture file $file ($!)\n";
  48
  49         $cap->print($header)
  50             or die "$0: error writing to $file ($!)\n";
  51     }
  52
  53     while ($sock->recv($buf, 1600))
  54     {
  55         $cap->print(
  56             # packet header: sec, usec, included size, original size
  57             (pack LLLL => (gettimeofday), (length $buf) x 2),
  58             $buf
  59         ) or die "$0: error writing to $file ($!)\n";
  60     }
  61
  62     if ($restart)
  63     {
  64         $restart = 0;
  65         $cap->close;
  66         undef $cap;
  67     }
  68 }