.

bin/adduser.ml

@@ -16,11 +16,10 @@ let ssh_edn, ssh_protocol = Mimic.register ~name:"ssh" (module SSH)
 let unix_ctx_with_ssh () =
   Git_unix.ctx (Happy_eyeballs_lwt.create ()) >|= fun ctx ->
   let open Mimic in
-  let k0 scheme user path host port capabilities =
+  let k0 scheme user path host port mode =
     match scheme, Unix.gethostbyname host with
     | `SSH, {Unix.h_addr_list; _} when Array.length h_addr_list > 0 ->
-      Lwt.return_some
-        {SSH.user; path; host= h_addr_list.(0); port; capabilities}
+      Lwt.return_some {SSH.user; path; host= h_addr_list.(0); port; mode}
     | _ -> Lwt.return_none in
   ctx
   |> Mimic.fold Smart_git.git_transmission

bin/dune

@@ -19,8 +19,8 @@
  (public_name ptt.adduser)
  (package ptt-bin)
  (modules adduser sSH)
- (libraries logs.cli fmt.tty fmt.cli ca-certs mirage-flow git-unix git-kv
-   mirage-clock-unix ptt.value cmdliner))
+ (libraries logs.cli logs.fmt fmt.tty fmt.cli ca-certs mirage-flow git-unix
+   git-kv mirage-clock-unix ptt.value cmdliner))
 
 (executable
  (name spf)

bin/sSH.ml

@@ -17,16 +17,16 @@ type endpoint = {
   ; path: string
   ; host: Unix.inet_addr
   ; port: int
-  ; capabilities: [ `Wr | `Rd ]
+  ; mode: [ `Rd | `Wr ]
 }
 
 let pp_inet_addr ppf inet_addr =
   Fmt.string ppf (Unix.string_of_inet_addr inet_addr)
 
-let connect {user; path; host; port; capabilities} =
+let connect {user; path; host; port; mode} =
   let edn = Fmt.str "%s@%a" user pp_inet_addr host in
   let cmd =
-    match capabilities with
+    match mode with
     | `Rd -> Fmt.str {sh|git-upload-pack '%s'|sh} path
     | `Wr -> Fmt.str {sh|git-receive-pack '%s'|sh} path in
   let cmd = Fmt.str "ssh -p %d %s %a" port edn Fmt.(quote string) cmd in
@@ -58,3 +58,8 @@ let writev t css =
   go t css
 
 let close t = close_in t.ic; close_out t.oc; Lwt.return_unit
+
+let shutdown t = function
+  | `read -> close_in t.ic; Lwt.return_unit
+  | `write -> close_out t.oc; Lwt.return_unit
+  | `read_write -> close t

bin/spf.ml

@@ -61,7 +61,7 @@ let ns_update (ipaddr, port) ~dns_key stack ~domain spf =
       |> R.reword_error (R.msgf "%a" Dns_tsig.pp_s)
       |> Lwt.return
       >>? fun (data, mac) ->
-        DNS.send_tcp flow data
+        DNS.send_tcp flow (Cstruct.of_string data)
         >|= R.reword_error (fun _ ->
                 R.msgf "Impossible to send a DNS packet to %a:%d" Ipaddr.pp
                   ipaddr port)
@@ -72,7 +72,7 @@ let ns_update (ipaddr, port) ~dns_key stack ~domain spf =
                   ipaddr port)
         >>? fun data ->
         Dns_tsig.decode_and_verify (Ptime_clock.now ()) dns_key key_name ~mac
-          data
+          (Cstruct.to_string data)
         |> R.reword_error (R.msgf "%a" Dns_tsig.pp_e)
         |> Lwt.return
         >>? fun (packet', _tsig, _mac) ->