Add HTTPS support.
This commit is contained in:
parent
187b82fd41
commit
383920e6ee
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue