From 2096e6259b11e7bd9d670652f951793c777ff8e0 Mon Sep 17 00:00:00 2001 From: Jente Hidskes Ankarberg Date: Tue, 15 Feb 2022 14:21:28 +0100 Subject: [PATCH 1/4] Fix getHostKey The C function libssh2_session_hostkey returns a const char* where the first byte is (often) a NULL byte. This causes the Haskell FFI to return an empty String. Hence, we create a new FFI to libssh2_session_hostkey that returns a Ptr CChar, that we then wrap in a function that returns a base64 encoded String. This way we can capture the host key, including its NULL byte, in a proper Haskell type. Although this is a bug fix, this changes Haskell type signatures of exported functions. See #66. --- .../Network/SSH/Client/LibSSH2/Foreign.chs | 42 ++++++++++++++++--- 1 file changed, 36 insertions(+), 6 deletions(-) diff --git a/libssh2/src/Network/SSH/Client/LibSSH2/Foreign.chs b/libssh2/src/Network/SSH/Client/LibSSH2/Foreign.chs index a4a7dba..b98e76e 100644 --- a/libssh2/src/Network/SSH/Client/LibSSH2/Foreign.chs +++ b/libssh2/src/Network/SSH/Client/LibSSH2/Foreign.chs @@ -126,6 +126,29 @@ kht2int KEY_SSHDSS = 3 `shiftL` 18 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 @@ -276,15 +299,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) +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 #} @@ -293,10 +322,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_ From cc4440b8604f29dfc6b203fef446906f25bb5b45 Mon Sep 17 00:00:00 2001 From: Jente Hidskes Ankarberg Date: Sat, 19 Feb 2022 12:25:20 +0100 Subject: [PATCH 2/4] Fix checkHost The user needs to be able to specify the format of the hostname, key and key type. Although this is a bug fix, this changes Haskell type signatures of exported functions. See #66. --- libssh2-conduit/ssh-client.hs | 2 +- libssh2/src/Network/SSH/Client/LibSSH2.hs | 17 +++++++++-------- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/libssh2-conduit/ssh-client.hs b/libssh2-conduit/ssh-client.hs index bb215ab..606a9dd 100644 --- a/libssh2-conduit/ssh-client.hs +++ b/libssh2-conduit/ssh-client.hs @@ -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] publicKeyAuthFile session login public private "" (Just ch, !src) <- execCommand True session command hSetBuffering stdout NoBuffering diff --git a/libssh2/src/Network/SSH/Client/LibSSH2.hs b/libssh2/src/Network/SSH/Client/LibSSH2.hs index f6d511f..e912675 100644 --- a/libssh2/src/Network/SSH/Client/LibSSH2.hs +++ b/libssh2/src/Network/SSH/Client/LibSSH2.hs @@ -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 @@ -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 -> @@ -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 @@ -148,12 +148,13 @@ 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 -> IO KnownHostResult -checkHost s host port path = do +checkHost s host port path flags = do kh <- initKnownHosts s _numKnownHosts <- knownHostsReadFile kh path - (hostkey, _keylen, _keytype) <- getHostKey s - result <- checkKnownHost kh host port hostkey [TYPE_PLAIN, KEYENC_RAW] + (hostkey, _keytype) <- getHostKey s + result <- checkKnownHost kh host port hostkey flags freeKnownHosts kh return result @@ -268,7 +269,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 @@ -285,7 +286,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 From 98deedc2dfdcb30e861fc740f5e775f1086ba05a Mon Sep 17 00:00:00 2001 From: Jente Hidskes Ankarberg Date: Tue, 15 Feb 2022 14:26:39 +0100 Subject: [PATCH 3/4] Add new LIBSSH2_KNOWNHOST_KEY types --- .../Network/SSH/Client/LibSSH2/Foreign.chs | 53 +++++++++++++++---- 1 file changed, 42 insertions(+), 11 deletions(-) diff --git a/libssh2/src/Network/SSH/Client/LibSSH2/Foreign.chs b/libssh2/src/Network/SSH/Client/LibSSH2/Foreign.chs index b98e76e..ad8bbe8 100644 --- a/libssh2/src/Network/SSH/Client/LibSSH2/Foreign.chs +++ b/libssh2/src/Network/SSH/Client/LibSSH2/Foreign.chs @@ -107,21 +107,52 @@ 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 + +int2kht :: CInt -> KnownHostType +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) From 0f96157ae1011540048dc78a9338639d8cf2b71e Mon Sep 17 00:00:00 2001 From: Jente Hidskes Ankarberg Date: Tue, 15 Feb 2022 14:33:06 +0100 Subject: [PATCH 4/4] Implement checkHost in terms of bracket --- libssh2/src/Network/SSH/Client/LibSSH2.hs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/libssh2/src/Network/SSH/Client/LibSSH2.hs b/libssh2/src/Network/SSH/Client/LibSSH2.hs index e912675..773359c 100644 --- a/libssh2/src/Network/SSH/Client/LibSSH2.hs +++ b/libssh2/src/Network/SSH/Client/LibSSH2.hs @@ -150,13 +150,14 @@ checkHost :: Session -> 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 -> IO KnownHostResult -checkHost s host port path flags = do - kh <- initKnownHosts s - _numKnownHosts <- knownHostsReadFile kh path - (hostkey, _keytype) <- getHostKey s - result <- checkKnownHost kh host port hostkey flags - 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)