Created
February 8, 2017 11:20
-
-
Save pdonadeo/81f3483bbd615aeeecfdec93ab6025dc to your computer and use it in GitHub Desktop.
SSL Test (4)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment