{-# LANGUAGE ScopedTypeVariables #-}
module Network.SSH.Client.LibSSH2
  (-- * Types
   Session, Channel, KnownHosts, Sftp, SftpHandle,
   SftpAttributes, SftpList, SftpFileTransferFlags,

   -- * Functions
   withSSH2,
   withSSH2User,
   withSSH2Agent,
   withSession,
   withChannel,
   withChannelBy,
   checkHost,
   readAllChannel,
   writeAllChannel,
   scpSendFile,
   scpReceiveFile,
   runShellCommands,
   execCommands,
   directTcpIpEx,

   -- * Sftp Functions
   withSFTP,
   withSFTPUser,
   withSftpSession,
   sftpListDir,
   sftpRenameFile,
   sftpSendFile, sftpSendFromHandle,
   sftpSendBytes,
   sftpReceiveFile, sftpReadFileToHandler,
   sftpFstat,
   sftpDeleteFile,

   -- * Utilities
   socketConnect,
   sessionInit,
   sessionClose,
  ) where

import Control.Monad
import Control.Exception as E
import Network.Socket
import System.IO
import qualified Data.ByteString as BSS
import qualified Data.ByteString.Char8 as BSSC
import qualified Data.ByteString.Lazy as BSL

import Network.SSH.Client.LibSSH2.Types
import Network.SSH.Client.LibSSH2.Foreign

-- | Similar to Network.connectTo, but does not socketToHandle.
socketConnect :: String -> Int -> IO Socket
socketConnect :: String -> Int -> IO Socket
socketConnect String
hostname Int
port = do
  let hints :: AddrInfo
hints = AddrInfo
defaultHints { addrSocketType :: SocketType
addrSocketType = SocketType
Stream }
  AddrInfo
addr:[AddrInfo]
_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo (forall a. a -> Maybe a
Just AddrInfo
hints) (forall a. a -> Maybe a
Just String
hostname) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
port)
  forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
    (Family -> SocketType -> ProtocolNumber -> IO Socket
socket (AddrInfo -> Family
addrFamily AddrInfo
addr) (AddrInfo -> SocketType
addrSocketType AddrInfo
addr) (AddrInfo -> ProtocolNumber
addrProtocol AddrInfo
addr))
    (Socket -> IO ()
close)
    (\Socket
sock -> do
       Socket -> SockAddr -> IO ()
connect Socket
sock forall a b. (a -> b) -> a -> b
$ AddrInfo -> SockAddr
addrAddress AddrInfo
addr
       forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock)

-- | Execute some actions within SSH2 connection.
-- Uses public key authentication.
withSSH2 :: FilePath          -- ^ Path to known_hosts file
         -> FilePath          -- ^ Path to public key file
         -> FilePath          -- ^ Path to private key file
         -> String            -- ^ Passphrase
         -> String            -- ^ Remote user name
         -> String            -- ^ Remote host name
         -> Int               -- ^ Remote port number (usually 22)
         -> (Session -> IO a) -- ^ Actions to perform on session
         -> IO a
withSSH2 :: forall a.
String
-> String
-> String
-> String
-> String
-> String
-> Int
-> (Session -> IO a)
-> IO a
withSSH2 String
known_hosts String
public String
private String
passphrase String
login String
hostname Int
port Session -> IO a
fn =
  forall a. String -> Int -> (Session -> IO a) -> IO a
withSession String
hostname Int
port forall a b. (a -> b) -> a -> b
$ \Session
s -> do
    KnownHostResult
r <- Session
-> String -> Int -> String -> [KnownHostType] -> IO KnownHostResult
checkHost Session
s String
hostname Int
port String
known_hosts [KnownHostType
TYPE_MASK]
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (KnownHostResult
r forall a. Eq a => a -> a -> Bool
== KnownHostResult
MISMATCH) forall a b. (a -> b) -> a -> b
$
      forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Host key mismatch for host " forall a. [a] -> [a] -> [a]
++ String
hostname
    Session -> String -> String -> String -> String -> IO ()
publicKeyAuthFile Session
s String
login String
public String
private String
passphrase
    Session -> IO a
fn Session
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 :: forall a.
String -> String -> String -> Int -> (Session -> IO a) -> IO a
withSSH2Agent String
known_hosts String
login String
hostname Int
port Session -> IO a
fn =
  forall a. String -> Int -> (Session -> IO a) -> IO a
withSession String
hostname Int
port forall a b. (a -> b) -> a -> b
$ \Session
s -> do
    KnownHostResult
r <- Session
-> String -> Int -> String -> [KnownHostType] -> IO KnownHostResult
checkHost Session
s String
hostname Int
port String
known_hosts [KnownHostType
TYPE_MASK]
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (KnownHostResult
r forall a. Eq a => a -> a -> Bool
== KnownHostResult
MISMATCH) forall a b. (a -> b) -> a -> b
$
      forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"host key mismatch for host " forall a. [a] -> [a] -> [a]
++ String
hostname
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (Session -> IO Agent
agentInit Session
s) Agent -> IO ()
agentFree forall a b. (a -> b) -> a -> b
$ \Agent
a ->
      forall a b c. IO a -> IO b -> IO c -> IO c
E.bracket_ (Agent -> IO ()
agentConnect Agent
a) (Agent -> IO ()
agentDisconnect Agent
a) (forall {t} {b}. t -> String -> Agent -> (t -> IO b) -> IO b
act Session
s String
login Agent
a Session -> IO a
fn)
    where
      act :: t -> String -> Agent -> (t -> IO b) -> IO b
act t
s String
u Agent
a t -> IO b
f = do
          Agent -> IO ()
agentListIdentities Agent
a
          String -> Agent -> IO ()
agentAuthenticate String
u Agent
a
          t -> IO b
f t
s

-- | Execute some actions within SSH2 connection.
-- Uses username/password authentication.
withSSH2User :: FilePath          -- ^ Path to known_hosts file
         -> String            -- ^ Remote user name
         -> String            -- ^ Remote password
         -> String            -- ^ Remote host name
         -> Int               -- ^ Remote port number (usually 22)
         -> (Session -> IO a) -- ^ Actions to perform on session
         -> IO a
withSSH2User :: forall a.
String
-> String -> String -> String -> Int -> (Session -> IO a) -> IO a
withSSH2User String
known_hosts String
login String
password String
hostname Int
port Session -> IO a
fn =
  forall a. String -> Int -> (Session -> IO a) -> IO a
withSession String
hostname Int
port forall a b. (a -> b) -> a -> b
$ \Session
s -> do
    KnownHostResult
r <- Session
-> String -> Int -> String -> [KnownHostType] -> IO KnownHostResult
checkHost Session
s String
hostname Int
port String
known_hosts [KnownHostType
TYPE_MASK]
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (KnownHostResult
r forall a. Eq a => a -> a -> Bool
== KnownHostResult
MISMATCH) forall a b. (a -> b) -> a -> b
$
      forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Host key mismatch for host " forall a. [a] -> [a] -> [a]
++ String
hostname
    Session -> String -> String -> IO ()
usernamePasswordAuth Session
s String
login String
password
    Session -> IO a
fn Session
s

-- | Execute some actions within SSH2 session
withSession :: String            -- ^ Remote host name
            -> Int               -- ^ Remote port number (usually 22)
            -> (Session -> IO a) -- ^ Actions to perform on handle and session
            -> IO a
withSession :: forall a. String -> Int -> (Session -> IO a) -> IO a
withSession String
hostname Int
port = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (String -> Int -> IO Session
sessionInit String
hostname Int
port) Session -> IO ()
sessionClose

--  | Initialize session to the gived host
sessionInit :: String -> Int -> IO Session
sessionInit :: String -> Int -> IO Session
sessionInit String
hostname Int
port = do
      Socket
sock <- String -> Int -> IO Socket
socketConnect String
hostname Int
port
      Session
session <- IO Session
initSession
      Session -> Bool -> IO ()
setBlocking Session
session Bool
False
      Session -> Socket -> IO ()
handshake Session
session Socket
sock
      forall (m :: * -> *) a. Monad m => a -> m a
return Session
session

--  | Close active session
sessionClose :: Session -> IO ()
sessionClose :: Session -> IO ()
sessionClose Session
session = do
      Session -> String -> IO ()
disconnectSession Session
session String
"Done."
      Session -> IO (Maybe Socket)
sessionGetSocket Session
session forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Socket -> IO ()
close
      Session -> IO ()
freeSession Session
session



--  | Check remote host against known hosts list
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 :: Session
-> String -> Int -> String -> [KnownHostType] -> IO KnownHostResult
checkHost Session
s String
host Int
port String
path [KnownHostType]
flags = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
  (Session -> IO KnownHosts
initKnownHosts Session
s)
  KnownHosts -> IO ()
freeKnownHosts
  (\KnownHosts
kh -> do
    Int
_numKnownHosts <- KnownHosts -> String -> IO Int
knownHostsReadFile KnownHosts
kh String
path
    (ByteString
hostkey, HostKeyType
_keytype) <- Session -> IO (ByteString, HostKeyType)
getHostKey Session
s
    KnownHosts
-> String
-> Int
-> ByteString
-> [KnownHostType]
-> IO KnownHostResult
checkKnownHost KnownHosts
kh String
host Int
port ByteString
hostkey [KnownHostType]
flags
  )

-- | Execute some actions withing SSH2 channel
withChannel :: Session -> (Channel -> IO a) -> IO (Int, a)
withChannel :: forall a. Session -> (Channel -> IO a) -> IO (Int, a)
withChannel Session
s = forall a b. IO a -> (a -> Channel) -> (a -> IO b) -> IO (Int, b)
withChannelBy (Session -> IO Channel
openChannelSession Session
s) forall a. a -> a
id

-- | Read all data from the channel
--
-- Although this function returns a lazy bytestring, the data is /not/ read
-- lazily.
readAllChannel :: Channel -> IO BSL.ByteString
readAllChannel :: Channel -> IO ByteString
readAllChannel Channel
ch = [ByteString] -> IO ByteString
go []
  where
    go :: [BSS.ByteString] -> IO BSL.ByteString
    go :: [ByteString] -> IO ByteString
go [ByteString]
acc = do
      ByteString
bs <- Channel -> Size -> IO ByteString
readChannel Channel
ch Size
0x400
      if ByteString -> Int
BSS.length ByteString
bs forall a. Ord a => a -> a -> Bool
> Int
0
        then [ByteString] -> IO ByteString
go (ByteString
bs forall a. a -> [a] -> [a]
: [ByteString]
acc)
        else forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
BSL.fromChunks forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [ByteString]
acc)

readAllChannelNonBlocking :: Channel -> IO BSL.ByteString
readAllChannelNonBlocking :: Channel -> IO ByteString
readAllChannelNonBlocking Channel
ch = [ByteString] -> IO ByteString
go []
  where
    go :: [BSS.ByteString] -> IO BSL.ByteString
    go :: [ByteString] -> IO ByteString
go [ByteString]
acc = do
      ByteString
bs <- do Bool
readable <- Channel -> IO Bool
pollChannelRead Channel
ch
               if Bool
readable
                 then Channel -> Size -> IO ByteString
readChannel Channel
ch Size
0x400
                 else forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
BSS.empty
      if ByteString -> Int
BSS.length ByteString
bs forall a. Ord a => a -> a -> Bool
> Int
0
        then [ByteString] -> IO ByteString
go (ByteString
bs forall a. a -> [a] -> [a]
: [ByteString]
acc)
        else forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
BSL.fromChunks forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [ByteString]
acc)

-- | Write a lazy bytestring to the channel
writeAllChannel :: Channel -> BSL.ByteString -> IO ()
writeAllChannel :: Channel -> ByteString -> IO ()
writeAllChannel Channel
ch = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Channel -> ByteString -> IO ()
writeChannel Channel
ch) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL.toChunks

runShellCommands :: Session -> [String] -> IO (Int, [BSL.ByteString])
runShellCommands :: Session -> [String] -> IO (Int, [ByteString])
runShellCommands Session
s [String]
commands = forall a. Session -> (Channel -> IO a) -> IO (Int, a)
withChannel Session
s forall a b. (a -> b) -> a -> b
$ \Channel
ch -> do
  Channel -> String -> IO ()
requestPTY Channel
ch String
"linux"
  Channel -> IO ()
channelShell Channel
ch
  ByteString
_hello <- Channel -> IO ByteString
readAllChannelNonBlocking Channel
ch
  [ByteString]
out <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
commands forall a b. (a -> b) -> a -> b
$ \String
cmd -> do
             Channel -> ByteString -> IO ()
writeChannel Channel
ch (String -> ByteString
BSSC.pack forall a b. (a -> b) -> a -> b
$ String
cmd forall a. [a] -> [a] -> [a]
++ String
"\n")
             ByteString
r <- Channel -> IO ByteString
readAllChannelNonBlocking Channel
ch
             forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
r
  Channel -> IO ()
channelSendEOF Channel
ch
  forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
out

execCommands :: Session -> [String] -> IO (Int, [BSL.ByteString])
execCommands :: Session -> [String] -> IO (Int, [ByteString])
execCommands Session
s [String]
commands = forall a. Session -> (Channel -> IO a) -> IO (Int, a)
withChannel Session
s forall a b. (a -> b) -> a -> b
$ \Channel
ch ->
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
commands forall a b. (a -> b) -> a -> b
$ \String
cmd -> do
      Channel -> String -> IO ()
channelExecute Channel
ch String
cmd
      Channel -> IO ByteString
readAllChannel Channel
ch

-- | Send a file to remote host via SCP.
-- Returns size of sent data.
scpSendFile :: Session
            -> Int       -- ^ File creation mode (0o777, for example)
            -> FilePath  -- ^ Path to local file
            -> FilePath  -- ^ Remote file path
            -> IO Integer
scpSendFile :: Session -> Int -> String -> String -> IO Integer
scpSendFile Session
s Int
mode String
local String
remote = do
  Handle
h <- String -> IOMode -> IO Handle
openFile String
local IOMode
ReadMode
  Integer
size <- Handle -> IO Integer
hFileSize Handle
h
  (Int
_, Integer
result) <- forall a b. IO a -> (a -> Channel) -> (a -> IO b) -> IO (Int, b)
withChannelBy (Session
-> String -> Int -> Int64 -> POSIXTime -> POSIXTime -> IO Channel
scpSendChannel Session
s String
remote Int
mode (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size) POSIXTime
0 POSIXTime
0) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ \Channel
ch -> do
    Integer
written <- Channel -> Handle -> IO Integer
writeChannelFromHandle Channel
ch Handle
h
    Channel -> IO ()
channelSendEOF Channel
ch
    Channel -> IO ()
channelWaitEOF Channel
ch
    forall (m :: * -> *) a. Monad m => a -> m a
return Integer
written
  Handle -> IO ()
hClose Handle
h
  forall (m :: * -> *) a. Monad m => a -> m a
return Integer
result

-- | Receive file from remote host via SCP.
-- Returns size of received data.
scpReceiveFile :: Session   --
               -> FilePath  -- ^ Remote file path
               -> FilePath  -- ^ Path to local file
               -> IO Integer
scpReceiveFile :: Session -> String -> String -> IO Integer
scpReceiveFile Session
s String
remote String
local = do
  Handle
h <- String -> IOMode -> IO Handle
openFile String
local IOMode
WriteMode
  (Int
_, Integer
result) <- forall a b. IO a -> (a -> Channel) -> (a -> IO b) -> IO (Int, b)
withChannelBy (Session -> String -> IO (Channel, Offset)
scpReceiveChannel Session
s String
remote) forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ \(Channel
ch, Offset
fileSize) -> do
    Channel -> Handle -> Offset -> IO Integer
readChannelToHandle Channel
ch Handle
h Offset
fileSize
  Handle -> IO ()
hClose Handle
h
  forall (m :: * -> *) a. Monad m => a -> m a
return Integer
result

-- | Generalization of 'withChannel'
withChannelBy :: IO a            -- ^ Create a channel (and possibly other stuff)
              -> (a -> Channel)  -- ^ Extract the channel from "other stuff"
              -> (a -> IO b)     -- ^ Actions to execute on the channel
              -> IO (Int, b)     -- ^ Channel exit status and return value
withChannelBy :: forall a b. IO a -> (a -> Channel) -> (a -> IO b) -> IO (Int, b)
withChannelBy IO a
createChannel a -> Channel
extractChannel a -> IO b
actions = do
  a
stuff <- IO a
createChannel
  let ch :: Channel
ch = a -> Channel
extractChannel a
stuff
  b
result <- a -> IO b
actions a
stuff
  Channel -> IO ()
closeChannel Channel
ch
  Int
exitStatus <- Channel -> IO Int
channelExitStatus Channel
ch
  Channel -> IO ()
freeChannel Channel
ch
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
exitStatus, b
result)

-- | Execute some actions within SFTP connection.
-- Uses public key authentication.
withSFTP :: FilePath          -- ^ Path to known_hosts file
         -> FilePath          -- ^ Path to public key file
         -> FilePath          -- ^ Path to private key file
         -> String            -- ^ Passphrase
         -> String            -- ^ Remote user name
         -> String            -- ^ Remote host name
         -> Int               -- ^ Remote port number (usually 22)
         -> (Sftp -> IO a)    -- ^ Actions to perform on sftp session
         -> IO a
withSFTP :: forall a.
String
-> String
-> String
-> String
-> String
-> String
-> Int
-> (Sftp -> IO a)
-> IO a
withSFTP String
known_hosts String
public String
private String
passphrase String
login String
hostname Int
port Sftp -> IO a
fn =
  forall a. String -> Int -> (Session -> IO a) -> IO a
withSession String
hostname Int
port forall a b. (a -> b) -> a -> b
$ \Session
s -> do
    KnownHostResult
r <- Session
-> String -> Int -> String -> [KnownHostType] -> IO KnownHostResult
checkHost Session
s String
hostname Int
port String
known_hosts [KnownHostType
TYPE_MASK]
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (KnownHostResult
r forall a. Eq a => a -> a -> Bool
== KnownHostResult
MISMATCH) forall a b. (a -> b) -> a -> b
$
      forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Host key mismatch for host " forall a. [a] -> [a] -> [a]
++ String
hostname
    Session -> String -> String -> String -> String -> IO ()
publicKeyAuthFile Session
s String
login String
public String
private String
passphrase
    forall a. Session -> (Sftp -> IO a) -> IO a
withSftpSession Session
s Sftp -> IO a
fn

-- | Execute some actions within SFTP connection.
-- Uses username/password authentication.
withSFTPUser :: FilePath          -- ^ Path to known_hosts file
             -> String            -- ^ Remote user name
             -> String            -- ^ Remote password
             -> String            -- ^ Remote host name
             -> Int               -- ^ Remote port number (usually 22)
             -> (Sftp -> IO a)    -- ^ Actions to perform on sftp session
             -> IO a
withSFTPUser :: forall a.
String
-> String -> String -> String -> Int -> (Sftp -> IO a) -> IO a
withSFTPUser String
known_hosts String
login String
password String
hostname Int
port Sftp -> IO a
fn =
  forall a. String -> Int -> (Session -> IO a) -> IO a
withSession String
hostname Int
port forall a b. (a -> b) -> a -> b
$ \Session
s -> do
    KnownHostResult
r <- Session
-> String -> Int -> String -> [KnownHostType] -> IO KnownHostResult
checkHost Session
s String
hostname Int
port String
known_hosts [KnownHostType
TYPE_MASK]
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (KnownHostResult
r forall a. Eq a => a -> a -> Bool
== KnownHostResult
MISMATCH) forall a b. (a -> b) -> a -> b
$
      forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Host key mismatch for host " forall a. [a] -> [a] -> [a]
++ String
hostname
    Session -> String -> String -> IO ()
usernamePasswordAuth Session
s String
login String
password
    forall a. Session -> (Sftp -> IO a) -> IO a
withSftpSession Session
s Sftp -> IO a
fn

-- | Execute some actions within SFTP session
withSftpSession :: Session           -- ^ Remote host name
                -> (Sftp -> IO a)    -- ^ Actions to perform on sftp session
                -> IO a
withSftpSession :: forall a. Session -> (Sftp -> IO a) -> IO a
withSftpSession Session
session =
  forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (Session -> IO Sftp
sftpInit Session
session) Sftp -> IO ()
sftpShutdown

type SftpList = [(BSS.ByteString, SftpAttributes)]

-- | Reads directory information
-- Returns the list of files with attributes, directory . and ..
-- are not excluded
sftpListDir :: Sftp        -- ^ Opened sftp session
            -> FilePath    -- ^ Remote directory to read
            -> IO SftpList
sftpListDir :: Sftp -> String -> IO SftpList
sftpListDir Sftp
sftp String
path =
  let
    collectFiles :: SftpHandle -> SftpList -> IO SftpList
    collectFiles :: SftpHandle -> SftpList -> IO SftpList
collectFiles SftpHandle
h SftpList
acc = do
      Maybe (ByteString, SftpAttributes)
v <- SftpHandle -> IO (Maybe (ByteString, SftpAttributes))
sftpReadDir SftpHandle
h
      case Maybe (ByteString, SftpAttributes)
v of
        Maybe (ByteString, SftpAttributes)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return SftpList
acc
        Just (ByteString, SftpAttributes)
r  -> SftpHandle -> SftpList -> IO SftpList
collectFiles SftpHandle
h ((ByteString, SftpAttributes)
r forall a. a -> [a] -> [a]
: SftpList
acc)
  in
    forall a. Sftp -> String -> (SftpHandle -> IO a) -> IO a
withDirList Sftp
sftp String
path forall a b. (a -> b) -> a -> b
$ \SftpHandle
h ->
      SftpHandle -> SftpList -> IO SftpList
collectFiles SftpHandle
h []

withDirList :: Sftp
            -> FilePath
            -> (SftpHandle -> IO a)
            -> IO a
withDirList :: forall a. Sftp -> String -> (SftpHandle -> IO a) -> IO a
withDirList Sftp
sftp String
path = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (Sftp -> String -> IO SftpHandle
sftpOpenDir Sftp
sftp String
path) SftpHandle -> IO ()
sftpCloseHandle


-- | Send a file to remote host via SFTP
-- Returns size of sent data.
sftpSendFile :: Sftp      -- ^ Opened sftp session
             -> FilePath  -- ^ Path to local file
             -> FilePath  -- ^ Remote file path
             -> Int       -- ^ File creation mode (0o777, for example)
             -> IO Integer
sftpSendFile :: Sftp -> String -> String -> Int -> IO Integer
sftpSendFile Sftp
sftp String
local String
remote Int
mode =
  forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
local IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
fh ->
    Sftp -> Handle -> String -> Int -> IO Integer
sftpSendFromHandle Sftp
sftp Handle
fh String
remote Int
mode

-- | Send a file to remote host via SFTP
-- Returns size of sent data.
sftpSendFromHandle :: Sftp      -- ^ Opened sftp session
                   -> Handle    -- ^ Handle to read from
                   -> FilePath  -- ^ Remote file path
                   -> Int       -- ^ File creation mode (0o777, for example)
                   -> IO Integer
sftpSendFromHandle :: Sftp -> Handle -> String -> Int -> IO Integer
sftpSendFromHandle Sftp
sftp Handle
fh String
remote Int
mode = do
  let flags :: [SftpFileTransferFlags]
flags = [SftpFileTransferFlags
FXF_WRITE, SftpFileTransferFlags
FXF_CREAT, SftpFileTransferFlags
FXF_TRUNC, SftpFileTransferFlags
FXF_EXCL]
  forall a.
Sftp
-> String
-> Int
-> [SftpFileTransferFlags]
-> (SftpHandle -> IO a)
-> IO a
withOpenSftpFile Sftp
sftp String
remote Int
mode [SftpFileTransferFlags]
flags forall a b. (a -> b) -> a -> b
$ \SftpHandle
sftph ->
    SftpHandle -> Handle -> IO Integer
sftpWriteFileFromHandler SftpHandle
sftph Handle
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 -> ByteString -> String -> Int -> IO Integer
sftpSendBytes Sftp
sftp ByteString
bytes String
remote Int
mode = do
  let flags :: [SftpFileTransferFlags]
flags = [SftpFileTransferFlags
FXF_WRITE, SftpFileTransferFlags
FXF_CREAT, SftpFileTransferFlags
FXF_TRUNC, SftpFileTransferFlags
FXF_EXCL]
  forall a.
Sftp
-> String
-> Int
-> [SftpFileTransferFlags]
-> (SftpHandle -> IO a)
-> IO a
withOpenSftpFile Sftp
sftp String
remote Int
mode [SftpFileTransferFlags]
flags forall a b. (a -> b) -> a -> b
$ \SftpHandle
sftph ->
    SftpHandle -> ByteString -> IO Integer
sftpWriteFileFromBytes SftpHandle
sftph ByteString
bytes

-- | Received a file from remote host via SFTP
-- Returns size of received data.
sftpReceiveFile :: Sftp      -- ^ Opened sftp session
                -> FilePath  -- ^ Path to local file
                -> FilePath  -- ^ Remote file path
                -> IO Integer
sftpReceiveFile :: Sftp -> String -> String -> IO Integer
sftpReceiveFile Sftp
sftp String
local String
remote =
  forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
local IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
fh ->
    Sftp -> String -> Handle -> IO Integer
sftpReceiveToHandle Sftp
sftp String
remote Handle
fh

-- | Received a file from remote host via SFTP
-- Returns size of received data.
sftpReceiveToHandle :: Sftp      -- ^ Opened sftp session
                    -> FilePath  -- ^ Path to remote file
                    -> Handle    -- ^ Open handle to write to
                    -> IO Integer
sftpReceiveToHandle :: Sftp -> String -> Handle -> IO Integer
sftpReceiveToHandle Sftp
sftp String
remote Handle
fh = do
  Int
result <- forall a.
Sftp
-> String
-> Int
-> [SftpFileTransferFlags]
-> (SftpHandle -> IO a)
-> IO a
withOpenSftpFile Sftp
sftp String
remote Int
0 [SftpFileTransferFlags
FXF_READ] forall a b. (a -> b) -> a -> b
$ \SftpHandle
sftph -> do
    SftpAttributes
fstat <- SftpHandle -> IO SftpAttributes
sftpFstat SftpHandle
sftph
    SftpHandle -> Handle -> Int -> IO Int
sftpReadFileToHandler SftpHandle
sftph Handle
fh (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ SftpAttributes -> CULLong
saFileSize SftpAttributes
fstat)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
result

withOpenSftpFile :: Sftp
                 -> FilePath
                 -> Int
                 -> [SftpFileTransferFlags]
                 -> (SftpHandle -> IO a)
                 -> IO a
withOpenSftpFile :: forall a.
Sftp
-> String
-> Int
-> [SftpFileTransferFlags]
-> (SftpHandle -> IO a)
-> IO a
withOpenSftpFile Sftp
sftp String
path Int
mode [SftpFileTransferFlags]
flags =
  forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (Sftp -> String -> Int -> [SftpFileTransferFlags] -> IO SftpHandle
sftpOpenFile Sftp
sftp String
path Int
mode [SftpFileTransferFlags]
flags) SftpHandle -> IO ()
sftpCloseHandle