packages feed

libssh2 0.2.0.8 → 0.2.0.9

raw patch · 5 files changed

+144/−36 lines, 5 files

Files

libssh2.cabal view
@@ -1,6 +1,6 @@ Name:                libssh2 -Version:             0.2.0.8+Version:             0.2.0.9  Synopsis:            FFI bindings to libssh2 SSH2 client library (http://libssh2.org/)
src/Network/SSH/Client/LibSSH2.hs view
@@ -27,6 +27,7 @@    sftpListDir,    sftpRenameFile,    sftpSendFile, sftpSendFromHandle,+   sftpSendBytes,    sftpReceiveFile, sftpReadFileToHandler,    sftpFstat,    sftpDeleteFile,@@ -73,7 +74,7 @@          -> 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@@ -89,7 +90,7 @@               -> 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 ->@@ -111,7 +112,7 @@          -> 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@@ -147,14 +148,16 @@           -> 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)@@ -267,7 +270,7 @@          -> 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@@ -284,7 +287,7 @@              -> 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@@ -346,6 +349,18 @@   let flags = [FXF_WRITE, FXF_CREAT, FXF_TRUNC, FXF_EXCL]   withOpenSftpFile sftp remote mode flags $ \sftph ->     sftpWriteFileFromHandler sftph fh++-- | Send bytes to a remote host via SFTP+-- Returns the size of sent data.+sftpSendBytes :: Sftp           -- ^ Opened sftp session+              -> BSS.ByteString -- ^ Bytes to write+              -> FilePath       -- ^ Remote file path+              -> Int            -- ^ File creation mode (0o777, for example)+              -> IO Integer+sftpSendBytes sftp bytes remote mode = do+  let flags = [FXF_WRITE, FXF_CREAT, FXF_TRUNC, FXF_EXCL]+  withOpenSftpFile sftp remote mode flags $ \sftph ->+    sftpWriteFileFromBytes sftph bytes  -- | Received a file from remote host via SFTP -- Returns size of received data.
src/Network/SSH/Client/LibSSH2/Errors.chs view
@@ -190,9 +190,12 @@     Nothing -> error "EAGAIN thrown on session without socket"     Just socket -> do       dirs <- blockedDirections s-      if (OUTBOUND `elem` dirs)-        then threadWaitWrite socket-        else threadWaitRead socket+      case dirs of+        [] -> pure ()+        _ ->+          if (OUTBOUND `elem` dirs)+            then threadWaitWrite socket+            else threadWaitRead socket  -- | Sftp
src/Network/SSH/Client/LibSSH2/Foreign.chs view
@@ -19,6 +19,7 @@    -- * Session functions    initialize, exit,    initSession, freeSession, disconnectSession,+   keepaliveConfig,    handshake,    setBlocking, @@ -33,7 +34,7 @@    -- * Channel functions    openChannelSession, closeChannel, freeChannel,    channelSendEOF, channelWaitEOF, channelIsEOF,-   readChannel, writeChannel,+   readChannel, readChannelStderr, writeChannel,    writeChannelFromHandle, readChannelToHandle,    channelProcess, channelExecute, channelShell,    requestPTY, requestPTYEx,@@ -46,8 +47,8 @@    sftpOpenDir, sftpReadDir, sftpCloseHandle,    sftpOpenFile,    sftpRenameFile, sftpRenameFileEx,-   sftpWriteFileFromHandler, sftpReadFileToHandler,-   sftpFstat, sftpDeleteFile,+   sftpWriteFileFromHandler, sftpWriteFileFromBytes,+   sftpReadFileToHandler, sftpFstat, sftpDeleteFile,     RenameFlag (..), SftpFileTransferFlags (..),    SftpAttributes (..),@@ -106,25 +107,79 @@   | 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@@ -226,6 +281,9 @@                   -> IO () disconnectSession s msg = void . handleInt (Just s) $ disconnectSessionEx s 11 msg "" +{# fun keepalive_config as keepaliveConfig+  { toPointer `Session', bool2int `Bool', `Int' } -> `()' #}+ {# fun session_set_blocking as setBlocking   { toPointer `Session', bool2int `Bool' } -> `()' #} @@ -272,15 +330,21 @@                    -> 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 #}@@ -289,10 +353,11 @@ 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_@@ -386,6 +451,12 @@             -> IO BSS.ByteString readChannel c sz = readChannelEx c 0 sz +-- | Read data from channel.+readChannelStderr :: Channel         --+                  -> Size             -- ^ Amount of data to read+                  -> IO BSS.ByteString+readChannelStderr c sz = readChannelEx c {#const SSH_EXTENDED_DATA_STDERR#} sz+ -- | Write data to channel. writeChannel :: Channel -> BSS.ByteString -> IO () writeChannel ch bs =@@ -761,6 +832,24 @@     bufferSize = 0x100000    in allocaBytes bufferSize $ go 0++-- | Upload bytes to the sftp server+-- Returns size of sent data.+sftpWriteFileFromBytes :: SftpHandle -> BSS.ByteString -> IO Integer+sftpWriteFileFromBytes sftph bs = BSS.useAsCStringLen bs (uncurry (send 0))+  where+    send :: Int -> Ptr CChar -> Int -> IO Integer+    send written _ 0 = pure (toInteger written)+    send written src len = do+      let nBytes = min len bufferSize+      sent <- fmap fromIntegral . handleInt (Just sftph)+                           $ {# call sftp_write #} (toPointer sftph)+                                                   src+                                                   (fromIntegral nBytes)+      send (written + sent) (src `plusPtr` written) (len - sent)++    bufferSize :: Int+    bufferSize = 0x100000  data SftpAttributes = SftpAttributes {   saFlags :: CULong,
src/Network/SSH/Client/LibSSH2/Types.chs view
@@ -140,6 +140,7 @@   deriving (Eq, Show)  int2dir :: (Eq a, Num a, Show a) => a -> [Direction]+int2dir 0 = [] int2dir 1 = [INBOUND] int2dir 2 = [OUTBOUND] int2dir 3 = [INBOUND, OUTBOUND]