71 lines
2.4 KiB
OCaml
71 lines
2.4 KiB
OCaml
|
open Lwt
|
||
|
|
open Ex_common
|
||
|
|
|
||
|
|
let hostname = "mirage.io"
|
||
|
|
|
||
|
|
let proxy = "127.0.0.1", 3129
|
||
|
|
|
||
|
|
(* To test TLS-over-TLS, the `squid` proxy can be installed locally and configured to support HTTPS:
|
||
|
|
|
||
|
|
- Generate a certificate for localhost: https://gist.github.com/cecilemuller/9492b848eb8fe46d462abeb26656c4f8
|
||
|
|
|
||
|
|
$ openssl req -x509 -nodes -new -sha256 -days 1024 -newkey rsa:2048 -keyout RootCA.key -out RootCA.pem -subj "/C=US/CN=Example-Root-CA"
|
||
|
|
$ openssl x509 -outform pem -in RootCA.pem -out RootCA.crt
|
||
|
|
$ cat <<EOF > domains.ext
|
||
|
|
authorityKeyIdentifier=keyid,issuer
|
||
|
|
basicConstraints=CA:FALSE
|
||
|
|
keyUsage = digitalSignature, nonRepudiation, keyEncipherment, dataEncipherment
|
||
|
|
subjectAltName = @alt_names
|
||
|
|
[alt_names]
|
||
|
|
DNS.1 = localhost
|
||
|
|
EOF
|
||
|
|
$ openssl req -new -nodes -newkey rsa:2048 -keyout localhost.key -out localhost.csr -subj "/C=US/ST=YourState/L=YourCity/O=Example-Certificates/CN=localhost.local"
|
||
|
|
$ openssl x509 -req -sha256 -days 1024 -in localhost.csr -CA RootCA.pem -CAkey RootCA.key -CAcreateserial -extfile domains.ext -out localhost.crt
|
||
|
|
|
||
|
|
- Configure squid by adding HTTPS support on port 3129 in /etc/squid/squid.conf :
|
||
|
|
|
||
|
|
https_port 3129 tls-cert=/path/to/localhost.crt tls-key=/path/to/localhost.key
|
||
|
|
|
||
|
|
*)
|
||
|
|
|
||
|
|
let client = get_ok (Tls.Config.client ~authenticator:null_auth ())
|
||
|
|
|
||
|
|
let string_prefix ~prefix msg =
|
||
|
|
let len = String.length prefix in
|
||
|
|
String.length msg >= len && String.sub msg 0 len = prefix
|
||
|
|
|
||
|
|
let host = Result.get_ok (Domain_name.of_string hostname)
|
||
|
|
let host = Result.get_ok (Domain_name.host host)
|
||
|
|
|
||
|
|
let test_client _ =
|
||
|
|
(* Connect to proxy *)
|
||
|
|
Tls_lwt.Unix.connect client proxy >>= fun t ->
|
||
|
|
let (ic, oc) = Tls_lwt.of_t t in
|
||
|
|
|
||
|
|
(* Request proxy to connect to hostname *)
|
||
|
|
let req =
|
||
|
|
Printf.sprintf "CONNECT %s:443 HTTP/1.1\r\nHost: %s\r\n\r\n"
|
||
|
|
hostname hostname
|
||
|
|
in
|
||
|
|
Lwt_io.write oc req >>= fun () ->
|
||
|
|
Lwt_io.read ic ~count:1024 >>= fun msg ->
|
||
|
|
assert (string_prefix ~prefix:"HTTP/1.1 200 " msg) ;
|
||
|
|
|
||
|
|
(* TLS with hostname, over the TLS connection with the proxy *)
|
||
|
|
Tls_lwt.Unix.client_of_channels client ~host (ic, oc) >>= fun t ->
|
||
|
|
let (ic, oc) = Tls_lwt.of_t t in
|
||
|
|
|
||
|
|
(* Request homepage from host *)
|
||
|
|
let req =
|
||
|
|
Printf.sprintf "GET / HTTP/1.1\r\nHost: %s\r\nConnection: close\r\n\r\n"
|
||
|
|
hostname
|
||
|
|
in
|
||
|
|
|
||
|
|
Lwt_io.(write oc req >>= fun () ->
|
||
|
|
read ~count:1024 ic >>= print >>= fun () ->
|
||
|
|
read ~count:1024 ic >>= print >>= fun () ->
|
||
|
|
close oc >>= fun () ->
|
||
|
|
printf "++ done.\n%!")
|
||
|
|
|
||
|
|
let () = Lwt_main.run (test_client ())
|