Merge pull request xapi-project#6 from sharady/CP-23210

CP-23210: Add tests for wsproxy

cli/wsproxy.ml

@@ -121,4 +121,4 @@ let _ =
     Lwt_io.with_file filename ~mode:Lwt_io.output (fun chan ->
         Lwt_io.fprintf chan "%d" pid) >>= fun _ ->
     start "wsproxy" handler
-  end
+  end

test/jbuild

@@ -0,0 +1,11 @@
+(jbuild_version 1)
+
+(executable
+ ((name wsproxy_tests)
+  (libraries (oUnit qcheck wslib))
+))
+
+(alias
+ ((name runtest)
+  (deps (wsproxy_tests.exe))
+  (action (run ${<}))))

test/test.ml

@@ -0,0 +1,39 @@
+(*
+ * Copyright (C) Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+
+module NoOpMonad = struct
+  type 'a t = 'a
+
+  let return a = a
+  let bind x f = f x
+end
+
+module StringMonad = struct
+  type 'a t =
+    { data : 'a;
+      str : string }
+  let return a = { data=a; str=""; }
+  let bind x f =
+    let newstr = f x.data in
+    {newstr with str = x.str ^ newstr.str}
+
+  let strwr x =
+    { data=(); str=x }
+  let getstr x = x.str
+  let getdata x = x.data
+end
+
+
+

test/test.mli

@@ -0,0 +1,31 @@
+(*
+ * Copyright (C) Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+
+module NoOpMonad :
+sig
+  type 'a t = 'a
+  val return : 'a -> 'a
+  val bind : 'a -> ('a -> 'b) -> 'b
+end
+
+module StringMonad :
+sig
+  type 'a t = { data : 'a; str : string; }
+  val return : 'a -> 'a t
+  val bind : 'a t -> ('a -> 'b t) -> 'b t
+  val strwr : string -> unit t
+  val getstr : 'a t -> string
+  val getdata : 'a t -> 'a
+end

test/test_helpers.ml

@@ -0,0 +1,93 @@
+(*
+ * Copyright (C) Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open OUnit
+open Wslib
+
+let gen_nums n generator =
+  QCheck.Gen.generate n generator
+
+let test_split () =
+  let (a, b) = Helpers.split "helper" 2 in
+  assert_equal a "he";
+  assert_equal b "lper"
+
+let test_break () =
+  let pred = function | 'x' -> true | _ -> false in
+  let (a, b) = Helpers.break pred "helper" in
+  assert_equal a "helper";
+  assert_equal b "";
+  let (a, b) = Helpers.break pred "helxper" in
+  assert_equal a "hel";
+  assert_equal b "xper"
+
+let test_str_drop_while () =
+  let pred = function | 'x' -> true | _ -> false in
+  let a = Helpers.str_drop_while pred "helper" in
+  assert_equal a "helper";
+  let b = Helpers.str_drop_while pred "xhelper" in
+  assert_equal b "helper"
+
+let test_marshal_unmarshal_int () =
+  let generator = QCheck.Gen.ui64 in
+  let nums = gen_nums 10 generator in
+  List.iter (fun i ->
+    assert_equal i (Helpers.unmarshal_int 8 (Helpers.marshal_int 8 i))
+  ) nums
+
+let test_marshal_unmarshal_int8 () =
+  let generator = QCheck.Gen.int_bound 255 in
+  let nums = gen_nums 10 generator in
+  List.iter (fun i ->
+    assert_equal i (Helpers.unmarshal_int8 (Helpers.marshal_int8 i))
+  ) nums
+
+let test_marshal_unmarshal_int16 () =
+  let generator = QCheck.Gen.int_bound 65535 in
+  let nums = gen_nums 10 generator in
+  List.iter (fun i ->
+    assert_equal i (Helpers.unmarshal_int16 (Helpers.marshal_int16 i))
+  ) nums
+
+let test_marshal_unmarshal_int32 () =
+  let generator = QCheck.Gen.ui32 in
+  let nums = gen_nums 10 generator in
+  List.iter (fun i ->
+    assert_equal i (Helpers.unmarshal_int32 (Helpers.marshal_int32 i))
+  ) nums
+
+let test_marshal_unmarshal_int64 () =
+  let generator = QCheck.Gen.ui64 in
+  let nums = gen_nums 10 generator in
+  List.iter (fun i ->
+    assert_equal i (Helpers.unmarshal_int64 (Helpers.marshal_int64 i))
+  ) nums
+
+let test_unmask () =
+  let a = Helpers.unmask "01010101" "\x01\x01\x01\x01\x01\x01\x01\x01" in
+  assert_equal a "10101010"
+
+let test =
+  "test_helpers" >:::
+  [
+    "test_split" >:: test_split;
+    "test_break" >:: test_break;
+    "test_str_drop_while" >:: test_str_drop_while;
+    "test_marshal_unmarshal_int" >:: test_marshal_unmarshal_int;
+    "test_marshal_unmarshal_int8" >:: test_marshal_unmarshal_int8;
+    "test_marshal_unmarshal_int16" >:: test_marshal_unmarshal_int16;
+    "test_marshal_unmarshal_int32" >:: test_marshal_unmarshal_int32;
+    "test_marshal_unmarshal_int64" >:: test_marshal_unmarshal_int64;
+    "test_unmask" >:: test_unmask;
+  ]

test/test_iteratees.ml

@@ -0,0 +1,100 @@
+(*
+ * Copyright (C) Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open OUnit
+open Wslib
+
+module I = Iteratees.Iteratee(Test.StringMonad)
+module TestWsIteratee = Websockets.Wsprotocol(Test.StringMonad)
+open TestWsIteratee
+open I
+
+let get_data = function
+  | IE_done x -> Some x
+  | IE_cont _ -> None
+
+let test_heads () =
+  let res str =
+    match get_data (Test.StringMonad.getdata (enum_1chunk "test" (heads str))) with
+    | Some x -> x
+    | None -> 1234
+  in
+  assert_equal (res "t") 1;
+  assert_equal (res "te") 2;
+  assert_equal (res "x") 0
+
+let test_drop () =
+  assert_equal (Test.StringMonad.getdata (enum_1chunk "test" (drop 1))) (IE_done ())
+
+let test_readn () =
+  let res i =
+    match get_data (Test.StringMonad.getdata (enum_1chunk "test" (readn i))) with
+    | Some x -> x
+    | None -> "xxxxx"
+  in
+  assert_equal (res 0) "";
+  assert_equal (res 1) "t";
+  assert_equal (res 2) "te";
+  assert_equal (res 4) "test"
+
+let test_read_int8 () =
+  let res str =
+    match get_data (Test.StringMonad.getdata (enum_1chunk str (read_int8))) with
+    | Some x -> x
+    | None -> 0
+  in
+  assert_equal 97 (res "a");
+  assert_equal 65 (res "A");
+  assert_equal 125 (res "}")
+
+let test_peek () =
+  let res str =
+    match get_data (Test.StringMonad.getdata (enum_1chunk str (peek))) with
+    | Some x -> begin match x with | Some c -> c | None -> 'g' end
+    | None -> 'g'
+  in
+  assert_equal 'a' (res "abc");
+  assert_equal 'x' (res "xyz")
+
+let test_head () =
+  let res str =
+    match get_data (Test.StringMonad.getdata (enum_1chunk str (head))) with
+    | Some x -> begin match x with | Some c -> c | None -> 'g' end
+    | None -> 'g'
+  in
+  assert_equal 'a' (res "abc");
+  assert_equal 'x' (res "xyz")
+
+let test_break () =
+  let alter = function | '\n' -> true | _ -> false in
+  let res str =
+    match get_data (Test.StringMonad.getdata (enum_1chunk str (break alter))) with
+    | Some x -> x
+    | None -> "xxxxx"
+  in
+  assert_equal "" (res "\ntest");
+  assert_equal "test" (res "test\nabc");
+  assert_equal "abcxyz" (res "abcxyz\n")
+
+let test =
+  "test_iteratees" >:::
+  [
+    "test_heads" >:: test_heads;
+    "test_drop" >:: test_drop;
+    "test_readn" >:: test_readn;
+    "test_read_int8" >:: test_read_int8;
+    "test_peek" >:: test_peek;
+    "test_head" >:: test_head;
+    "test_break" >:: test_break;
+  ]

test/test_websockets.ml

@@ -0,0 +1,86 @@
+(*
+ * Copyright (C) Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open OUnit
+open Wslib
+
+module TestWsIteratee = Websockets.Wsprotocol(Test.StringMonad)
+module I = Iteratees.Iteratee(Test.StringMonad)
+open TestWsIteratee
+open I
+
+(* Unmasked text message frame *)
+let test_strings =
+  [ "\x81\x05\x48\x65\x6c\x6c\x6f"; (* contains "Hello" *)
+    "\x01\x03\x48\x65\x6c";         (* contains "Hel" *)
+    "\x80\x02\x6c\x6f";             (* contains "lo" *)
+    "\x82\x7F\x0000000000010000";   (* contains 256 bytes of binary data *)
+    "\x82\x7F\x0000000000010000"    (* contains 65536 bytes of binary data *)
+  ]
+let test_old_str = "\x00Hello\xff\x00There\xff"
+(* A single-frame masked text message *)
+let test_mask_str = "\x81\x85\x37\xfa\x21\x3d\x7f\x9f\x4d\x51\x58" (* contains "Hello" *)
+
+let test_wsframe () =
+  let frame = wsframe (writer Test.StringMonad.strwr "foo") in
+  let unframe = wsunframe (writer Test.StringMonad.strwr "bar") in
+  test_strings |> List.iter (fun str ->
+    (* Test with enum_1chunk *)
+    let x = enum_1chunk (Test.StringMonad.getstr (enum_1chunk str frame)) unframe in
+    assert_equal str (Test.StringMonad.getstr x);
+    (* Test with enum_nchunk *)
+    for i = 1 to 10 do
+      let z = enum_nchunk (Test.StringMonad.getstr (enum_nchunk str i frame)) i unframe in
+      assert_equal str (Test.StringMonad.getstr z)
+    done)
+
+let test_wsframe_old () =
+  let frame = wsframe_old (writer Test.StringMonad.strwr "foo") in
+  let unframe = wsunframe_old (writer Test.StringMonad.strwr "bar") in
+  test_strings |> List.iter (fun str ->
+    (* Test with enum_1chunk *)
+    let x = enum_1chunk (Test.StringMonad.getstr (enum_1chunk str frame)) unframe in
+    assert_equal str (Test.StringMonad.getstr x);
+    (* Test with enum_nchunk *)
+    for i = 1 to 10 do
+      let z = enum_nchunk (Test.StringMonad.getstr (enum_nchunk str i frame)) i unframe in
+      assert_equal str (Test.StringMonad.getstr z)
+    done)
+
+let test_wsunframe () =
+  let unframe = wsunframe (writer Test.StringMonad.strwr "foo") in
+  (* Test with enum_1chunk *)
+  assert_equal "Hello" (Test.StringMonad.getstr (enum_1chunk test_mask_str unframe));
+  (* Test with enum_nchunk *)
+  for i = 1 to 10 do
+    assert_equal "Hello" (Test.StringMonad.getstr (enum_nchunk test_mask_str i unframe))
+  done
+
+let test_wsunframe_old () =
+  let unframe = wsunframe_old (writer Test.StringMonad.strwr "foo") in
+  (* Test with enum_1chunk *)
+  assert_equal "HelloThere" (Test.StringMonad.getstr (enum_1chunk test_old_str unframe));
+  (* Test with enum_nchunk *)
+  for i = 1 to 10 do
+    assert_equal "HelloThere" (Test.StringMonad.getstr (enum_nchunk test_old_str i unframe))
+  done
+
+let test =
+  "test_websockets" >:::
+  [
+    "test_wsframe" >:: test_wsframe;
+    "test_wsunframe" >:: test_wsunframe;
+    "test_wsframe_old" >:: test_wsframe_old;
+    "test_wsunframe_old" >:: test_wsunframe_old;
+  ]

test/wsproxy_tests.ml

@@ -0,0 +1,26 @@
+(*
+ * Copyright (C) Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open OUnit
+
+let tests =
+  "tests" >:::
+  [
+    Test_helpers.test;
+    Test_iteratees.test;
+    Test_websockets.test;
+  ]
+
+let () =
+  ounit2_of_ounit1 tests |> OUnit2.run_test_tt_main;