examples/ping.ml

   1 (* Read in IPv4 and IPv6 ping packets and display them.
   2  * $Id: 60_ping.ml,v 1.3 2008-04-25 11:08:43 rjones Exp $
   3  *)
   4
   5 open Printf
   6
   7 let display pkt =
   8   bitmatch pkt with
   9   (* IPv4 packet header *)
  10   | { 4 : 4; hdrlen : 4; tos : 8; length : 16;
  11       identification : 16; flags : 3; fragoffset : 13;
  12       ttl : 8; protocol : 8; checksum : 16;
  13       source : 32;
  14       dest : 32;
  15       options : (hdrlen-5)*32 : bitstring;
  16       payload : -1 : bitstring } ->
  17
  18     printf "IPv4:\n";
  19     printf "  header length: %d * 32 bit words\n" hdrlen;
  20     printf "  type of service: %d\n" tos;
  21     printf "  packet length: %d bytes\n" length;
  22     printf "  identification: %d\n" identification;
  23     printf "  flags: %d\n" flags;
  24     printf "  fragment offset: %d\n" fragoffset;
  25     printf "  ttl: %d\n" ttl;
  26     printf "  protocol: %d\n" protocol;
  27     printf "  checksum: %d\n" checksum;
  28     printf "  source: %lx  dest: %lx\n" source dest;
  29     printf "  header options + padding:\n";
  30     Bitmatch.hexdump_bitstring stdout options;
  31     printf "  packet payload:\n";
  32     Bitmatch.hexdump_bitstring stdout payload
  33
  34   (* IPv6 packet header *)
  35   | { 6 : 4; tclass : 8; flow : 20;
  36       length : 16; nexthdr : 8; ttl : 8;
  37       source : 128 : bitstring;
  38       dest : 128 : bitstring;
  39       payload : -1 : bitstring } ->
  40
  41     printf "IPv6:\n";
  42     printf "  traffic class: %d\n" tclass;
  43     printf "  flow label: %d\n" flow;
  44     printf "  packet (payload) length: %d bytes\n" length;
  45     printf "  next header: %d\n" nexthdr;
  46     printf "  ttl: %d\n" ttl;
  47     printf "  source address:\n";
  48     Bitmatch.hexdump_bitstring stdout source;
  49     printf "  destination address:\n";
  50     Bitmatch.hexdump_bitstring stdout dest;
  51     printf "packet payload:\n";
  52     Bitmatch.hexdump_bitstring stdout payload
  53
  54   | { version : 4 } ->
  55     eprintf "unknown IP version %d\n" version;
  56     exit 1
  57
  58   | { _ } as pkt ->
  59     eprintf "data is smaller than one nibble:\n";
  60     Bitmatch.hexdump_bitstring stderr pkt;
  61     exit 1
  62
  63 let () =
  64   let pkt = Bitmatch.bitstring_of_file "tests/ipv4.ping" in
  65   display pkt;
  66   let pkt = Bitmatch.bitstring_of_file "tests/ipv6.ping" in
  67   display pkt