Skip to content
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

Reimplement bindings for session_hostkey and knownhost_checkp #67

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Reimplement bindings for session_hostkey and knownhost_checkp #67

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
4 changes: 2 additions & 2 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 @@ -152,8 +152,8 @@ checkHost :: Session
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]
(hostkey, _keytype) <- getHostKey s
result <- checkKnownHost kh host port hostkey [TYPE_PLAIN, KEYENC_RAW, KEY_RSA1, KEY_SSHRSA, KEY_SSHDSS]
Copy link
Contributor

Choose a reason for hiding this comment

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

I think we also need KEYENC_BASE64, since the keys in the known hosts file are base64 encoded.

Copy link
Contributor

Choose a reason for hiding this comment

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

I needed this in my implementation at least.

Copy link
Contributor

Choose a reason for hiding this comment

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

Perhaps we should allow the user of this function to pass the flags, and add it as a parameter to the function.

Copy link
Owner Author

Choose a reason for hiding this comment

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

I thought maybe it would be better to do

(hostkey, keytype) <- getHostKey s
result <- checkKnownHost kh host port hostkey [keytype]

what do you think?

Copy link
Contributor

Choose a reason for hiding this comment

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

That is insufficient; the typemask details not just what key type is it, but also what format the host name is and what format the key is in. See
https://www.libssh2.org/libssh2_knownhost_check.html

For example, we'd pass [TYPE_PLAIN, KEYENC_BASE64, KEY_SSHRSA] to specify that the host name is plain (not hashed), that the key is base64 encoded and that the key is an ssh-rsa key.

freeKnownHosts kh
return result

Expand Down
50 changes: 34 additions & 16 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 @@ -117,12 +117,28 @@ 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_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

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
| otherwise = error $ "Unsupported known host type: " ++ show i

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

Expand Down Expand Up @@ -276,27 +292,29 @@ 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 knownhost_checkp as checkKnownHost_
{ toPointer `KnownHosts',
`String',
`Int',
`String',
`Int',
typemask2int `[KnownHostType]',
castPtr `Ptr ()' } -> `KnownHostResult' int2khresult #}

-- | Get remote host public key and it's type
getHostKey :: Session -> IO (BSS.ByteString, KnownHostType)
getHostKey session = do
alloca $ \sizePtr ->
alloca $ \khtPtr -> do
keyPtr <- {# call session_hostkey #} (toPointer session) sizePtr khtPtr
keySize <- peek sizePtr
kht <- peek khtPtr
key <- BSS.packCStringLen (keyPtr, fromIntegral keySize)
return (key, int2kht kht)

-- | Check host data against known hosts.
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 hostname port key flags = do
withCString hostname $ \hostnamePtr ->
BSS.useAsCStringLen key $ \(keyPtr, keySize) -> do
res <- {# call knownhost_checkp #} (toPointer kh) hostnamePtr (fromIntegral port) keyPtr (fromIntegral keySize) (typemask2int flags) nullPtr
return $ int2khresult res

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