libssh2-conduit 0.1 → 0.2.1
raw patch · 3 files changed
+71/−95 lines, 3 filesdep +bytestringdep +conduit-combinatorsdep +filepathdep −monad-controldep ~basedep ~conduitdep ~libssh2new-component:exe:hs-ssh-client
Dependencies added: bytestring, conduit-combinators, filepath, libssh2-conduit, text
Dependencies removed: monad-control
Dependency ranges changed: base, conduit, libssh2, stm
Files
- Network/SSH/Client/LibSSH2/Conduit.hs +25/−70
- libssh2-conduit.cabal +35/−16
- ssh-client.hs +11/−9
Network/SSH/Client/LibSSH2/Conduit.hs view
@@ -1,85 +1,47 @@ {-# LANGUAGE FlexibleContexts #-} module Network.SSH.Client.LibSSH2.Conduit (sourceChannel,- splitLines, CommandsHandle, execCommand, getReturnCode ) where import Control.Monad-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Resource-import Control.Monad.Trans.Control-import System.IO.Unsafe (unsafeInterleaveIO)+import Control.Monad.IO.Class (MonadIO (..)) import Control.Concurrent.STM-import Data.Monoid import Data.Conduit-import Data.Conduit.Lazy+import qualified Data.ByteString as B import Network.SSH.Client.LibSSH2.Foreign import Network.SSH.Client.LibSSH2 -- | Read all contents of libssh2's Channel.-sourceChannel :: Channel -> Source IO String+sourceChannel :: MonadIO m => Channel -> Source m B.ByteString sourceChannel ch = src where- src = Source pull close-- pull = do- (sz, res) <- liftIO $ readChannel ch 0x400- if sz > 0- then return $ Open src res- else return Closed-- close = return ()---- | Similar to Data.Conduit.Binary.lines, but for Strings.-splitLines :: Resource m => Conduit String m String-splitLines =- conduitState id push close- where- push front bs' = return $ StateProducing leftover ls- where- bs = front bs'- (leftover, ls) = getLines id bs-- getLines front bs- | null bs = (id, front [])- | null y = ((x ++), front [])- | otherwise = getLines (front . (x:)) (drop 1 y)- where- (x, y) = break (== '\n') bs-- close front- | null bs = return []- | otherwise = return [bs]- where- bs = front ""+ src = do+ res <- liftIO $ readChannel ch 0x400+ if B.length res > 0+ then do+ yield res+ src+ else return () -- | Execute one command and read it's output lazily. -- If first argument is True, then you *must* get return code -- using getReturnCode on returned CommandsHandle. Moreover, -- you *must* guarantee that getReturnCode will be called -- only when all command output will be read.-execCommand :: Bool -- ^ Set to True if you want to get return code when command will terminate.+execCommand :: MonadIO m+ => Bool -- ^ Set to True if you want to get return code when command will terminate. -> Session -> String -- ^ Command- -> IO (Maybe CommandsHandle, Source IO String) + -> IO (Maybe CommandsHandle, Source m B.ByteString) execCommand b s cmd = do (ch, channel) <- initCH b s- let src = execCommandS ch channel cmd $= splitLines+ let src = execCommandSrc ch channel cmd return (if b then Just ch else Nothing, src) --- execCommands :: Bool -> Session -> [String] -> IO [String]--- execCommands b s cmds = do--- let srcs = [execCommandS (v i) s cmd | (i, cmd) <- zip [1..] cmds ]--- v i | i == length cmds = var--- | otherwise = Nothing--- res <- runResourceT $ lazyConsume $ mconcat srcs $= splitLines--- return res- -- | Handles channel opening and closing. data CommandsHandle = CommandsHandle { chReturnCode :: Maybe (TMVar Int),@@ -126,29 +88,22 @@ rc <- atomically $ takeTMVar v return rc -execCommandS :: CommandsHandle -> Channel -> String -> Source IO String-execCommandS var channel command =- Source {- sourcePull = pull channel - , sourceClose = return () }+execCommandSrc :: MonadIO m => CommandsHandle -> Channel -> String -> Source m B.ByteString+execCommandSrc var channel command = src where+ src = do+ liftIO $ channelExecute channel command+ pullAnswer channel - next ch =- Source (pullAnswer ch) $ do- return ()- --liftIO $ cleanupChannel var ch- pullAnswer ch = do- (sz, res) <- liftIO $ readChannel ch 0x400- if sz > 0- then return $ Open (next ch) res+ res <- liftIO $ readChannel ch 0x400+ if B.length res > 0+ then do+ yield res+ pullAnswer ch else do liftIO $ cleanupChannel var ch- return Closed-- pull ch = do- liftIO $ channelExecute ch command- pullAnswer ch+ return () -- | Close Channel and write return code cleanupChannel :: CommandsHandle -> Channel -> IO ()
libssh2-conduit.cabal view
@@ -1,5 +1,5 @@ Name: libssh2-conduit-Version: 0.1+Version: 0.2.1 Synopsis: Conduit wrappers for libssh2 FFI bindings (see libssh2 package). @@ -8,7 +8,7 @@ receive data from SSH channels lazily, without need to read all channel output to the memory. -Homepage: http://redmine.iportnov.ru/projects/libssh2-hs+Homepage: https://github.com/portnov/libssh2-hs License: BSD3 @@ -16,13 +16,8 @@ Author: IlyaPortnov --- An email address to which users can send suggestions, bug reports,--- and patches. Maintainer: portnov84@rambler.ru --- A copyright notice.--- Copyright: - Category: Network Build-type: Simple@@ -30,15 +25,39 @@ Extra-source-files: Makefile, ssh-client.hs -- Constraint on the version of Cabal needed to build this package.-Cabal-version: >=1.6+Cabal-version: >=1.8 +flag example-client+ description: Build the example client+ default: False+ Library Exposed-modules: Network.SSH.Client.LibSSH2.Conduit- - Build-depends: base >= 4 && <5, stm, transformers,- monad-control >= 0.3.1,- conduit >= 0.2.0, libssh2- - -- Modules not exported by this package.- -- Other-modules: - + GHC-Options: -fwarn-unused-imports++ Build-depends: base >= 4 && <5,+ bytestring >= 0.10,+ conduit >= 1.0.7,+ libssh2 >= 0.2.0.5,+ stm,+ transformers++Executable hs-ssh-client+ if flag(example-client)+ Build-depends: base, libssh2 >= 0.2.0.5,+ stm >= 2.4,+ transformers,+ libssh2-conduit >= 0.2.1,+ conduit >= 1.0.7,+ conduit-combinators >= 1.0.3,+ text >= 1.2.2.0,+ filepath, bytestring+ else+ buildable: False+ Main-Is: ssh-client.hs+ Other-modules: Network.SSH.Client.LibSSH2.Conduit+ GHC-Options: -threaded -fwarn-unused-imports++Source-repository head+ type: git+ location: https://github.com/portnov/libssh2-hs
ssh-client.hs view
@@ -1,12 +1,12 @@+{-# LANGUAGE BangPatterns #-} -import Control.Monad-import Control.Monad.Trans.Resource-import Control.Concurrent.STM import Data.Conduit-import Data.Conduit.Lazy+import qualified Data.Conduit.Combinators as C+import qualified Data.Conduit.List as CL import System.Environment import System.FilePath-import Codec.Binary.UTF8.String+import qualified Data.Text.IO as TIO+import System.IO import Network.SSH.Client.LibSSH2.Foreign import Network.SSH.Client.LibSSH2.Conduit@@ -24,12 +24,14 @@ let known_hosts = home </> ".ssh" </> "known_hosts" public = home </> ".ssh" </> "id_rsa.pub" private = home </> ".ssh" </> "id_rsa"- withSessionBlocking host port $ \session -> do+ withSession host port $ \session -> do r <- checkHost session host port known_hosts publicKeyAuthFile session login public private ""- (Just ch, src) <- execCommand True session command- res <- runResourceT $ lazyConsume src- forM (map decodeString res) putStrLn+ (Just ch, !src) <- execCommand True session command+ hSetBuffering stdout NoBuffering+ src =$= C.decodeUtf8 =$= C.linesUnbounded $$ CL.mapM_ TIO.putStrLn rc <- getReturnCode ch putStrLn $ "Exit code: " ++ show rc exit++returnStrict !x = return x