check that ssh public key received over the wire is sane

1 files changed, 13 insertions, 0 deletions

diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs
index 7e72dd99d..c158f7dd2 100644
--- a/Assistant/Ssh.hs
+++ b/Assistant/Ssh.hs
@@ -83,6 +83,19 @@ sshTranscript opts input = do
 	return ()
 	return (transcript, ok)
 
+{- Ensure that the ssh public key doesn't include any ssh options, like
+ - command=foo, or other weirdness -}
+validateSshPubKey :: SshPubKey -> IO ()
+validateSshPubKey pubkey = do
+	let ws = words pubkey
+	when (length ws > 3 || length ws < 2) $
+		error $ "wrong number of words in ssh public key " ++ pubkey
+	let (ssh, keytype) = separate (== '-') (ws !! 0)
+	unless (ssh == "ssh" && all isAlphaNum keytype) $
+		error $ "bad ssh public key prefix " ++ ws !! 0
+	when (length ws == 3) $
+		unless (all (\c -> isAlphaNum c || c == '@') (ws !! 2)) $
+			error $ "bad comment in ssh public key " ++ pubkey
 
 makeAuthorizedKeys :: Bool -> SshPubKey -> IO Bool
 makeAuthorizedKeys rsynconly pubkey = boolSystem "sh"