libssh2 0.2.0.7 → 0.2.0.8

raw patch · 6 files changed

+294/−17 lines, 6 filesdep +libssh2dep ~networkPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: libssh2

Dependency ranges changed: network

API changes (from Hackage documentation)

Files

• libssh2.cabal +7/−4
• src/Network/SSH/Client/LibSSH2.hs +32/−8
• src/Network/SSH/Client/LibSSH2/Errors.chs +4/−0
• src/Network/SSH/Client/LibSSH2/Foreign.chs +196/−2
• src/Network/SSH/Client/LibSSH2/Types.chs +40/−2
• src/Network/SSH/Client/LibSSH2/WaitSocket.hs +15/−1

@@ -1,6 +1,6 @@ Name:                libssh2 -Version:             0.2.0.7+Version:             0.2.0.8  Synopsis:            FFI bindings to libssh2 SSH2 client library (http://libssh2.org/) @@ -40,7 +40,7 @@ Extra-source-files:  ssh-client.hs, Makefile, include/libssh2_local.h  -- Constraint on the version of Cabal needed to build this package.-Cabal-version:       >=1.8+Cabal-version:       >=1.10  flag gcrypt   description: add hack that allows to run threaded program when libssh2 is built against gcrypt@@ -60,7 +60,8 @@   Include-dirs:        include   Includes:            include/libssh2_local.h -  Build-depends:       base >= 4 && < 5, network >= 2.3,+  Build-depends:       base >= 4 && < 5,+                       network >= 2.3 && < 3.2,                        syb >= 0.3.3, time >= 1.2,                        bytestring >= 0.9,                        unix@@ -68,6 +69,7 @@   Extra-libraries:     "ssh2"   pkgconfig-depends:   libssh2 >= 1.2.8   GHC-Options:         -Wall+  Default-Language: Haskell2010    -- Other-modules: @@ -82,11 +84,12 @@  Executable hs-ssh-client   if flag(example-client)-    Build-depends: base, utf8-string, syb, network, filepath, bytestring, time+    Build-depends: base, utf8-string, syb, network, filepath, bytestring, time, libssh2   else     buildable: False   Main-Is: ssh-client.hs   GHC-Options: -threaded+  Default-Language: Haskell2010  Source-repository head   type: git

@@ -7,6 +7,7 @@    -- * Functions    withSSH2,    withSSH2User,+   withSSH2Agent,    withSession,    withChannel,    withChannelBy,@@ -17,10 +18,12 @@    scpReceiveFile,    runShellCommands,    execCommands,+   directTcpIpEx,     -- * Sftp Functions    withSFTP,    withSFTPUser,+   withSftpSession,    sftpListDir,    sftpRenameFile,    sftpSendFile, sftpSendFromHandle,@@ -36,8 +39,6 @@  import Control.Monad import Control.Exception as E-import Network  hiding (sClose)-import Network.BSD import Network.Socket import System.IO import qualified Data.ByteString as BSS@@ -50,12 +51,14 @@ -- | Similar to Network.connectTo, but does not socketToHandle. socketConnect :: String -> Int -> IO Socket socketConnect hostname port = do-    proto <- getProtocolNumber "tcp"-    bracketOnError (socket AF_INET Stream proto) (close)-            (\sock -> do-              he <- getHostByName hostname-              connect sock (SockAddrInet (fromIntegral port) (hostAddress he))-              return sock)+  let hints = defaultHints { addrSocketType = Stream }+  addr:_ <- getAddrInfo (Just hints) (Just hostname) (Just $ show port)+  bracketOnError+    (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))+    (close)+    (\sock -> do+       connect sock $ addrAddress addr+       return sock)  -- | Execute some actions within SSH2 connection. -- Uses public key authentication.@@ -75,6 +78,27 @@       error $ "Host key mismatch for host " ++ hostname     publicKeyAuthFile s login public private passphrase     fn s++-- | Execute some actions within SSH2 connection.+-- Uses agent based public key authentication.+withSSH2Agent :: String            -- ^ Path to known_hosts file+              -> String            -- ^ Remote user name+              -> String            -- ^ Remote host name+              -> Int               -- ^ Remote port number (usually 22)+              -> (Session -> IO a) -- ^ Actions to perform on session+              -> IO a+withSSH2Agent known_hosts login hostname port fn =+  withSession hostname port $ \s -> do+    r <- checkHost s hostname port known_hosts+    when (r == MISMATCH) $+      error $ "host key mismatch for host " ++ hostname+    E.bracket (agentInit s) agentFree $ \a ->+      E.bracket_ (agentConnect a) (agentDisconnect a) (act s login a fn)+    where+      act s u a f = do+          agentListIdentities a+          agentAuthenticate u a+          f s  -- | Execute some actions within SSH2 connection. -- Uses username/password authentication.

@@ -259,3 +259,7 @@    throwCtxSpecificError ctx =     throwCtxSpecificError (sftpHandleSession ctx)++instance SshCtx Agent where+  getSession = getSession . agentSession+  throwCtxSpecificError _ er = throw er

@@ -37,6 +37,7 @@    writeChannelFromHandle, readChannelToHandle,    channelProcess, channelExecute, channelShell,    requestPTY, requestPTYEx,+   directTcpIpEx,    channelExitStatus, channelExitSignal,    scpSendChannel, scpReceiveChannel, pollChannelRead, @@ -51,17 +52,35 @@    RenameFlag (..), SftpFileTransferFlags (..),    SftpAttributes (..), +   -- * SSH Agent functions+   Agent (..), AgentPublicKey,+   agentInit,+   agentConnect, agentDisconnect,+   agentListIdentities,+   agentGetIdentity,+   agentGetIdentities,+   agentFree,+   agentPublicKeyComment,+   agentPublicKeyBlob,+   agentUserAuth,+   agentAuthenticate,+    -- * Debug    TraceFlag (..), setTraceMode   ) where +import Control.Exception (throw, tryJust) import Control.Monad (void) import Data.Time.Clock.POSIX import Foreign hiding (void) import Foreign.C.Types import Foreign.C.String import System.IO+#if MIN_VERSION_network(3,0,0)+import Network.Socket (Socket, withFdSocket)+#else import Network.Socket (Socket(MkSocket), isReadable)+#endif import qualified Data.ByteString as BSS import qualified Data.ByteString.Unsafe as BSS @@ -129,16 +148,34 @@ init_crypto False = 1 init_crypto True  = 0 +#if MIN_VERSION_network(3,0,0) ssh2socket :: Socket #ifdef mingw32_HOST_OS     #ifdef x86_64_HOST_ARCH            -> CULLong     #else+           -> IO CUInt+    #endif+#else+           -> IO CInt+#endif+ssh2socket s =+#ifdef mingw32_HOST_OS+  fromIntegral <$> withFdSocket s pure+#else+  withFdSocket s pure+#endif+#else+ssh2socket :: Socket+#ifdef mingw32_HOST_OS+    #ifdef x86_64_HOST_ARCH+           -> CULLong+    #else            -> CUInt     #endif #else            -> CInt-#endif+#endif /* mingw32_HOST_OS */ ssh2socket (MkSocket s _ _ _ _) = #ifdef mingw32_HOST_OS   (fromIntegral s)@@ -146,6 +183,8 @@   s #endif +#endif /* MIN_VERSION_network(3,0,0) */+ {# fun init as initialize_   { init_crypto `Bool' } -> `Int' #} @@ -194,14 +233,24 @@ bool2int True  = 1 bool2int False = 0 +#if MIN_VERSION_network(3,0,0)+{# fun session_handshake+  { `Ptr ()', `CInt' } -> `Int' #}++handshake_ :: Session -> Socket -> IO Int+handshake_ session socket = do+  session_handshake (toPointer session) =<< ssh2socket socket+#else {# fun session_handshake as handshake_   { toPointer `Session', ssh2socket `Socket' } -> `Int' #}+#endif  -- | Run SSH handshake on network socket. handshake :: Session -> Socket -> IO () handshake session socket = do   sessionSetSocket session (Just socket)-  void . handleInt (Just session) $ handshake_ session socket+  void $ handleInt (Just session)+       $ handshake_ session socket  {# fun knownhost_init as initKnownHosts_   { toPointer `Session' } -> `Ptr ()' id #}@@ -280,6 +329,16 @@    `Int', `Int',    `String' & } -> `Ptr ()' id #} +{# fun channel_direct_tcpip_ex as directTcpIpEx_+  { toPointer `Session',+   `String',+   `Int',+   `String',+   `Int' } -> `Ptr ()' id #}++directTcpIpEx :: Session -> String -> Int -> String -> Int -> IO Channel+directTcpIpEx s host port shost sport = handleNullPtr (Just s) (channelFromPointer s) $ directTcpIpEx_ s host port shost sport+ -- | Open a channel for session. openChannelSession :: Session -> IO Channel openChannelSession s = handleNullPtr (Just s) (channelFromPointer s) $@@ -518,7 +577,11 @@   mbSocket <- sessionGetSocket (channelSession ch)   case mbSocket of     Nothing -> error "pollChannelRead without socket present"+#if MIN_VERSION_network(3,0,0)+    Just _ -> pure True+#else     Just socket -> isReadable socket+#endif  -- -- | Sftp support@@ -738,3 +801,134 @@   withCStringLen path $ \(str,len) -> do     void . handleInt (Just sftp) $       {# call sftp_unlink_ex #} (toPointer sftp) str (toEnum len)+++--+-- | Agent support+--++-- | Initialize a new ssh agent handle.+agentInit :: Session -> IO Agent+agentInit s = handleNullPtr (Just s) (agentFromPointer s) $ agentInit_ s++{# fun agent_init as agentInit_ { toPointer `Session' } -> `Ptr ()' id #}++{# fun agent_free as agentFree+  { toPointer `Agent' } -> `()' #}++-- | Attempt to establish a connection to an ssh agent process.+-- | The environment variable @SSH_AUTH_SOCK@ is used to determine where to connect on unix.+agentConnect :: Agent -> IO ()+agentConnect agent = void . handleInt (Just agent) $ agentConnect_ agent++{# fun agent_connect as agentConnect_ { toPointer `Agent' } -> `Int' #}++-- | Get or update the list of known identities. Must be called at least once.+agentListIdentities :: Agent -> IO ()+agentListIdentities agent = void . handleInt (Just agent) $ agentListIdentities_ agent++{# fun agent_list_identities as agentListIdentities_ { toPointer `Agent' } -> `Int' #}++-- | Cleans up a connection to an ssh agent.+agentDisconnect :: Agent -> IO ()+agentDisconnect agent = void . handleInt (Just agent) $ agentDisconnect_ agent++{# fun agent_disconnect as agentDisconnect_ { toPointer `Agent' } -> `Int' #}++-- | Copies all the keys from the agent to the local process.+agentGetIdentities :: Agent -> IO [AgentPublicKey]+agentGetIdentities agent = agentGetIdentities_ agent []+  where+    agentGetIdentities_ :: Agent -> [AgentPublicKey] -> IO [AgentPublicKey]+    agentGetIdentities_ agent' acc@[] = do+      k <- agentGetIdentity agent' Nothing+      case k of+        Just aKey -> agentGetIdentities_ agent' [aKey]+        Nothing -> return acc+    agentGetIdentities_ agent' acc = do+      k <- agentGetIdentity agent' $ Just $ head acc+      case k of+        Just aKey -> agentGetIdentities_ agent' (aKey:acc)+        Nothing -> return acc++agentNullPublicKey :: IO AgentPublicKey+agentNullPublicKey = agentPublicKeyFromPointer nullPtr++-- | Copies one identity from the agent to the local process.+agentGetIdentity :: Agent                     -- ^ Agent handle.+                 -> Maybe AgentPublicKey      -- ^ Previous key returned.+                 -> IO (Maybe AgentPublicKey)+agentGetIdentity agent Nothing = do+  nullKey <- agentNullPublicKey+  agentGetIdentity agent (Just nullKey)+agentGetIdentity agent (Just key) = do+  agentGetIdentity_ agent key++agentGetIdentity_ :: Agent -> AgentPublicKey -> IO (Maybe AgentPublicKey)+agentGetIdentity_ a pk = do+  withAgentPublicKey pk $ \pkPtr -> do+    alloca $ \ptr -> do+      (res, pptr) <- with ptr $ \pkStore -> do+                x <- {# call agent_get_identity #} (toPointer a) pkStore (castPtr pkPtr)+                pptr <- peek pkStore+                return (x, pptr)+      void $ handleInt (Just a) (return res)+      if res == 0+        then do+          resPkPtr <- agentPublicKeyFromPointer pptr+          return $ Just resPkPtr+        else return Nothing++-- | Return the comment from the given agent public key.+agentPublicKeyComment :: AgentPublicKey -> IO BSS.ByteString+agentPublicKeyComment pk = do+  withAgentPublicKey pk $ \pkPtr -> do+    c <- {# get struct agent_publickey->comment #} pkPtr+    BSS.packCString c++-- | Return the bytes of the given agent public key.+agentPublicKeyBlob :: AgentPublicKey -> IO BSS.ByteString+agentPublicKeyBlob pk = do+  withAgentPublicKey pk $ \pkPtr -> do+    blobPtr <- {# get struct agent_publickey->blob #} pkPtr+    blobLen <- {# get struct agent_publickey->blob_len #} pkPtr+    BSS.packCStringLen (castPtr blobPtr, fromEnum blobLen)++-- | Perform agent based public key authentication.+-- You almost certainly want @agentAuthenticate instead of this, since this+-- only does one round of authentication with the agent.+agentUserAuth :: Agent          -- ^ Agent handle.+              -> String         -- ^ Username to authenticate with.+              -> AgentPublicKey -- ^ Public key to use from the agent.+              -> IO ()+agentUserAuth agent username key = void . handleInt (Just agent) $ agentUserAuth_ agent username key++{# fun agent_userauth as agentUserAuth_ { toPointer `Agent'+                                        , `String'+                                        , withAgentPublicKeyVoidPtr* `AgentPublicKey'+                                        } -> `Int' #}++-- | Authenticate with an ssh agent.+-- Takes a user and an agent and tries each key from the agent in succession.+-- Throws AUTHENTICATION_FAILED if it's unable to authenticate.+-- If you call this, you need to call @agentListIdentities at least once.+agentAuthenticate :: String -- ^ Remote user name.+                  -> Agent  -- ^ Connection to an agent.+                  -> IO ()+agentAuthenticate login agent = do+  firstKey <- agentGetIdentity agent Nothing+  agentAuthenticate' login agent firstKey+  where+      agentAuthenticate' _ _ Nothing = throw AUTHENTICATION_FAILED+      agentAuthenticate' u a (Just k) = do+          r <- tryJust isAuthenticationFailed (agentUserAuth a u k)+          case r of+              Left _ -> do+                  nextKey <- agentGetIdentity a $ Just k+                  agentAuthenticate' u a nextKey+              Right _ -> return ()+      isAuthenticationFailed AUTHENTICATION_FAILED = Just ()+      isAuthenticationFailed _ = Nothing++withAgentPublicKeyVoidPtr :: AgentPublicKey -> (Ptr () -> IO a) -> IO a+withAgentPublicKeyVoidPtr p f = withAgentPublicKey p $ \pp -> f (castPtr pp)

@@ -17,6 +17,8 @@    Channel,    Sftp,    SftpHandle,+   Agent,+   AgentPublicKey,    ToPointer (..),    Direction (..),    int2dir,@@ -35,11 +37,14 @@    sftpSession,    sftpHandlePtr,    sftpHandleFromPointer,-   sftpHandleSession+   sftpHandleSession,+   agentFromPointer,+   agentSession,+   agentPublicKeyFromPointer,+   withAgentPublicKey   ) where  import Foreign-import Foreign.C.Types import Foreign.C.String import Data.Generics import Data.IORef@@ -65,6 +70,7 @@     then return Nothing     else Just `fmap` peekCAString strPtr + class ToPointer p where   toPointer :: p -> Ptr () @@ -172,3 +178,35 @@  instance ToPointer SftpHandle where   toPointer = castPtr . sftpHandlePtr+++--+-- | Agent support+--++agentFromPointer :: Session -> Ptr () -> IO Agent+agentFromPointer session ptr = return $ Agent (castPtr ptr) session++{# pointer *AGENT as CAgent #}++data Agent = Agent { agentPtr :: CAgent, agentSession :: Session }++instance Show Agent where+  show agent = "<libssh2 agent: " ++ show (agentPtr agent) ++ ">"++instance ToPointer Agent where+  toPointer = castPtr . agentPtr++{# pointer *agent_publickey as AgentPublicKey foreign newtype #}++agentPublicKeyFromPointer :: Ptr () -> IO AgentPublicKey+agentPublicKeyFromPointer ptr = do+  newPtr <- newForeignPtr_ ptr+  return $ AgentPublicKey $ castForeignPtr newPtr++deriving instance Eq AgentPublicKey+deriving instance Data AgentPublicKey+deriving instance Typeable AgentPublicKey++instance Show AgentPublicKey where+  show (AgentPublicKey p) = "<libssh2 agent publickey: " ++ show p ++ ">"

@@ -11,7 +11,13 @@   , threadWaitWrite   ) where -import Network.Socket(Socket,fdSocket)+import Network.Socket(Socket)+#if MIN_VERSION_network(3,0,0)+import Network.Socket(withFdSocket)+#else+import Network.Socket(fdSocket)+#endif+ import System.Posix.Types(Fd(Fd))  #ifdef mingw32_HOST_OS@@ -26,10 +32,18 @@ #endif  threadWaitRead :: Socket -> IO ()+#if MIN_VERSION_network(3,0,0)+threadWaitRead = flip withFdSocket (threadWaitRead_ . Fd)+#else threadWaitRead = threadWaitRead_ . Fd . fdSocket+#endif  threadWaitWrite :: Socket -> IO ()+#if MIN_VERSION_network(3,0,0)+threadWaitWrite = flip withFdSocket (threadWaitWrite_ . Fd)+#else threadWaitWrite = threadWaitWrite_ . Fd . fdSocket+#endif  -- | Block the current thread until data is available to read on the -- given file descriptor (GHC only).