Add HTTPS support.

This commit is contained in:
Fabien Freling 2015-07-31 21:22:24 +02:00
parent 187b82fd41
commit 383920e6ee
3 changed files with 14 additions and 4 deletions

View file

@ -1,3 +1,3 @@
true: package(netclient), package(netstring) true: package(netclient), package(netstring), package(nettls-gnutls)
<test.*>: package(oUnit) <test.*>: package(oUnit)
<irc.*>: package(irc-client.lwt) <irc.*>: package(irc-client.lwt)

View file

@ -4,6 +4,8 @@ open Nethtml
open Netencoding;; open Netencoding;;
Nettls_gnutls.init();;
let extract_string_value document = let extract_string_value document =
match document with match document with
| Data(s) -> Some s | Data(s) -> Some s

View file

@ -33,12 +33,20 @@ let test_escape_characters text_ctx =
assert_equal expected (SimpleHttp.decode_esc_char html_str) assert_equal expected (SimpleHttp.decode_esc_char html_str)
let test_https test_ctx =
let url = "https://en.wikipedia.org/wiki/Main_Page" in
let title = SimpleHttp.get_http_title (SimpleHttp.get_body url) in
assert_equal (Some "Wikipedia, the free encyclopedia") title
(* Name the test cases and group them together *) (* Name the test cases and group them together *)
let suite = let suite =
"suite">::: "suite">:::
["test get_title">:: test_get_title; [
"test get_title">:: test_get_title;
"test remove_spaces">:: test_remove_spaces; "test remove_spaces">:: test_remove_spaces;
"test HTML character escaping">:: test_escape_characters] "test HTML character escaping">:: test_escape_characters;
"test HTTPS">:: test_https
]
let () = let () =
run_test_tt_main suite run_test_tt_main suite