package tiny_libs

  1. Overview
  2. Docs
From-scratch libraries for teaching: graphics, audio, compression, crypto, networking and more

Install 

dune-project
 Dependency

github.com Readme Edit opam file Versions (1)

Authors

  1. Y
    Yoann Padioleau <yoann.padioleau@gmail.com

Maintainers

  1. Y
    Yoann Padioleau <yoann.padioleau@gmail.com

Sources

0.3.6.tar.gz
md5=7c636383d146d30ac6f2fa234a6253c8
sha512=c79f3823c5f8f57e5038eb640d487c61168b84aa07c61999d6622ef9fd0c890e2b03b4c6a7cdbbe9352a49e25dda00ac7bb14693cee8e3d7beeed251351a2af0

doc/src/tiny_libs.networking_unix/Tls_tunnel.ml.html

Source file Tls_tunnel.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
(* Claude Code
 *
 * Copyright (C) 2026 Yoann Padioleau
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Library General Public License
 * (LGPL) as published by the Free Software Foundation; either version
 * 2 of the License, or (at your option) any later version.
 *)

(* See Tls_tunnel.mli *)

let program = "openssl"

let connect (caps : < Cap.exec ; .. >) ~(host : string) ~(port : int) : (Transport.t, string) result =
  let (_ : Cap.Exec.t) = caps#exec program in
  try
    let to_r, to_w = Unix.pipe ~cloexec:true () and from_r, from_w = Unix.pipe ~cloexec:true () in
    let devnull = Unix.openfile "/dev/null" [ Unix.O_WRONLY; Unix.O_CLOEXEC ] 0 in
    let address = Printf.sprintf "%s:%d" host port in
    let pid =
      Unix.create_process program
        [| program; "s_client"; "-quiet"; "-verify_return_error"; "-connect"; address; "-servername"; host |]
        to_r from_w devnull
    in
    List.iter Unix.close [ to_r; from_w; devnull ];
    Unix.set_nonblock from_r;
    (* writing to a tunnel that ended would kill us with SIGPIPE: an
       error instead (EPIPE), which ends the connection *)
    Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
    let pending = Buffer.create 4096 and closed = ref None in
    let finish why =
      if !closed = None then (
        closed := Some why;
        (try Unix.close to_w with Unix.Unix_error _ -> ());
        (try Unix.close from_r with Unix.Unix_error _ -> ());
        ignore (Unix.waitpid [ Unix.WNOHANG ] pid))
    in
    let send line =
      if !closed = None then
        let s = line ^ "\r\n" in
        try ignore (Unix.write_substring to_w s 0 (String.length s)) with Unix.Unix_error (e, _, _) -> finish (Unix.error_message e)
    in
    let receive () =
      let chunk = Bytes.create 65536 in
      let rec read () =
        if !closed = None then
          match Unix.read from_r chunk 0 (Bytes.length chunk) with
          | 0 -> finish "closed by the server"
          | n ->
              Buffer.add_subbytes pending chunk 0 n;
              read ()
          | exception Unix.Unix_error ((Unix.EAGAIN | Unix.EWOULDBLOCK), _, _) -> ()
          | exception Unix.Unix_error (e, _, _) -> finish (Unix.error_message e)
      in
      read ();
      (* the complete lines; a partial one waits for its end *)
      let all = Buffer.contents pending in
      match String.rindex_opt all '\n' with
      | None -> []
      | Some i ->
          Buffer.clear pending;
          Buffer.add_string pending (String.sub all (i + 1) (String.length all - i - 1));
          String.split_on_char '\n' (String.sub all 0 i)
          |> List.map (fun l -> if l <> "" && l.[String.length l - 1] = '\r' then String.sub l 0 (String.length l - 1) else l)
    in
    let status () = match !closed with None -> "over TLS to " ^ address ^ " (openssl)" | Some why -> address ^ ": " ^ why in
    Ok { Transport.send; receive; status; player = (fun () -> None) }
  with Unix.Unix_error (e, _, _) -> Error (Printf.sprintf "can't run %s: %s" program (Unix.error_message e))