SSL Test (4)

test_ssl4.ml

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

open Re2.Std


(* ocamlbuild -use-ocamlfind -cflag -thread -lflag -thread -pkgs re2,async_ssl test_ssl4.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.with_connection
    (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 ->
      info "Ssl.client";
      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;
        info "Ssl.connection.close";
        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 ()) *)
  Deferred.never ()

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