Repository: mirage/awa-ssh
Pull request #66 (2023-06-14 10:16:03)

Revert "server: support GEX (RFC 4419) and ECDH key exchanges"
Reverts mirage/awa-ssh#63


Patch:
diff --git a/lib/client.ml b/lib/client.ml
index 2fb1901..5b25c01 100644
--- a/lib/client.ml
+++ b/lib/client.ml
@@ -138,7 +138,7 @@ let make ?(authenticator = `No_authentication) ~user auth_method =
     | `Key Hostkey.Ed25519_pub _ -> Hostkey.algs_of_typ `Ed25519
     | `Fingerprint (typ, _) -> Hostkey.algs_of_typ typ
   in
-  let client_kexinit = Kex.make_kexinit hostkey_algs Kex.supported () in
+  let client_kexinit = Kex.make_kexinit hostkey_algs Kex.client_supported () in
   let banner_msg = Ssh.Msg_version version_banner in
   let kex_msg = Ssh.Msg_kexinit client_kexinit in
   let t = { state = Init (version_banner, client_kexinit);
diff --git a/lib/kex.ml b/lib/kex.ml
index e1226e9..9d51837 100644
--- a/lib/kex.ml
+++ b/lib/kex.ml
@@ -105,13 +105,17 @@ let hash_of_alg = function
   | Ecdh_sha2_nistp384 -> Mirage_crypto.Hash.module_of `SHA384
   | Ecdh_sha2_nistp521 -> Mirage_crypto.Hash.module_of `SHA512
 
-let supported =
+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 ]
 
+let server_supported =
+  [ Diffie_hellman_group14_sha256 ; Diffie_hellman_group14_sha1 ;
+    Diffie_hellman_group1_sha1 ]
+
 let make_kexinit ?ext_info host_key_algs algs () =
   let k =
     { cookie = Mirage_crypto_rng.generate 16;
diff --git a/lib/server.ml b/lib/server.ml
index b0b777d..b8e130a 100644
--- a/lib/server.ml
+++ b/lib/server.ml
@@ -14,9 +14,6 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-let src = Logs.Src.create "awa.server" ~doc:"AWA server"
-module Log = (val Logs.src_log src : Logs.LOG)
-
 open Util
 
 type event =
@@ -50,7 +47,6 @@ type t = {
   user_db        : Auth.db;               (* username database *)
   channels       : Channel.db;            (* Ssh channels *)
   ignore_next_packet : bool;              (* Ignore the next packet from the wire *)
-  dh_group       : (Mirage_crypto_pk.Dh.group * int32 * int32 * int32) option; (* used for GEX (RFC 4419) *)
 }
 
 let guard_msg t msg =
@@ -71,7 +67,7 @@ let make host_key user_db =
   let open Ssh in
   let server_kexinit =
     let algs = host_key_algs host_key in
-    Kex.make_kexinit algs Kex.supported ()
+    Kex.make_kexinit algs Kex.server_supported ()
   in
   let banner_msg = Ssh.Msg_version version_banner in
   let kex_msg = Ssh.Msg_kexinit server_kexinit in
@@ -93,9 +89,7 @@ let make host_key user_db =
     auth_state = Auth.Preauth;
     user_db;
     channels = Channel.empty_db;
-    ignore_next_packet = false;
-    dh_group = None;
-  },
+    ignore_next_packet = false },
   [ banner_msg; kex_msg ]
 
 (* t with updated keys from new_keys_ctos *)
@@ -119,7 +113,7 @@ let rekey t =
   | false, true ->              (* can't be keying and must be keyed *)
     let server_kexinit =
       let algs = host_key_algs t.host_key in
-      Kex.make_kexinit algs Kex.supported ()
+      Kex.make_kexinit algs Kex.server_supported ()
     in
     let t = { t with server_kexinit; keying = true } in
     Some (t, Ssh.Msg_kexinit server_kexinit)
@@ -305,12 +299,9 @@ let input_msg t msg now =
       kex.first_kex_packet_follows &&
       not (Kex.guessed_right ~s:t.server_kexinit ~c:kex)
     in
-    let expect =
-      Some (if Kex.is_rfc4419 neg.kex_alg then MSG_KEX_4 else MSG_KEX_0)
-    in
     let t = { t with client_kexinit = Some kex;
                      neg_kex = Some neg;
-                     expect;
+                     expect = Some MSG_KEX_0; (* TODO needs fix *)
                      ignore_next_packet;
                      ext_info = kex.ext_info = Some `Ext_info_c; }
     in
@@ -318,126 +309,53 @@ let input_msg t msg now =
      | None -> make_noreply t   (* either already rekeying or not keyed *)
      | Some (t, kexinit) -> make_reply t kexinit)
   | Msg_kex (id, data) ->
-    let exts =
-      if t.ext_info then
-        let algs =
-          String.concat ","
-            (List.map Hostkey.alg_to_string (host_key_algs t.host_key));
+    begin
+      let* m = Wire.dh_kexdh_of_kex id data in
+      match m with
+      | Msg_kexdh_init e ->
+        let* neg = guard_some t.neg_kex "No negotiated kex" in
+        let* client_version = guard_some t.client_version "No client version" in
+        let* () = guard_none t.new_keys_stoc "Already got new_keys_stoc" in
+        let* () = guard_none t.new_keys_ctos "Already got new_keys_ctos" in
+        let* c = guard_some t.client_kexinit "No client kex" in
+        let* f, k = Kex.(Dh.generate neg.kex_alg e) in
+        let pub_host_key = Hostkey.pub_of_priv t.host_key in
+        let h = Kex.Dh.compute_hash ~signed:true neg
+            ~v_c:client_version
+            ~v_s:t.server_version
+            ~i_c:c.rawkex
+            ~i_s:(Wire.blob_of_kexinit t.server_kexinit)
+            ~k_s:pub_host_key
+            ~e ~f ~k
         in
-        let extensions =
-          [Extension { name = "server-sig-algs"; value = algs; }]
+        let signature = Hostkey.sign neg.server_host_key_alg t.host_key h in
+        Format.printf "shared is %a signature is %a (hash %a)\n%!"
+          Cstruct.hexdump_pp (Mirage_crypto_pk.Z_extra.to_cstruct_be f)
+          Cstruct.hexdump_pp signature Cstruct.hexdump_pp h;
+        let session_id = match t.session_id with None -> h | Some x -> x in
+        let* new_keys_ctos, new_keys_stoc, key_eol =
+          Kex.Dh.derive_keys k h session_id neg now
         in
-        [ Msg_ext_info extensions ]
-      else []
-    in
-    let sign_rekey t neg ~h ~f ~k =
-      let signature = Hostkey.sign neg.Kex.server_host_key_alg t.host_key h in
-      Log.debug (fun m -> m "shared is %a signature is %a (hash %a)"
-                    Cstruct.hexdump_pp (Mirage_crypto_pk.Z_extra.to_cstruct_be f)
-                    Cstruct.hexdump_pp signature Cstruct.hexdump_pp h);
-      let session_id = match t.session_id with None -> h | Some x -> x in
-      let* new_keys_ctos, new_keys_stoc, key_eol =
-        Kex.Dh.derive_keys k h session_id neg now
-      in
-      let signature = neg.server_host_key_alg, signature in
-      Ok ({ t with session_id = Some session_id;
-                   new_keys_ctos = Some new_keys_ctos;
-                   new_keys_stoc = Some new_keys_stoc;
-                   key_eol = Some key_eol;
-                   expect = Some MSG_NEWKEYS },
-          signature,
-          Msg_newkeys :: exts)
-    in
-    let cv_ckex t =
-      let* client_version = guard_some t.client_version "No client version" in
-      let* () = guard_none t.new_keys_stoc "Already got new_keys_stoc" in
-      let* () = guard_none t.new_keys_ctos "Already got new_keys_ctos" in
-      let* c = guard_some t.client_kexinit "No client kex" in
-      Ok (client_version, c.rawkex)
-    in
-    let dh ~ec t neg ~e ~f ~k =
-      let* client_version, i_c = cv_ckex t in
-      let pub_host_key = Hostkey.pub_of_priv t.host_key in
-      let h = Kex.Dh.compute_hash ~signed:(not ec) neg
-          ~v_c:client_version
-          ~v_s:t.server_version
-          ~i_c
-          ~i_s:(Wire.blob_of_kexinit t.server_kexinit)
-          ~k_s:pub_host_key
-          ~e ~f ~k
-      in
-      let* t, signature, msgs = sign_rekey t neg ~h ~f ~k in
-      Ok (t, (pub_host_key, signature), msgs)
-    in
-    begin
-      match t.neg_kex with
-      | None -> Error "No negotiated kex"
-      | Some neg ->
-        if Kex.is_rfc4419 neg.kex_alg then
-          let* m = Wire.dh_kexdh_gex_of_kex id data in
-          match t.dh_group, m with
-          | None, Msg_kexdh_gex_request (min, n, max) ->
-            let* group =
-              if max < 2048l then
-                Error "maximum group size too small"
-              else if min > 8192l then
-                Error "minimum group size too big"
-              else if min > n || n > max then
-                Error "group size limits wrong (min <= n <= max)"
-              else if n < 3072l then
-                Ok Mirage_crypto_pk.Dh.Group.ffdhe2048
-              else if n < 4096l then
-                Ok Mirage_crypto_pk.Dh.Group.ffdhe3072
-              else if n < 6144l then
-                Ok Mirage_crypto_pk.Dh.Group.ffdhe4096
-              else if n < 8192l then
-                Ok Mirage_crypto_pk.Dh.Group.ffdhe6144
-              else
-                Ok Mirage_crypto_pk.Dh.Group.ffdhe8192
-            in
-            make_replies { t with
-                           dh_group = Some (group, min, n, max);
-                           expect = Some MSG_KEX_2 }
-              [ Msg_kexdh_gex_group (group.p, group.gg) ]
-          | Some (group, min, n, max), Msg_kexdh_gex_init theirs ->
-            let secret, my_share = Mirage_crypto_pk.Dh.gen_key group in
-            let* client_version, i_c = cv_ckex t in
-            let* k = Kex.Dh.shared secret theirs in
-            let pub_host_key = Hostkey.pub_of_priv t.host_key in
-            let f = Mirage_crypto_pk.Z_extra.of_cstruct_be my_share in
-            let h =
-              Kex.Dh.compute_hash_gex neg
-                ~v_c:client_version ~v_s:t.server_version
-                ~i_c ~i_s:(Wire.blob_of_kexinit t.server_kexinit)
-                ~k_s:pub_host_key
-                ~min ~n ~max
-                ~p:group.p ~g:group.gg
-                ~e:theirs ~f
-                ~k
-            in
-            let* t, sig_, msgs = sign_rekey t neg ~h ~f ~k in
-            make_replies t
-              (Msg_kexdh_gex_reply (pub_host_key, f, sig_) :: msgs)
-          | _ -> Error "unexpected KEX message"
-        else if Kex.is_finite_field neg.kex_alg then
-          let* m = Wire.dh_kexdh_of_kex id data in
-          match m with
-          | Msg_kexdh_init e ->
-            let* f, k = Kex.(Dh.generate neg.kex_alg e) in
-            let* (t, (key, sig_), msgs) = dh ~ec:false t neg ~e ~f ~k in
-            make_replies t
-              (Msg_kexdh_reply (key, f, sig_) :: msgs)
-          | _ -> Error "unexpected KEX message"
-        else (* EC *)
-          let* m = Wire.dh_kexecdh_of_kex id data in
-          match m with
-          | Msg_kexecdh_init e ->
-            let secret, f = Kex.Dh.ec_secret_pub neg.kex_alg in
-            let* k = Kex.Dh.ec_shared secret e in
-            let* (t, (key, sig_), msgs) = dh ~ec:true t neg ~e ~f ~k in
-            make_replies t
-              (Msg_kexdh_reply (key, f, sig_) :: msgs)
-          | _ -> Error "unexpected KEX message"
+        let signature = neg.server_host_key_alg, signature in
+        make_replies { t with session_id = Some session_id;
+                              new_keys_ctos = Some new_keys_ctos;
+                              new_keys_stoc = Some new_keys_stoc;
+                              key_eol = Some key_eol;
+                              expect = Some MSG_NEWKEYS }
+          ([ Msg_kexdh_reply (pub_host_key, f, signature); Msg_newkeys ] @ (
+              if t.ext_info then
+                let algs =
+                  String.concat ","
+                    (List.map Hostkey.alg_to_string (host_key_algs t.host_key));
+                in
+                let extensions =
+                  [Extension { name = "server-sig-algs";
+                               value = algs; }]
+                in
+                [ Msg_ext_info extensions ]
+              else []))
+      | _ ->
+        Error "unexpected KEX message"
     end
   | Msg_newkeys ->
     (* If this is the first time we keyed, we must take a service request *)


Test patch:
diff --git a/test/test.ml b/test/test.ml
index 6a8f03e..b11bb60 100644
--- a/test/test.ml
+++ b/test/test.ml
@@ -410,7 +410,7 @@ let t_ignore_next_packet () =
   let t = Server.{ t with client_version = Some "SSH-2.0-client";
                           expect = Some(Ssh.MSG_KEXINIT) }
   in
-  let kexinit = Ssh.{ (Kex.make_kexinit Hostkey.preferred_algs Kex.supported ()) with
+  let kexinit = Ssh.{ (Kex.make_kexinit Hostkey.preferred_algs Kex.client_supported ()) with
                       encryption_algs_ctos = ["aes256-cbc"];
                       first_kex_packet_follows = true }
   in