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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
open Util
let src = Logs.Src.create "awa.authenticator" ~doc:"AWA authenticator"
module Log = (val Logs.src_log src : Logs.LOG)
type typ = [ `Rsa | `Ed25519 ]
let typ_of_string s =
match String.lowercase_ascii s with
| "rsa" -> Ok `Rsa
| "ed25519" -> Ok `Ed25519
| _ -> Error ("unknown key type " ^ s)
let string_of_typ = function
| `Rsa -> "rsa"
| `Ed25519 -> "ed25519"
type authenticator = [
| `No_authentication
| `Key of Hostkey.pub
| `Fingerprint of typ * string
]
let hostkey_matches a key =
match a with
| `No_authentication ->
Log.warn (fun m -> m "NO AUTHENTICATOR");
true
| `Key pub' ->
if key = pub' then begin
Log.app (fun m -> m "host key verification successful!");
true
end else begin
Log.err (fun m -> m "host key verification failed");
false
end
| `Fingerprint (typ, s) ->
let hash = Digestif.SHA256.(to_raw_string (digest_string (Cstruct.to_string (Wire.blob_of_pubkey key)))) in
Log.app (fun m -> m "authenticating server fingerprint SHA256:%s"
(Base64.encode_string ~pad:false hash));
let typ_matches = match typ, key with
| `Ed25519, Hostkey.Ed25519_pub _ -> true
| `Rsa, Hostkey.Rsa_pub _ -> true
| _ -> false
and fp_matches = String.equal s hash
in
if typ_matches && fp_matches then begin
Log.app (fun m -> m "host fingerprint verification successful!");
true
end else begin
Log.err (fun m -> m "host fingerprint verification failed");
false
end
let authenticator_of_string str =
if str = "" then
Ok `No_authentication
else
match String.split_on_char ':' str with
| [ y ; fp ] ->
let* t =
match y with
| "SHA256" -> Ok `Rsa
| y -> typ_of_string y
in
begin match Base64.decode ~pad:false fp with
| Error (`Msg m) ->
Error ("invalid authenticator (bad b64 in fingerprint): " ^ m)
| Ok fp -> Ok (`Fingerprint (t, fp))
end
| _ ->
match Base64.decode ~pad:false str with
| Ok k ->
let* key = Wire.pubkey_of_blob_error_as_string (Cstruct.of_string k) in
Ok (`Key key)
| Error (`Msg msg) ->
Error (str ^ " is invalid or unsupported authenticator, b64 failed: " ^ msg)
let of_seed ?bits typ seed =
let typ = match typ with `Rsa -> `RSA | `Ed25519 -> `ED25519 in
match X509.Private_key.generate ~seed ?bits typ with
| `RSA k ->
let pub = Mirage_crypto_pk.Rsa.pub_of_priv k in
let pubkey = Wire.blob_of_pubkey (Hostkey.Rsa_pub pub) in
Log.info (fun m -> m "using ssh-rsa %s"
(Cstruct.to_string pubkey |> Base64.encode_string));
Hostkey.Rsa_priv k
| `ED25519 k ->
let pub = Mirage_crypto_ec.Ed25519.pub_of_priv k in
let pubkey = Wire.blob_of_pubkey (Hostkey.Ed25519_pub pub) in
Log.info (fun m -> m "using ssh-ed25519 %s"
(Cstruct.to_string pubkey |> Base64.encode_string));
Hostkey.Ed25519_priv k
| _ -> assert false
let of_string str =
match String.split_on_char ':' str with
| [ typ; data; ] ->
let* typ = Result.map_error (fun m -> `Msg m) (typ_of_string typ) in
let typ = match typ with `Rsa -> `RSA | `Ed25519 -> `ED25519 in
let* res = X509.Private_key.of_string typ data in
(match res with
| `RSA k -> Ok (Hostkey.Rsa_priv k)
| `ED25519 k -> Ok (Hostkey.Ed25519_priv k)
| _ -> assert false)
| _ -> Error (`Msg "Invalid SSH key format (type:key)")