Fix svnignore in the examples subdirectory.
[ocaml-bitstring.git] / tests / 60_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