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..773359c 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,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 -> 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) @@ -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 @@ -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 diff --git a/libssh2/src/Network/SSH/Client/LibSSH2/Foreign.chs b/libssh2/src/Network/SSH/Client/LibSSH2/Foreign.chs index a4a7dba..ad8bbe8 100644 --- a/libssh2/src/Network/SSH/Client/LibSSH2/Foreign.chs +++ b/libssh2/src/Network/SSH/Client/LibSSH2/Foreign.chs @@ -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 + +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) +-- | 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 +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) +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 +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_