Skip to content

Fix known hosts check #69

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
portnov merged 4 commits into from
Apr 24, 2022
Merged

Fix known hosts check #69

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
2096e62
Fix getHostKey
Hjdskes Feb 15, 2022
cc4440b
Fix checkHost
Hjdskes Feb 19, 2022
98deedc
Add new LIBSSH2_KNOWNHOST_KEY types
Hjdskes Feb 15, 2022
0f96157
Implement checkHost in terms of bracket
Hjdskes Feb 15, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion libssh2-conduit/ssh-client.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ ssh login host port command = do
public = home </> ".ssh" </> "id_rsa.pub"
private = home </> ".ssh" </> "id_rsa"
withSession host port $ \session -> do
r <- checkHost session host port known_hosts
r <- checkHost session host port known_hosts [TYPE_MASK]
Copy link
Copy Markdown
Contributor Author

@Hjdskes Hjdskes Feb 15, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I am not sure if this is the right behaviour; it basically allows everything. I opted for this because I did not want to make any more breaking changes.

publicKeyAuthFile session login public private ""
(Just ch, !src) <- execCommand True session command
hSetBuffering stdout NoBuffering
Expand Down
26 changes: 14 additions & 12 deletions libssh2/src/Network/SSH/Client/LibSSH2.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -74,7 +74,7 @@ withSSH2 :: FilePath -- ^ Path to known_hosts file
-> IO a
withSSH2 known_hosts public private passphrase login hostname port fn =
withSession hostname port $ \s -> do
r <- checkHost s hostname port known_hosts
r <- checkHost s hostname port known_hosts [TYPE_MASK]
when (r == MISMATCH) $
error $ "Host key mismatch for host " ++ hostname
publicKeyAuthFile s login public private passphrase
Expand All @@ -90,7 +90,7 @@ withSSH2Agent :: String -- ^ Path to known_hosts file
-> IO a
withSSH2Agent known_hosts login hostname port fn =
withSession hostname port $ \s -> do
r <- checkHost s hostname port known_hosts
r <- checkHost s hostname port known_hosts [TYPE_MASK]
when (r == MISMATCH) $
error $ "host key mismatch for host " ++ hostname
E.bracket (agentInit s) agentFree $ \a ->
Expand All @@ -112,7 +112,7 @@ withSSH2User :: FilePath -- ^ Path to known_hosts file
-> IO a
withSSH2User known_hosts login password hostname port fn =
withSession hostname port $ \s -> do
r <- checkHost s hostname port known_hosts
r <- checkHost s hostname port known_hosts [TYPE_MASK]
when (r == MISMATCH) $
error $ "Host key mismatch for host " ++ hostname
usernamePasswordAuth s login password
Expand Down Expand Up @@ -148,14 +148,16 @@ checkHost :: Session
-> String -- ^ Remote host name
-> Int -- ^ Remote port number (usually 22)
-> FilePath -- ^ Path to known_hosts file
-> [KnownHostType] -- ^ Flags specifying what format the host name is, what format the key is and what key type it is
Copy link
Copy Markdown
Contributor Author

@Hjdskes Hjdskes Feb 15, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is a breaking change, but one that is necessary.

-> IO KnownHostResult
checkHost s host port path = do
kh <- initKnownHosts s
_numKnownHosts <- knownHostsReadFile kh path
(hostkey, _keylen, _keytype) <- getHostKey s
result <- checkKnownHost kh host port hostkey [TYPE_PLAIN, KEYENC_RAW]
freeKnownHosts kh
return result
checkHost s host port path flags = bracket
(initKnownHosts s)
freeKnownHosts
(\kh -> do
_numKnownHosts <- knownHostsReadFile kh path
(hostkey, _keytype) <- getHostKey s
checkKnownHost kh host port hostkey flags
)

-- | Execute some actions withing SSH2 channel
withChannel :: Session -> (Channel -> IO a) -> IO (Int, a)
Expand Down Expand Up @@ -268,7 +270,7 @@ withSFTP :: FilePath -- ^ Path to known_hosts file
-> IO a
withSFTP known_hosts public private passphrase login hostname port fn =
withSession hostname port $ \s -> do
r <- checkHost s hostname port known_hosts
r <- checkHost s hostname port known_hosts [TYPE_MASK]
when (r == MISMATCH) $
error $ "Host key mismatch for host " ++ hostname
publicKeyAuthFile s login public private passphrase
Expand All @@ -285,7 +287,7 @@ withSFTPUser :: FilePath -- ^ Path to known_hosts file
-> IO a
withSFTPUser known_hosts login password hostname port fn =
withSession hostname port $ \s -> do
r <- checkHost s hostname port known_hosts
r <- checkHost s hostname port known_hosts [TYPE_MASK]
when (r == MISMATCH) $
error $ "Host key mismatch for host " ++ hostname
usernamePasswordAuth s login password
Expand Down
95 changes: 78 additions & 17 deletions libssh2/src/Network/SSH/Client/LibSSH2/Foreign.chs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -107,25 +107,79 @@ data KnownHostType =
| KEY_RSA1
| KEY_SSHRSA
| KEY_SSHDSS
| KEY_ECDSA_256
| KEY_ECDSA_384
| KEY_ECDSA_521
| KEY_ED25519
| KEY_UNKNOWN
deriving (Eq, Show)

kht2int :: KnownHostType -> CInt
kht2int TYPE_MASK = 0xffff
kht2int TYPE_PLAIN = 1
kht2int TYPE_SHA1 = 2
kht2int TYPE_CUSTOM = 3
kht2int KEYENC_MASK = 3 `shiftL` 16
kht2int KEYENC_RAW = 1 `shiftL` 16
kht2int TYPE_MASK = 0xffff
kht2int TYPE_PLAIN = 1
kht2int TYPE_SHA1 = 2
kht2int TYPE_CUSTOM = 3
kht2int KEYENC_MASK = 3 `shiftL` 16
kht2int KEYENC_RAW = 1 `shiftL` 16
kht2int KEYENC_BASE64 = 2 `shiftL` 16
kht2int KEY_MASK = 3 `shiftL` 18
kht2int KEY_SHIFT = 18
kht2int KEY_RSA1 = 1 `shiftL` 18
kht2int KEY_SSHRSA = 2 `shiftL` 18
kht2int KEY_SSHDSS = 3 `shiftL` 18
kht2int KEY_MASK = 15 `shiftL` 18
kht2int KEY_SHIFT = 18
kht2int KEY_RSA1 = 1 `shiftL` 18
kht2int KEY_SSHRSA = 2 `shiftL` 18
kht2int KEY_SSHDSS = 3 `shiftL` 18
kht2int KEY_ECDSA_256 = 4 `shiftL` 18
kht2int KEY_ECDSA_384 = 5 `shiftL` 18
kht2int KEY_ECDSA_521 = 6 `shiftL` 18
kht2int KEY_ED25519 = 7 `shiftL` 18
kht2int KEY_UNKNOWN = 15 `shiftL` 18
Copy link
Copy Markdown
Contributor Author

@Hjdskes Hjdskes Feb 15, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If you look carefully, you see that both KEY_MASK and KEY_UNKNOWN are 15 << 18. This is true in upstream too: https://github.com/libssh2/libssh2/blob/de7a74aff24c47b2f2e9815f0a98598195d602e4/include/libssh2.h#L1023


int2kht :: CInt -> KnownHostType
Copy link
Copy Markdown
Contributor Author

@Hjdskes Hjdskes Feb 15, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This function is now unused, I wasn't sure whether to keep it (and possible export it) or get rid of it.

int2kht 0xffff = TYPE_MASK
int2kht 1 = TYPE_PLAIN
int2kht 2 = TYPE_SHA1
int2kht 3 = TYPE_CUSTOM
int2kht 18 = KEY_SHIFT
int2kht i
| i == 3 `shiftL` 16 = KEYENC_MASK
| i == 1 `shiftL` 16 = KEYENC_RAW
| i == 2 `shiftL` 16 = KEYENC_BASE64
| i == 15 `shiftL` 18 = KEY_MASK
| i == 1 `shiftL` 18 = KEY_RSA1
| i == 2 `shiftL` 18 = KEY_SSHRSA
| i == 3 `shiftL` 18 = KEY_SSHDSS
| i == 4 `shiftL` 18 = KEY_ECDSA_256
| i == 5 `shiftL` 18 = KEY_ECDSA_384
| i == 6 `shiftL` 18 = KEY_ECDSA_521
| i == 7 `shiftL` 18 = KEY_ED25519
| i == 15 `shiftL` 18 = KEY_UNKNOWN
| otherwise = error $ "Unsupported known host type: " ++ show i

typemask2int :: [KnownHostType] -> CInt
typemask2int list = foldr (.|.) 0 (map kht2int list)

-- | Host key types. See libssh2 documentation.
data HostKeyType =
UNKNOWN
| RSA
| DSS
| ECDSA_256
| ECDSA_384
| ECDSA_521
| ED25519
deriving (Enum, Eq, Ord)

instance Show HostKeyType where
show UNKNOWN = "unknown"
show RSA = "ssh-rsa"
show DSS = "ssh-dss"
show ECDSA_256 = "ecdsa-sha2-nistp256"
show ECDSA_384 = "ecdsa-sha2-nistp384"
show ECDSA_521 = "ecdsa-sha2-nistp521"
show ED25519 = "ssh-ed25519"

int2hkt :: Integral n => n -> HostKeyType
int2hkt = toEnum . fromIntegral

-- Result of matching host against known_hosts.
data KnownHostResult =
MATCH
Expand Down Expand Up @@ -276,15 +330,21 @@ knownHostsReadFile :: KnownHosts
-> IO Int
knownHostsReadFile kh path = handleInt (Nothing :: Maybe Session) $ knownHostsReadFile_ kh path 1

-- | Get remote host public key
{# fun session_hostkey as getHostKey
{ toPointer `Session', alloca- `Size' peek*, alloca- `CInt' peek* } -> `String' #}
{# fun session_hostkey as getHostKey_
{ toPointer `Session', alloca- `Size' peek*, alloca- `CInt' peek* } -> `Ptr CChar' id #}

-- | Get remote host public key and its type
getHostKey :: Session -> IO (BSS.ByteString, HostKeyType)
Copy link
Copy Markdown
Contributor Author

@Hjdskes Hjdskes Feb 19, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is the second breaking change.

getHostKey session = do
(keyPtr, keySize, keyType) <- getHostKey_ session
key <- BSS.packCStringLen (keyPtr, fromIntegral keySize)
pure (key, int2hkt keyType)

{# fun knownhost_checkp as checkKnownHost_
{ toPointer `KnownHosts',
`String',
`Int',
`String',
id `Ptr CChar',
`Int',
typemask2int `[KnownHostType]',
castPtr `Ptr ()' } -> `KnownHostResult' int2khresult #}
Expand All @@ -293,10 +353,11 @@ knownHostsReadFile kh path = handleInt (Nothing :: Maybe Session) $ knownHostsRe
checkKnownHost :: KnownHosts --
-> String -- ^ Host name
-> Int -- ^ Port number (usually 22)
-> String -- ^ Host public key
-> BSS.ByteString -- ^ Host public key
-> [KnownHostType] -- ^ Host flags (see libssh2 documentation)
-> IO KnownHostResult
checkKnownHost kh host port key flags = checkKnownHost_ kh host port key (length key) flags nullPtr
checkKnownHost kh host port key flags = BSS.useAsCStringLen key $ \(keyPtr, keySize) -> do
checkKnownHost_ kh host port keyPtr keySize flags nullPtr

-- TODO: I don't see the '&' in the libssh2 docs?
{# fun userauth_publickey_fromfile_ex as publicKeyAuthFile_
Expand Down