Merge pull request #16 from hannesm/tls-nocrypto-master

Tls nocrypto master

.travis.yml

@@ -3,7 +3,7 @@ install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/ma
 script: bash -ex .travis-opam.sh
 sudo: required
 env:
- - PACKAGE="tlstunnel" OCAML_VERSION=4.01 POST_INSTALL_HOOK="./.travis-test.sh"
- - PACKAGE="tlstunnel" OCAML_VERSION=latest POST_INSTALL_HOOK="./.travis-test.sh"
+ - PACKAGE="tlstunnel" OCAML_VERSION=4.01 POST_INSTALL_HOOK="./.travis-test.sh" EXTRA_REMOTES=https://github.com/mirage/mirage-dev.git
+ - PACKAGE="tlstunnel" OCAML_VERSION=latest POST_INSTALL_HOOK="./.travis-test.sh" EXTRA_REMOTES=https://github.com/mirage/mirage-dev.git
 notifications:
  email: false

README.md

@@ -12,7 +12,7 @@ Who needs a stunnel if you have a tls tunnel?
 You first need [OCaml](https://ocaml.org) (at least 4.1.0) and
 [OPAM](https://opam.ocaml.org) (1.2.*) from your distribution.
 
-Then, run `opam pin add tlstunnel
+Then, run `opam repo add mirage-dev git://github.com/mirage/mirage-dev.git` and `opam pin add tlstunnel
 https://github.com/hannesm/tlstunnel`, which will install `tlstunnel`
 for you.
 

opam

@@ -13,8 +13,9 @@ build: [
 ]
 depends: [
  "ocamlfind" {build}
- "tls" {>= "0.4.0"}
+ "tls" {>= "0.5.0"}
  "x509" {>= "0.3.0"}
+ "nocrypto" {>= "0.4.0"}
  "lwt"
  "type_conv"
  "sexplib"

src/tlstunnel.ml

@@ -101,9 +101,8 @@ let rec read_write closing close cnt buf ic oc =
  Lwt_io.write oc s >>= fun () ->
  read_write closing close cnt buf ic oc
  else
- (closing := true ;
- close ()))
- (fun _ -> closing := true ; close ())
+ close ())
+ (fun _ -> close ())
 
 let tls_info t =
  let v, c =
@@ -116,16 +115,15 @@ let tls_info t =
  in
  version ^ ", " ^ cipher
 
-let safe_close closing tls fds () =
+let safe_close closing tls fd () =
  closing := true ;
- let safe_close fd =
- try_lwt (Lwt_unix.close fd)
- with _ -> return_unit
+ let safely f x =
+ try_lwt (f x) with _ -> return_unit
  in
  (match tls with
- | Some x -> Tls_lwt.Unix.close x
+ | Some x -> safely Tls_lwt.Unix.close x
  | None -> return_unit) >>= fun () ->
- Lwt.join (List.map safe_close fds)
+ safely Lwt_unix.close fd
 
 let worker config backend log s logfds () =
  let closing = ref false in
@@ -137,7 +135,7 @@ let worker config backend log s logfds () =
 
  let fd = socket PF_INET SOCK_STREAM 0 in
  if logfds then Fd_logger.add_fd fd ;
- let close = safe_close closing (Some t) [ s ; fd ] in
+ let close = safe_close closing (Some t) fd in
 
  catch (fun () ->
  connect fd backend >>= fun () ->
@@ -160,10 +158,10 @@ let worker config backend log s logfds () =
  log ("received inner exception " ^ Printexc.to_string exn)))
  (function
  | Tls_lwt.Tls_alert _ | Tls_lwt.Tls_failure _ as exn ->
- log ("failed to establish TLS connection: " ^ Printexc.to_string exn) ;
- (* Tls_lwt has already closed the underlying file descriptor *)
-  return_unit
- | exn -> safe_close closing None [s] () >|= fun () ->
+ safe_close closing None s () >|= fun () ->
+ log ("failed to establish TLS connection: " ^ Printexc.to_string exn)
+ | exn ->
+  safe_close closing None s () >|= fun () ->
  log ("received outer exception " ^ Printexc.to_string exn))
 
 let init out =
@@ -206,7 +204,7 @@ let serve (fip, fport) (bip, bport) certificate privkey logfd logfds =
  let frontend = ADDR_INET (fip, fport)
  and backend = ADDR_INET (bip, bport)
  in
- Tls_lwt.rng_init () >>= fun () ->
+ Nocrypto_entropy_lwt.initialize () >>= fun () ->
  server_config certificate privkey >>= fun tls_config ->
  let server_socket = init_socket (Log.log_initial logchan backend) frontend in
  let raw_log = Log.log_raw logchan in