Merge pull request #51 from hannesm/client-password-auth

client: support for password authentication fixes #31

lib/client.ml

@@ -43,13 +43,24 @@ let pp_event ppf = function
 type kex_state =
   | Negotiated_kex of string * Ssh.kexinit * string * Ssh.kexinit * Kex.negotiation * Mirage_crypto_pk.Dh.secret * Ssh.mpint
 
+type ec_secret = [
+  | `Ed25519 of Mirage_crypto_ec.X25519.secret
+  | `P256 of Mirage_crypto_ec.P256.Dh.secret
+  | `P384 of Mirage_crypto_ec.P384.Dh.secret
+  | `P521 of Mirage_crypto_ec.P521.Dh.secret
+]
+
 type eckex_state =
-  | Negotiated_eckex of string * Ssh.kexinit * string * Ssh.kexinit * Kex.negotiation * Mirage_crypto_ec.X25519.secret * Ssh.mpint
+  | Negotiated_eckex of string * Ssh.kexinit * string * Ssh.kexinit * Kex.negotiation * ec_secret * Ssh.mpint
 
 type gex_state =
   | Requested_gex of string * Ssh.kexinit * string * Ssh.kexinit * Kex.negotiation * int32 * int32 * int32
   | Negotiated_gex of string * Ssh.kexinit * string * Ssh.kexinit * Kex.negotiation * int32 * int32 * int32 * Z.t * Z.t * Mirage_crypto_pk.Dh.secret * Ssh.mpint
 
+type userauth_interactive =
+  | Requested of string
+  | Info_sent
+
 type state =
   | Init of string * Ssh.kexinit
   | Received_version of string * Ssh.kexinit * string
@@ -58,8 +69,10 @@ type state =
   | Gex of gex_state
   | Newkeys_before_auth of Kex.keys * Kex.keys
   | Requested_service of string
-  | Userauth_request of Ssh.auth_method
-  | Userauth_requested of Hostkey.pub option
+  | Userauth_initial
+  | Userauth_password
+  | Userauth_publickey of Hostkey.priv
+  | Userauth_keyboard_interactive of userauth_interactive
   | Opening_channel of Channel.channel_end
   | Established
 
@@ -74,8 +87,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 +130,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 +150,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 ]
@@ -153,8 +168,8 @@ let handle_kexinit t c_v ckex s_v skex =
       let secret, my_pub = Kex.Dh.secret_pub neg.kex_alg in
       Kex (Negotiated_kex (c_v, ckex, s_v, skex, neg, secret, my_pub)),
       Ssh.Msg_kexdh_init my_pub
-    else (* not RFC 4419, not finite field -> ECDH *)
-      let secret, my_pub = Kex.Dh.ecdh_secret_pub neg.kex_alg in
+    else (* not RFC 4419, not finite field -> EC *)
+      let secret, my_pub = Kex.Dh.ec_secret_pub neg.kex_alg in
       Eckex (Negotiated_eckex (c_v, ckex, s_v, skex, neg, secret, my_pub)),
       Ssh.Msg_kexecdh_init my_pub
   in
@@ -169,7 +184,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 ], [])
 
@@ -197,7 +214,7 @@ let handle_kexdh_reply t now v_c ckex v_s skex neg secret my_pub k_s theirs p =
   dh_reply ~ec:false t now v_c ckex v_s skex neg shared my_pub k_s theirs p
 
 let handle_kexecdh_reply t now v_c ckex v_s skex neg secret my_pub k_s theirs p =
-  let* shared = Kex.Dh.ecdh_shared secret theirs in
+  let* shared = Kex.Dh.ec_shared secret theirs in
   dh_reply ~ec:true t now v_c ckex v_s skex neg shared my_pub k_s theirs p
 
 let handle_kexdh_gex_group t v_c ckex v_s skex neg min n max p gg =
@@ -244,43 +261,62 @@ let handle_newkeys_before_auth t keys =
 
 let service_accepted t = function
   | "ssh-userauth" ->
-    Ok ({ t with state = Userauth_request Authnone },
+    Ok ({ t with state = Userauth_initial },
         [ Ssh.Msg_userauth_request (t.user, service, Authnone) ],
         [])
   | service -> Error ("unknown service: " ^ service)
 
-let handle_auth_failure t m = function
+let handle_auth_none 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 handle_pk_auth t pk =
+      let auth_req met = [ Ssh.Msg_userauth_request (t.user, service, met) ] in
+      match t.auth_method with
+      | `Pubkey key ->
+        if List.mem "publickey" xs then
+          let pub = Hostkey.pub_of_priv key in
+          let met = Ssh.Pubkey (pub, None) in
+          Ok ({ t with state = Userauth_publickey key ; auth_tried = true },
+              auth_req met, [])
+        else
+          Error "no supported authentication methods left"
+      | `Password pass ->
+        if List.mem "password" xs then
+          let met = Ssh.Password (pass, None) in
+          Ok ({ t with state = Userauth_password ; auth_tried = true },
+              auth_req met, [])
+        else if List.mem "keyboard-interactive" xs then
+          let met = Ssh.Keyboard_interactive (None, []) in
+          let state = Userauth_keyboard_interactive (Requested pass) in
+          Ok ({ t with state ; auth_tried = true }, auth_req met, [])
+        else
+          Error "no supported authentication methods left"
+
+let handle_pk_auth t 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
-  Ok ({ t with state = Userauth_requested (Some pk) ; sig_algs },
+  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_publickey key ; 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
-  | _ -> Error "not sure how we ended in pk ok now"
+let handle_userauth_info_req t password (name, instruction, lang, prompts) =
+  Log.info (fun m -> m "keyboard interactive: name %s instruction %s lang %s"
+               name instruction lang);
+  List.iter (fun (prompt, _echo) -> Log.info (fun m -> m "PROMPT: %s" prompt))
+    prompts;
+  match prompts with
+  | [ _ ] ->
+    Ok ({ t with state = Userauth_keyboard_interactive Info_sent },
+        [ Ssh.Msg_userauth_info_response [ password ] ], [])
+  | _ -> Error "keyboard interactive user authentication: not a single prompt"
 
 let open_channel t =
   if Channel.is_empty t.channels then
@@ -357,12 +393,47 @@ let input_msg t msg now =
     handle_newkeys_before_auth t keys
   | Requested_service s, Msg_service_accept s' when s = s' ->
     service_accepted t s
-  | 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_request _, Msg_userauth_success -> open_channel t
-  | Userauth_requested _, Msg_userauth_success -> open_channel t
+  | Userauth_initial, Msg_userauth_failure (methods, _) ->
+    handle_auth_none t methods
+  | Userauth_publickey key, Msg_userauth_failure _ ->
+    (* signature algorithm wasn't received well by the server *)
+    handle_pk_auth t key
+  | Userauth_publickey key, Msg_userauth_1 buf ->
+    begin
+      let* m = Wire.userauth_pk_ok buf in
+      match m with
+      | Msg_userauth_pk_ok pub ->
+        if Hostkey.pub_of_priv key = pub then
+          handle_pk_auth t key
+        else
+          Error "key user authentication: public key does not match private"
+      | _ -> Error "unexpected userauth message"
+    end
+  | Userauth_keyboard_interactive (Requested password), Msg_userauth_1 buf ->
+    begin
+      let* m = Wire.userauth_info_request buf in
+      match m with
+      | Msg_userauth_info_request (n, i, l, p) ->
+        handle_userauth_info_req t password (n, i, l, p)
+      | _ -> Error "unexpected userauth message"
+    end
+  | Userauth_keyboard_interactive Info_sent, Msg_userauth_1 buf ->
+    begin
+      (* in contrast to 4256, OpenSSH sends another Info_req with no prompts *)
+      let* m = Wire.userauth_info_request buf in
+      match m with
+      | Msg_userauth_info_request (_, _, _, []) ->
+        Ok (t, [ Ssh.Msg_userauth_info_response [] ], [])
+      | _ -> Error "unexpected userauth message"
+    end
+  | (Userauth_password | Userauth_publickey _ | Userauth_keyboard_interactive _), Msg_userauth_success ->
+    open_channel t
+  | (Userauth_password | Userauth_publickey _ | Userauth_keyboard_interactive _), Msg_userauth_banner (banner, lang) ->
+    Log.info (fun m -> m "userauth banner %s%s" banner
+                 (if lang = "" then "" else " (lang " ^ lang ^ ")"));
+    Ok (t, [], [])
+  | (Userauth_password | Userauth_keyboard_interactive _), Msg_userauth_failure _ ->
+    Error "user authentication failed"
   | Opening_channel us, Msg_channel_open_confirmation (oid, tid, win, max, data) ->
     open_channel_success t us oid tid win max data
   | _, Msg_global_request (_, want_reply, Unknown_request _) ->

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

lib/kex.ml

@@ -34,22 +34,31 @@ type alg =
   | Diffie_hellman_group1_sha1
   | Diffie_hellman_group_exchange_sha1
   | Curve25519_sha256
+  | Ecdh_sha2_nistp256
+  | Ecdh_sha2_nistp384
+  | Ecdh_sha2_nistp521
 
 let is_rfc4419 = function
   | Diffie_hellman_group_exchange_sha256
   | Diffie_hellman_group_exchange_sha1 -> true
   | Diffie_hellman_group14_sha256
   | Diffie_hellman_group14_sha1
   | Diffie_hellman_group1_sha1
-  | Curve25519_sha256 -> false
+  | Curve25519_sha256
+  | Ecdh_sha2_nistp256
+  | Ecdh_sha2_nistp384
+  | Ecdh_sha2_nistp521 -> false
 
 let is_finite_field = function
   | Diffie_hellman_group_exchange_sha256
   | Diffie_hellman_group_exchange_sha1
   | Diffie_hellman_group14_sha256
   | Diffie_hellman_group14_sha1
   | Diffie_hellman_group1_sha1 -> true
-  | Curve25519_sha256 -> false
+  | Curve25519_sha256
+  | Ecdh_sha2_nistp256
+  | Ecdh_sha2_nistp384
+  | Ecdh_sha2_nistp521 -> false
 
 let alg_of_string = function
   | "diffie-hellman-group-exchange-sha256" -> Ok Diffie_hellman_group_exchange_sha256
@@ -58,6 +67,9 @@ let alg_of_string = function
   | "diffie-hellman-group14-sha1" -> Ok Diffie_hellman_group14_sha1
   | "diffie-hellman-group1-sha1" -> Ok Diffie_hellman_group1_sha1
   | "curve25519-sha256" -> Ok Curve25519_sha256
+  | "ecdh-sha2-nistp256" -> Ok Ecdh_sha2_nistp256
+  | "ecdh-sha2-nistp384" -> Ok Ecdh_sha2_nistp384
+  | "ecdh-sha2-nistp521" -> Ok Ecdh_sha2_nistp521
   | s -> Error ("Unknown kex_alg " ^ s)
 
 let alg_to_string = function
@@ -67,14 +79,20 @@ let alg_to_string = function
   | Diffie_hellman_group14_sha1 -> "diffie-hellman-group14-sha1"
   | Diffie_hellman_group1_sha1  -> "diffie-hellman-group1-sha1"
   | Curve25519_sha256 -> "curve25519-sha256"
+  | Ecdh_sha2_nistp256 -> "ecdh-sha2-nistp256"
+  | Ecdh_sha2_nistp384 -> "ecdh-sha2-nistp384"
+  | Ecdh_sha2_nistp521 -> "ecdh-sha2-nistp521"
 
 let group_of_alg = function
   | Diffie_hellman_group14_sha256 -> Mirage_crypto_pk.Dh.Group.oakley_14
   | Diffie_hellman_group14_sha1 -> Mirage_crypto_pk.Dh.Group.oakley_14
   | Diffie_hellman_group1_sha1  -> Mirage_crypto_pk.Dh.Group.oakley_2
   | Diffie_hellman_group_exchange_sha1
   | Diffie_hellman_group_exchange_sha256
-  | Curve25519_sha256 -> assert false
+  | Curve25519_sha256
+  | Ecdh_sha2_nistp256
+  | Ecdh_sha2_nistp384
+  | Ecdh_sha2_nistp521 -> assert false
 
 let hash_of_alg = function
   | Diffie_hellman_group_exchange_sha256
@@ -83,9 +101,13 @@ let hash_of_alg = function
   | Diffie_hellman_group_exchange_sha1
   | Diffie_hellman_group14_sha1
   | Diffie_hellman_group1_sha1 -> Mirage_crypto.Hash.module_of `SHA1
+  | Ecdh_sha2_nistp256 -> Mirage_crypto.Hash.module_of `SHA256
+  | Ecdh_sha2_nistp384 -> Mirage_crypto.Hash.module_of `SHA384
+  | Ecdh_sha2_nistp521 -> Mirage_crypto.Hash.module_of `SHA512
 
 let client_supported =
   [ Curve25519_sha256 ;
+    Ecdh_sha2_nistp256 ; Ecdh_sha2_nistp384 ; Ecdh_sha2_nistp521 ;
     Diffie_hellman_group14_sha256 ; Diffie_hellman_group_exchange_sha256 ;
     Diffie_hellman_group14_sha1 ; Diffie_hellman_group1_sha1 ;
     Diffie_hellman_group_exchange_sha1 ]
@@ -387,18 +409,31 @@ module Dh = struct
     in
     Ok (Mirage_crypto_pk.Z_extra.of_cstruct_be shared)
 
-  let ecdh_secret_pub = function
+  let ec_secret_pub = function
     | Curve25519_sha256 ->
       let secret, pub = Mirage_crypto_ec.X25519.gen_key () in
-      secret, Mirage_crypto_pk.Z_extra.of_cstruct_be pub
+      `Ed25519 secret, Mirage_crypto_pk.Z_extra.of_cstruct_be pub
+    | Ecdh_sha2_nistp256 ->
+      let secret, pub = Mirage_crypto_ec.P256.Dh.gen_key () in
+      `P256 secret, Mirage_crypto_pk.Z_extra.of_cstruct_be pub
+    | Ecdh_sha2_nistp384 ->
+      let secret, pub = Mirage_crypto_ec.P384.Dh.gen_key () in
+      `P384 secret, Mirage_crypto_pk.Z_extra.of_cstruct_be pub
+    | Ecdh_sha2_nistp521 ->
+      let secret, pub = Mirage_crypto_ec.P521.Dh.gen_key () in
+      `P521 secret, Mirage_crypto_pk.Z_extra.of_cstruct_be pub
     | _ -> assert false
 
-  let ecdh_shared secret recv =
+  let ec_shared secret recv =
     let r = Mirage_crypto_pk.Z_extra.to_cstruct_be recv in
     let* shared =
       Result.map_error
         (Fmt.to_to_string Mirage_crypto_ec.pp_error)
-        (Mirage_crypto_ec.X25519.key_exchange secret r)
+        (match secret with
+         | `Ed25519 secret -> Mirage_crypto_ec.X25519.key_exchange secret r
+         | `P256 secret -> Mirage_crypto_ec.P256.Dh.key_exchange secret r
+         | `P384 secret -> Mirage_crypto_ec.P384.Dh.key_exchange secret r
+         | `P521 secret -> Mirage_crypto_ec.P521.Dh.key_exchange secret r)
     in
     Ok (Mirage_crypto_pk.Z_extra.of_cstruct_be shared)
 

lib/server.ml

@@ -179,8 +179,8 @@ let rec input_userauth_request t username service auth_method =
       try_auth t (by_pubkey username alg pubkey session_id service signed t.user_db)
     | Password (password, None) ->    (* Password authentication *)
       try_auth t (by_password username password t.user_db)
-    (* Change of password, or Hostbased or Authnone won't be supported *)
-    | Password (_, Some _) | Hostbased _ | Authnone -> failure t
+    (* Change of password, or keyboard_interactive, or Authnone won't be supported *)
+    | Password (_, Some _) | Keyboard_interactive _ | Authnone -> failure t
   in
   (* See if we can actually authenticate *)
   match t.auth_state with