test_ssl.ml

open Core.Std
open Async.Std
open Async_ssl.Std
open Log.Global

open Re2.Std


(*
  ocamlbuild \
    -use-ocamlfind \
    -pkgs re.emacs,async_ssl,async_shell,uri.services,ipaddr.unix,cryptokit,base64 \
    src/test_ssl.native
*)

let request_ssl qs = Printf.sprintf "GET /search?utf8=%%E2%%9C%%93&q=%s HTTP/1.1
Host: github.com
Connection: close
Pragma: no-cache
Cache-Control: no-cache
Upgrade-Insecure-Requests: 1
User-Agent: Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/55.0.2883.87 Safari/537.36
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8
Accept-Language: en-US,en;q=0.8,it;q=0.6\n\n" qs

let rand_string n =
  let rand_string = String.make n '_' in
  for i = 0 to (n - 1) do
    rand_string.[i] <- Char.of_int_exn ((Random.int 25) + 97);
  done;
  rand_string

let http_first_line_regex = Re2.create_exn "^HTTP/1\\.1\\s+(\\d+)\\s+(.*)$"

let get_ssl () =
  (* Connect the socket *)
  Tcp.connect (Tcp.to_host_and_port "github.com" 443) >>= fun (socket, net_to_ssl, ssl_to_net) ->

  (* Connect SSL *)
  let net_to_ssl = Reader.pipe net_to_ssl in
  let ssl_to_net = Writer.pipe ssl_to_net in
  let app_to_ssl, app_wr = Pipe.create () in
  let app_rd, ssl_to_app = Pipe.create () in
  Ssl.client
    ~version:Async_ssl.Ssl.Version.Tlsv1_2
    ~app_to_ssl
    ~ssl_to_app
    ~net_to_ssl
    ~ssl_to_net () |> Deferred.Or_error.ok_exn >>= fun connection ->
  Reader.of_pipe (Info.of_string "ssl_reader") app_rd >>= fun app_rd ->
  Writer.of_pipe (Info.of_string "ssl_writer") app_wr >>= fun (app_wr,_) ->

  (* Send the request *)
  Writer.write app_wr (request_ssl (rand_string 16));
  Writer.flushed app_wr >>= fun () ->

  (* Read the response *)
  Reader.contents app_rd >>= fun response_str ->

  (* Parse response code *)
  let first_line = String.split_lines response_str |> List.hd_exn |> String.strip in
  let tokens = Re2.find_submatches_exn http_first_line_regex first_line in
  let code = Option.value_exn (tokens.(1)) |> Int.of_string in
  let message = Option.value_exn (tokens.(2)) in

  (* Close *)
  don't_wait_for (
    Writer.close app_wr >>= fun () ->
    Reader.close app_rd >>= fun () ->
    Async_ssl.Ssl.Connection.close connection |> return
  );

  return (code, message)

let gc_loop () =
  let rec loop () =
    info "Gc.compact ()";
    Gc.compact ();
    (after (sec 60.)) >>= loop in
  loop ()

let rec loop ?(i=1) ?(errors=0.0) () =
  info "Call number %06d" i;
  get_ssl () >>= fun (code, message) ->
  let errors = if code = 200 then 0.0 else errors +. 1.0 in
  info "Server replied: %d \"%s\"" code message;
  (after (sec (1.0 +. 0.25 *. errors))) >>= fun () ->
  loop ~i:(i+1) ~errors ()

let main () =
  loop ()     |> don't_wait_for;
  gc_loop ()  |> don't_wait_for;
  never_returns (Scheduler.go ())

let () = Command.(async ~summary:"SSL test" Spec.empty main |> run)