Merge pull request #33 from fugitifduck/master

Add IPv6 support

Author: seliopou

lib/Packet.ml

@@ -30,7 +30,7 @@ let get_byte32 (n : Int32.t) (i : int) : int =
   to_int (logand 0xFFl (shift_right_logical n (8 * i)))
 
 let get_byte (n:int64) (i:int) : int =
-  if i < 0 || i > 5 then
+  if i < 0 || i > 7 then
     raise (Invalid_argument "Int64.get_byte index out of range");
   Int64.to_int (Int64.logand 0xFFL (Int64.shift_right_logical n (8 * i)))
 
@@ -58,6 +58,13 @@ let string_of_ip (ip : Int32.t) : string =
   Format.sprintf "%d.%d.%d.%d" (get_byte32 ip 3) (get_byte32 ip 2) 
     (get_byte32 ip 1) (get_byte32 ip 0)
 
+let string_of_ipv6 ((ip1,ip2) : int64*int64) : string =
+  Format.sprintf "%02x%02x:%02x%02x:%02x%02x:%02x%02x:%02x%02x:%02x%02x:%02x%02x:%02x%02x"
+   (get_byte ip1 7) (get_byte ip1 6) (get_byte ip1 5) (get_byte ip1 4)
+   (get_byte ip1 3) (get_byte ip1 2) (get_byte ip1 1) (get_byte ip1 0)
+   (get_byte ip2 7) (get_byte ip2 6) (get_byte ip2 5) (get_byte ip2 4)
+   (get_byte ip2 3) (get_byte ip2 2) (get_byte ip2 1) (get_byte ip2 0)
+
 let string_of_mac (x:int64) : string =
   Format.sprintf "%02x:%02x:%02x:%02x:%02x:%02x"
     (get_byte x 5) (get_byte x 4) (get_byte x 3)
@@ -109,6 +116,8 @@ type nwProto = int8 with sexp
 
 type nwTos = int8 with sexp
 
+type ipv6Addr = int64*int64 with sexp
+
 type tpPort = int16 with sexp
 
 let mk_pseudo_header (src : nwAddr) (dst : nwAddr) (proto : int) (len : int) =
@@ -1376,3 +1385,27 @@ let mac_of_string (s : string) : dlAddr =
                (logor (shift_left (parse_byte (List.nth bytes 3)) 16)
                   (logor (shift_left (parse_byte (List.nth bytes 4)) 8)
                      (parse_byte (List.nth bytes 5)))))))
+
+let ipv6_of_string (s : string) : ipv6Addr =
+  let bytes = Str.split (Str.regexp ":") s in
+  let bytes_len = List.length bytes in
+  let rec fill_with_0 n =
+    if n = 0 then ["0"]
+    else "0"::(fill_with_0 (n-1)) in
+  let rec fill_bytes bytes =
+    match bytes with
+      | [] -> []
+      | ""::q -> List.append (fill_with_0 (8-bytes_len)) q
+      | t::q -> t::(fill_bytes q) in
+  let bytes = fill_bytes bytes in
+  let parse_byte str = Int64.of_string ("0x" ^ str) in
+  let open Int64 in
+      (logor (shift_left (parse_byte (List.nth bytes 0)) 48)
+         (logor (shift_left (parse_byte (List.nth bytes 1)) 32)
+            (logor (shift_left (parse_byte (List.nth bytes 2)) 16)
+               (parse_byte (List.nth bytes 3))))),
+      (logor (shift_left (parse_byte (List.nth bytes 4)) 48)
+         (logor (shift_left (parse_byte (List.nth bytes 5)) 32)
+            (logor (shift_left (parse_byte (List.nth bytes 6)) 16)
+               (parse_byte (List.nth bytes 7)))))
+                        

lib/Packet.mli

@@ -51,6 +51,9 @@ type nwProto = int8 with sexp
 (** [nwTos] is the type of IPv4 types of service. *)
 type nwTos = int8 with sexp
 
+(** [ipv6Addr] is the type of IPv6 addresses. *)
+type ipv6Addr = int64*int64 with sexp
+
 (** [tpPort] is the type of transport protocol ports. *)
 type tpPort = int16 with sexp
 
@@ -376,6 +379,12 @@ val string_of_nwProto : nwProto -> string
 (** [string_of_nwTos t] pretty-prints an IPv4 type of service. *)
 val string_of_nwTos : nwTos -> string
 
+(** [string_of_ipv6 t] pretty-prints an IPv6 address. **)
+val string_of_ipv6 : ipv6Addr -> string
+
+(** [string_of_ipv6 t] Converts a colon-separated IPv6 address to ipv6Addr. **)
+val ipv6_of_string : string -> ipv6Addr
+
 (** [string_of_tpPort p] pretty-prints a transport protocol port number. *)
 val string_of_tpPort : tpPort -> string
 

quickcheck/Arbitrary_Base.ml

@@ -1,6 +1,8 @@
 open QuickCheck
 module Gen = QuickCheck_gen
 
+type int128 = int64 * int64
+
 (* arbitrary instance for usigned integers, using `int` type. *)
 let arbitrary_uint = Gen.sized (fun n -> Gen.choose_int (0, n))
 
@@ -42,7 +44,7 @@ let arbitrary_uint48 =
     let lo = of_int c in
     ret_gen Int64.(logor (logor hi mid) lo)
 
-(* arbitrary instance for unsigned int48, using the `int64` type. *)
+(* arbitrary instance for unsigned int68, using the `int64` type. *)
 let arbitrary_uint64 =
   let open Gen in
   arbitrary_uint16 >>= fun a ->
@@ -56,6 +58,13 @@ let arbitrary_uint64 =
     let lo = of_int d in
     ret_gen Int64.(logor (logor hi (logor mid1 mid2)) lo)
 
+(* arbitrary instance for unsigned int128, using the `int64` type. *)
+let arbitrary_uint128 =
+  let open Gen in
+  arbitrary_uint64 >>= fun a ->
+  arbitrary_uint64 >>= fun b ->
+    ret_gen (a,b)
+
 
 (* arbitrary instance for option type, favoring `Some` rather than `None` *)
 let arbitrary_option arb =

quickcheck/Arbitrary_Base.mli

@@ -1,5 +1,7 @@
 open QuickCheck
 
+type int128 = int64 * int64
+
 (* arbitrary instance for usigned integers. Still uses the `int` type. *)
 val arbitrary_uint : int arbitrary
 
@@ -27,5 +29,8 @@ val arbitrary_uint48 : int64 arbitrary
 (* arbitrary instance for unsigned int64, using the `int64` type. *)
 val arbitrary_uint64 : int64 arbitrary
 
+(* arbitrary instance for unsigned int64, using the `int64` type. *)
+val arbitrary_uint128 : int128 arbitrary
+
 (* arbitrary instance for option type, favoring `Some` rather than `None` *)
 val arbitrary_option : 'a arbitrary -> 'a option arbitrary

test/Test.ml

@@ -1,5 +1,6 @@
 open Packet
 open QuickCheck
+open Arbitrary_Base
 
 module Gen = QuickCheck_gen
 
@@ -104,6 +105,23 @@ module RoundTrip = struct
     (packet_quickCheck (mk_ip tcp)
       (prop_roundtrip2 parse marshal))
 
+  let addr_roundtrip parse marshal e =
+    (parse (marshal e)) = e
+
+  let addr_quickcheck arbitrary parse marshal =
+    let show (p1,p2) = 
+      Format.sprintf "%Lu %Lu" p1 p2 in
+    let test = testable_fun arbitrary show testable_bool in
+    match quickCheck test (addr_roundtrip parse marshal) with
+      | Success -> true
+      | Failure _ -> failwith "No failure expected"
+      | Exhausted _ -> failwith "No exhaustion expected"
+
+  TEST "Roundtrip property for IPv6 Address" =
+    (addr_quickcheck arbitrary_uint128
+      ipv6_of_string string_of_ipv6)
+
+
 end
 
 Pa_ounit_lib.Runtime.summarize ()