client: support for password authentication fixes mirage#31

This changes the API of Client.make (now receives a variant
`Password of string | `Pubkey of key), and Awa_mirage.Make().client_of_flow as
well.

This does not support the keyboard-interactive authentication mechanism
(RFC 4256) that is commonly used (with e.g. PAM), but only the password
authentication. May be useful for feature parity between server and client, and
for some network devices.

lib/client.ml

@@ -74,8 +74,9 @@ type t = {
   sig_algs : Hostkey.alg list ;
   linger  : Cstruct.t;
   user : string ;
-  key : Hostkey.priv ;
+  auth_method : [ `Pubkey of Hostkey.priv | `Password of string ] ;
   authenticator : Keys.authenticator ;
+  auth_tried : bool ;
 }
 
 let established t = match t.state with Established -> true | _ -> false
@@ -116,7 +117,7 @@ let output_msgs t msgs =
   in
   t', List.rev data
 
-let make ?(authenticator = `No_authentication) ~user key =
+let make ?(authenticator = `No_authentication) ~user auth_method =
   let open Ssh in
   let hostkey_algs = match authenticator with
     | `No_authentication -> Hostkey.preferred_algs
@@ -136,7 +137,8 @@ let make ?(authenticator = `No_authentication) ~user key =
             linger = Cstruct.empty;
             channels = Channel.empty_db;
             sig_algs = [];
-            user ; key ; authenticator
+            user ; auth_method ; authenticator ;
+            auth_tried = false ;
           }
   in
   output_msgs t [ banner_msg ; kex_msg ]
@@ -169,7 +171,9 @@ let handle_kexinit t c_v ckex s_v skex =
         [] skex.server_host_key_algs
     in
     let s = List.filter (fun a -> List.mem a s) Hostkey.preferred_algs in
-    List.filter Hostkey.(alg_matches (priv_to_typ t.key)) s
+    match t.auth_method with
+    | `Pubkey key -> List.filter Hostkey.(alg_matches (priv_to_typ key)) s
+    | `Password _ -> s
   in
   Ok ({ t with state ; sig_algs }, [ msg ], [])
 
@@ -249,37 +253,51 @@ let service_accepted t = function
         [])
   | service -> Error ("unknown service: " ^ service)
 
-let handle_auth_failure t m = function
+let handle_auth_failure t _ = function
   | [] -> Error "no authentication method left"
   | xs ->
-    if List.mem "publickey" xs then
-      let pub = Hostkey.pub_of_priv t.key in
-      match m with
-      | Ssh.Pubkey (p, None) when Hostkey.pub_eq pub p ->
-        Error "permission denied (tried public key)"
-      | _ ->
-        let met = Ssh.Pubkey (pub, None) in
-        Ok ({ t with state = Userauth_request met },
-            [ Ssh.Msg_userauth_request (t.user, service, met) ],
-            [])
+    if t.auth_tried then
+      Error "authentication failure"
     else
-      Error "no supported authentication methods left"
+      let* met =
+        match t.auth_method with
+        | `Pubkey key ->
+          if List.mem "publickey" xs then
+            let pub = Hostkey.pub_of_priv key in
+            Ok (Ssh.Pubkey (pub, None))
+          else
+            Error "no supported authentication methods left"
+        | `Password pass ->
+          if List.mem "password" xs then
+            Ok (Ssh.Password (pass, None))
+          else
+            Error "no supported authentication methods left"
+      in
+      Ok ({ t with state = Userauth_request met ; auth_tried = true },
+          [ Ssh.Msg_userauth_request (t.user, service, met) ],
+          [])
 
-let handle_pk_auth t pk =
+let handle_pk_auth t pk key =
   let session_id = match t.session_id with None -> assert false | Some x -> x in
   let* alg, sig_algs =
     match t.sig_algs with
     | [] -> Error "no more signature algorithms available"
     | a :: rt -> Ok (a, rt)
   in
-  let signed = Auth.sign t.user alg t.key session_id service in
-  let met = Ssh.Pubkey (Hostkey.pub_of_priv t.key, Some (alg, signed)) in
+  let signed = Auth.sign t.user alg key session_id service in
+  let met = Ssh.Pubkey (Hostkey.pub_of_priv key, Some (alg, signed)) in
   Ok ({ t with state = Userauth_requested (Some pk) ; sig_algs },
       [ Ssh.Msg_userauth_request (t.user, service, met) ],
       [])
 
-let handle_pk_ok t m pk = match m with
-  | Ssh.Pubkey (pub, None) when pub = pk -> handle_pk_auth t pk
+let handle_pk_fail t pk =
+  (* called when the signature algorithm wasn't received well by the server *)
+  match t.auth_method with
+  | `Pubkey key -> handle_pk_auth t pk key
+  | _ -> Error "not sure how we ended in pk fail now"
+
+let handle_pk_ok t m pk = match t.auth_method, m with
+  | `Pubkey key, Ssh.Pubkey (pub, None) when pub = pk -> handle_pk_auth t pk key
   | _ -> Error "not sure how we ended in pk ok now"
 
 let open_channel t =
@@ -360,7 +378,7 @@ let input_msg t msg now =
   | Userauth_request m, Msg_userauth_failure (methods, _) ->
     handle_auth_failure t m methods
   | Userauth_request m, Msg_userauth_pk_ok pk -> handle_pk_ok t m pk
-  | Userauth_requested (Some pk), Msg_userauth_failure _ -> handle_pk_auth t pk
+  | Userauth_requested (Some pk), Msg_userauth_failure _ -> handle_pk_fail t pk
   | Userauth_request _, Msg_userauth_success -> open_channel t
   | Userauth_requested _, Msg_userauth_success -> open_channel t
   | Opening_channel us, Msg_channel_open_confirmation (oid, tid, win, max, data) ->

lib/client.mli

@@ -16,8 +16,8 @@
 
 type t
 
-val make : ?authenticator:Keys.authenticator -> user:string -> Hostkey.priv ->
-  t * Cstruct.t list
+val make : ?authenticator:Keys.authenticator -> user:string ->
+  [ `Pubkey of Hostkey.priv | `Password of string ] -> t * Cstruct.t list
 
 type event = [
   | `Established of int32

mirage/awa_mirage.ml

@@ -137,9 +137,9 @@ module Make (F : Mirage_flow.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) =
 
   let write t buf = writev t [buf]
 
-  let client_of_flow ?authenticator ~user key req flow =
+  let client_of_flow ?authenticator ~user auth req flow =
     let open Lwt_result.Infix in
-    let client, msgs = Awa.Client.make ?authenticator ~user key in
+    let client, msgs = Awa.Client.make ?authenticator ~user auth in
     let t = {
       flow   = flow ;
       state  = `Active client ;

mirage/awa_mirage.mli

@@ -23,8 +23,8 @@ module Make (F : Mirage_flow.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) :
       existing connection to SSH, mutually authenticates, opens a channel and
       sends the channel request. *)
   val client_of_flow : ?authenticator:Awa.Keys.authenticator -> user:string ->
-    Awa.Hostkey.priv -> Awa.Ssh.channel_request -> FLOW.flow ->
-    (flow, error) result Lwt.t
+    [ `Pubkey of Awa.Hostkey.priv | `Password of string ] ->
+    Awa.Ssh.channel_request -> FLOW.flow -> (flow, error) result Lwt.t
 
  type t
 

test/awa_test_client.ml

@@ -37,28 +37,36 @@ let write_cstruct fd buf =
   let n = Unix.write fd bytes 0 len in
   assert (n > 0)
 
-let jump _ user seed typ keyfile authenticator host port =
+let jump _ user pass seed typ keyfile authenticator host port =
   let ( let* ) = Result.bind in
   Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna);
   let fd = Unix.(socket PF_INET SOCK_STREAM 0) in
   Unix.(connect fd (ADDR_INET (inet_addr_of_string host, port)));
   match
-    let* key =
-      match keyfile with
-      | None -> Ok (Keys.of_seed typ seed)
-      | Some f ->
-        let fd = Unix.(openfile f [O_RDONLY] 0) in
-        let file_buf = Unix_cstruct.of_fd fd in
-        let r = match Wire.privkey_of_openssh file_buf, Wire.privkey_of_pem file_buf with
-          | Ok (k, _), _ -> Ok k
-          | _, Ok k -> Ok k
-          | Error m, _ -> Error m
+    let* auth = match pass with
+      | None ->
+        let* key =
+          match keyfile with
+          | None -> Ok (Keys.of_seed typ seed)
+          | Some f ->
+            let fd = Unix.(openfile f [O_RDONLY] 0) in
+            let file_buf = Unix_cstruct.of_fd fd in
+            let r = match Wire.privkey_of_openssh file_buf, Wire.privkey_of_pem file_buf with
+              | Ok (k, _), _ -> Ok k
+              | _, Ok k -> Ok k
+              | Error m, _ -> Error m
+            in
+            Unix.close fd;
+            r
         in
-        Unix.close fd;
-        r
+        Logs.info (fun m -> m "using publickey authentication");
+        Ok (`Pubkey key)
+      | Some pass ->
+        Logs.info (fun m -> m "using password authentication");
+        Ok (`Password pass)
     in
     let* authenticator = Keys.authenticator_of_string authenticator in
-    let t, out = Client.make ~authenticator ~user key in
+    let t, out = Client.make ~authenticator ~user auth in
     List.iter (write_cstruct fd) out;
     let rec read_react t =
       let data = read_cstruct fd in
@@ -99,6 +107,10 @@ let user =
   let doc = "username to use" in
   Arg.(value & opt string "hannes" & info [ "user" ] ~doc)
 
+let pass =
+  let doc = "password" in
+  Arg.(value & opt (some string) None & info [ "password" ] ~doc)
+
 let seed =
   let doc = "private key seed" in
   Arg.(value & opt string "180586" & info [ "seed" ] ~doc)
@@ -130,7 +142,7 @@ let setup_log =
 
 let cmd =
   let term =
-    Term.(term_result (const jump $ setup_log $ user $ seed $ keytype $ keyfile $ authenticator $ host $ port))
+    Term.(term_result (const jump $ setup_log $ user $ pass $ seed $ keytype $ keyfile $ authenticator $ host $ port))
   and info =
     Cmd.info "awa_test_client" ~version:"%%VERSION_NUM"
   in