diff --git a/.merlin b/.merlin index 621508a41..c100cfb97 100644 --- a/.merlin +++ b/.merlin @@ -1,4 +1,5 @@ PKG lwt cstruct mirage-net-unix mirage +PKG pcap-format oUnit S lib S lib_test S lwt diff --git a/Makefile b/Makefile index b3907f60b..47b346fc1 100644 --- a/Makefile +++ b/Makefile @@ -38,3 +38,7 @@ install: setup.bin: setup.ml ocamlopt.opt -o $@ $< || ocamlopt -o $@ $< || ocamlc -o $@ $< $(RM) setup.cmx setup.cmi setup.o setup.cmo + +test: build + ./setup.bin -test + diff --git a/_oasis b/_oasis index fbc696cd8..6fc903afa 100644 --- a/_oasis +++ b/_oasis @@ -131,8 +131,17 @@ Executable async_resolver Install: false BuildDepends: async, dns.async +Executable test + Path: lib_test/ounit + MainIs: test.ml + Build$: flag(tests) + Custom: true + CompiledObject: best + Install: false + BuildDepends: dns, unix, oUnit, pcap-format + +Test test + Run$: flag(tests) + Command: $test + WorkingDirectory: lib_test/ounit -Test lwt_server - Run$: flag(tests) && flag(lwt) - Command: $lwt_server - WorkingDirectory: lib_test/unix diff --git a/_tags b/_tags index d8a34ee26..33d525c3a 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: b3901364fc2b9324b871174e167753ca) +# DO NOT EDIT (digest: 6bcb902477722ed05ad25beb2555acfe) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process @@ -168,6 +168,28 @@ true: annot, bin_annot : use_dns : use_dns-async : custom +# Executable test +: pkg_base64 +: pkg_cstruct +: pkg_cstruct.syntax +: pkg_ipaddr +: pkg_oUnit +: pkg_pcap-format +: pkg_re +: pkg_re.str +: pkg_unix +: use_dns +: pkg_base64 +: pkg_cstruct +: pkg_cstruct.syntax +: pkg_ipaddr +: pkg_oUnit +: pkg_pcap-format +: pkg_re +: pkg_re.str +: pkg_unix +: use_dns +: custom # OASIS_STOP true: annot, bin_annot : syntax_camlp4o, pkg_lwt.syntax diff --git a/lib_test/ounit/dns-q-A.pcap b/lib_test/ounit/dns-q-A.pcap new file mode 100644 index 000000000..372631774 Binary files /dev/null and b/lib_test/ounit/dns-q-A.pcap differ diff --git a/lib_test/ounit/dns-r-A.pcap b/lib_test/ounit/dns-r-A.pcap new file mode 100644 index 000000000..7cd0d0a90 Binary files /dev/null and b/lib_test/ounit/dns-r-A.pcap differ diff --git a/lib_test/ounit/mdns-q-A.pcap b/lib_test/ounit/mdns-q-A.pcap new file mode 100644 index 000000000..637c9c920 Binary files /dev/null and b/lib_test/ounit/mdns-q-A.pcap differ diff --git a/lib_test/ounit/mdns-r-A.pcap b/lib_test/ounit/mdns-r-A.pcap new file mode 100644 index 000000000..c4afd7875 Binary files /dev/null and b/lib_test/ounit/mdns-r-A.pcap differ diff --git a/lib_test/ounit/test.ml b/lib_test/ounit/test.ml new file mode 100644 index 000000000..a1b994001 --- /dev/null +++ b/lib_test/ounit/test.ml @@ -0,0 +1,8 @@ + +open OUnit2 + +let () = + run_test_tt_main ("dns" >::: [ + Test_packet.tests; + ]) + diff --git a/lib_test/ounit/test_packet.ml b/lib_test/ounit/test_packet.ml new file mode 100644 index 000000000..e749ac131 --- /dev/null +++ b/lib_test/ounit/test_packet.ml @@ -0,0 +1,167 @@ + +open OUnit2 +open Printf + +exception TestData + +(* Adapted from ocaml-pcap/print/print.ml *) + +cstruct ethernet { + uint8_t dst[6]; + uint8_t src[6]; + uint16_t ethertype + } as big_endian + +cstruct ipv4 { + uint8_t hlen_version; + uint8_t tos; + uint16_t len; + uint16_t id; + uint16_t off; + uint8_t ttl; + uint8_t proto; + uint16_t csum; + uint8_t src[4]; + uint8_t dst[4] + } as big_endian + +cstruct udpv4 { + uint16_t source_port; + uint16_t dest_port; + uint16_t length; + uint16_t checksum + } as big_endian + +let load_pcap path = + let fd = Unix.(openfile path [O_RDONLY] 0) in + let buf = Bigarray.(Array1.map_file fd Bigarray.char c_layout false (-1)) in + let buf = Cstruct.of_bigarray buf in + let header, body = Cstruct.split buf Pcap.sizeof_pcap_header in + match Pcap.detect header with + | Some h -> + Pcap.packets h body + | None -> + assert_failure "Not pcap format" + +let load_packet path = + match (load_pcap path) () with + | Some (hdr, eth) -> + assert_equal 0x0800 (get_ethernet_ethertype eth); + let ip = Cstruct.shift eth sizeof_ethernet in + let version = get_ipv4_hlen_version ip lsr 4 in + assert_equal 4 version; + assert_equal 17 (get_ipv4_proto ip); + let udp = Cstruct.shift ip sizeof_ipv4 in + let body = Cstruct.shift udp sizeof_udpv4 in + Dns.Buf.of_cstruct body + | None -> + assert_failure "No packets" + +open Dns.Packet +open Dns.Name + +let tests = + "Packet" >::: + [ + "parse-dns-q" >:: (fun test_ctxt -> + let raw = load_packet "dns-q-A.pcap" in + let packet = parse raw in + assert_equal ~msg:"id" 0x930b packet.id; + assert_equal ~msg:"qr" Query packet.detail.qr; + assert_equal ~msg:"opcode" Standard packet.detail.opcode; + assert_equal ~msg:"aa" false packet.detail.aa; + assert_equal ~msg:"tc" false packet.detail.tc; + assert_equal ~msg:"rd" true packet.detail.rd; + assert_equal ~msg:"ra" false packet.detail.ra; + assert_equal ~msg:"rcode" NoError packet.detail.rcode; + assert_equal ~msg:"#qu" 1 (List.length packet.questions); + assert_equal ~msg:"#an" 0 (List.length packet.answers); + assert_equal ~msg:"#ad" 0 (List.length packet.additionals); + + let q = List.hd packet.questions in + assert_equal ~msg:"q_name" "www.google.com" (domain_name_to_string q.q_name); + assert_equal ~msg:"q_type" Q_A q.q_type; + assert_equal ~msg:"q_class" Q_IN q.q_class; + ); + + "parse-dns-r-A" >:: (fun test_ctxt -> + let raw = load_packet "dns-r-A.pcap" in + let packet = parse raw in + assert_equal ~msg:"id" 0x930b packet.id; + assert_equal ~msg:"qr" Response packet.detail.qr; + assert_equal ~msg:"opcode" Standard packet.detail.opcode; + assert_equal ~msg:"aa" false packet.detail.aa; + assert_equal ~msg:"tc" false packet.detail.tc; + assert_equal ~msg:"rd" true packet.detail.rd; + assert_equal ~msg:"ra" true packet.detail.ra; + assert_equal ~msg:"rcode" NoError packet.detail.rcode; + assert_equal ~msg:"#qu" 1 (List.length packet.questions); + assert_equal ~msg:"#an" 5 (List.length packet.answers); + assert_equal ~msg:"#ad" 0 (List.length packet.additionals); + + let q = List.hd packet.questions in + assert_equal ~msg:"q_name" "www.google.com" (domain_name_to_string q.q_name); + assert_equal ~msg:"q_type" Q_A q.q_type; + assert_equal ~msg:"q_class" Q_IN q.q_class; + + let rev_answers = List.rev packet.answers in + let expected_fourth = [208; 211; 209; 212; 210] in + List.iter2 (fun fourth a -> + assert_equal ~msg:"name" "www.google.com" (domain_name_to_string a.name); + assert_equal ~msg:"cls" RR_IN a.cls; + assert_equal ~msg:"flush" false a.flush; + assert_equal ~msg:"ttl" (Int32.of_int 220) a.ttl; + let expected_addr = "74.125.237." ^ (string_of_int fourth) in + match a.rdata with + | A addr -> assert_equal ~msg:"A" ~printer:(fun s -> s) expected_addr (Ipaddr.V4.to_string addr) + | _ -> assert_failure "RR type"; + ) expected_fourth rev_answers + ); + + "parse-mdns-q-A" >:: (fun test_ctxt -> + let raw = load_packet "mdns-q-A.pcap" in + let packet = parse raw in + assert_equal ~msg:"id" 0 packet.id; + assert_equal ~msg:"qr" Query packet.detail.qr; + assert_equal ~msg:"opcode" Standard packet.detail.opcode; + assert_equal ~msg:"aa" false packet.detail.aa; + assert_equal ~msg:"tc" false packet.detail.tc; + assert_equal ~msg:"rd" false packet.detail.rd; + assert_equal ~msg:"ra" false packet.detail.ra; + assert_equal ~msg:"rcode" NoError packet.detail.rcode; + assert_equal ~msg:"#qu" 1 (List.length packet.questions); + assert_equal ~msg:"#an" 0 (List.length packet.answers); + assert_equal ~msg:"#ad" 0 (List.length packet.additionals); + + let q = List.hd packet.questions in + assert_equal ~msg:"q_name" "cubieboard2.local" (domain_name_to_string q.q_name); + assert_equal ~msg:"q_type" Q_A q.q_type; + assert_equal ~msg:"q_class" Q_IN q.q_class + ); + + "parse-mdns-r-A" >:: (fun test_ctxt -> + let raw = load_packet "mdns-r-A.pcap" in + let packet = parse raw in + assert_equal ~msg:"id" 0 packet.id; + assert_equal ~msg:"qr" Response packet.detail.qr; + assert_equal ~msg:"opcode" Standard packet.detail.opcode; + assert_equal ~msg:"aa" true packet.detail.aa; + assert_equal ~msg:"tc" false packet.detail.tc; + assert_equal ~msg:"rd" false packet.detail.rd; + assert_equal ~msg:"ra" false packet.detail.ra; + assert_equal ~msg:"rcode" NoError packet.detail.rcode; + assert_equal ~msg:"#qu" 0 (List.length packet.questions); + assert_equal ~msg:"#an" 1 (List.length packet.answers); + assert_equal ~msg:"#ad" 0 (List.length packet.additionals); + + let a = List.hd packet.answers in + assert_equal ~msg:"name" "cubieboard2.local" (domain_name_to_string a.name); + assert_equal ~msg:"cls" RR_IN a.cls; + assert_equal ~msg:"flush" true a.flush; + assert_equal ~msg:"ttl" (Int32.of_int 120) a.ttl; + match a.rdata with + | A addr -> assert_equal ~msg:"A" "192.168.2.106" (Ipaddr.V4.to_string addr) + | _ -> assert_failure "RR type"; + ); + ] + diff --git a/myocamlbuild.ml b/myocamlbuild.ml index 37c9014a4..245eb0e70 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -1,5 +1,5 @@ (* OASIS_START *) -(* DO NOT EDIT (digest: 431e2a727922c8711dad01fd85c1dba3) *) +(* DO NOT EDIT (digest: c0bc55b8a1eef376ad5f495bdd68cf50) *) module OASISGettext = struct (* # 22 "src/oasis/OASISGettext.ml" *) @@ -622,6 +622,7 @@ let package_default = ("mirage", ["lib"; "lwt"]); ("lwt", ["lib"]); ("lib_test/unix", ["lib"; "lwt"]); + ("lib_test/ounit", ["lib"]); ("lib_test/async", ["async"]); ("async", ["lib"]) ] @@ -632,6 +633,6 @@ let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; -# 636 "myocamlbuild.ml" +# 637 "myocamlbuild.ml" (* OASIS_STOP *) Ocamlbuild_plugin.dispatch dispatch_default;; diff --git a/setup.ml b/setup.ml index c18fd2038..065386291 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.4.5 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 8966673d9a39e33e51ab12eda2547c77) *) +(* DO NOT EDIT (digest: f40142e7bb128f4c6d5ad87d03fd598d) *) (* Regenerated by OASIS v0.4.5 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6805,11 +6805,11 @@ let setup_t = build = OCamlbuildPlugin.build []; test = [ - ("lwt_server", + ("test", CustomPlugin.Test.main { CustomPlugin.cmd_main = - [(OASISExpr.EBool true, ("$lwt_server", []))]; + [(OASISExpr.EBool true, ("$test", []))]; cmd_clean = [(OASISExpr.EBool true, None)]; cmd_distclean = [(OASISExpr.EBool true, None)] }) @@ -6828,11 +6828,11 @@ let setup_t = clean = [OCamlbuildPlugin.clean]; clean_test = [ - ("lwt_server", + ("test", CustomPlugin.Test.clean { CustomPlugin.cmd_main = - [(OASISExpr.EBool true, ("$lwt_server", []))]; + [(OASISExpr.EBool true, ("$test", []))]; cmd_clean = [(OASISExpr.EBool true, None)]; cmd_distclean = [(OASISExpr.EBool true, None)] }) @@ -6849,11 +6849,11 @@ let setup_t = distclean = []; distclean_test = [ - ("lwt_server", + ("test", CustomPlugin.Test.distclean { CustomPlugin.cmd_main = - [(OASISExpr.EBool true, ("$lwt_server", []))]; + [(OASISExpr.EBool true, ("$test", []))]; cmd_clean = [(OASISExpr.EBool true, None)]; cmd_distclean = [(OASISExpr.EBool true, None)] }) @@ -7427,31 +7427,61 @@ let setup_t = exec_custom = true; exec_main_is = "test_async_dns_resolver_unix.ml" }); + Executable + ({ + cs_name = "test"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + bs_build = + [ + (OASISExpr.EBool true, false); + (OASISExpr.EFlag "tests", true) + ]; + bs_install = [(OASISExpr.EBool true, false)]; + bs_path = "lib_test/ounit"; + bs_compiled_object = Best; + bs_build_depends = + [ + InternalLibrary "dns"; + FindlibPackage ("unix", None); + FindlibPackage ("oUnit", None); + FindlibPackage ("pcap-format", None) + ]; + bs_build_tools = [ExternalTool "ocamlbuild"]; + bs_c_sources = []; + bs_data_files = []; + bs_ccopt = [(OASISExpr.EBool true, [])]; + bs_cclib = [(OASISExpr.EBool true, [])]; + bs_dlllib = [(OASISExpr.EBool true, [])]; + bs_dllpath = [(OASISExpr.EBool true, [])]; + bs_byteopt = [(OASISExpr.EBool true, [])]; + bs_nativeopt = [(OASISExpr.EBool true, [])] + }, + {exec_custom = true; exec_main_is = "test.ml"}); Test ({ - cs_name = "lwt_server"; + cs_name = "test"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { test_type = (`Test, "custom", Some "0.4"); - test_command = - [(OASISExpr.EBool true, ("$lwt_server", []))]; + test_command = [(OASISExpr.EBool true, ("$test", []))]; test_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)] }; - test_working_directory = Some "lib_test/unix"; + test_working_directory = Some "lib_test/ounit"; test_run = [ (OASISExpr.ENot (OASISExpr.EFlag "tests"), false); (OASISExpr.EFlag "tests", false); (OASISExpr.EAnd (OASISExpr.EFlag "tests", - OASISExpr.EAnd - (OASISExpr.EFlag "tests", - OASISExpr.EFlag "lwt")), + OASISExpr.EFlag "tests"), true) ]; test_tools = [ExternalTool "ocamlbuild"] @@ -7464,7 +7494,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.5"; - oasis_digest = Some "\144=/_@\132'๘ึ8f\b\002\006สน"; + oasis_digest = Some "\168\204\203?g\246D\163\147\176mlw\254\n\134"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7472,6 +7502,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7476 "setup.ml" +# 7506 "setup.ml" (* OASIS_STOP *) let () = setup ();;