module Network.SSH.Client.LibSSH2.Errors
(
ErrorCode (..),
SftpErrorCode (..),
NULL_POINTER,
IntResult (..),
getLastError,
getLastSftpError,
handleInt,
handleBool,
handleNullPtr,
int2error, error2int,
int2sftperror, sftperror2int,
blockedDirections,
threadWaitSession
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import Control.Exception
import Data.Generics
import Foreign
import Foreign.C.Types
import Network.SSH.Client.LibSSH2.Types
import Network.SSH.Client.LibSSH2.WaitSocket
data ErrorCode =
NONE
| SOCKET_NONE
| BANNER_RECV
| BANNER_SEND
| INVALID_MAC
| KEX_FALIURE
| ALLOC
| SOCKET_SEND
| KEY_EXCHANGE_FAILURE
| TIMEOUT
| HOSTKEY_INIT
| HOSTKEY_SIGN
| DECRYPT
| SOCKET_DISCONNECT
| PROTO
| PASSWORD_EXPIRED
| FILE
| METHOD_NONE
| AUTHENTICATION_FAILED
| PUBLICKEY_UNVERIFIED
| CHANNEL_OUTOFORDER
| CHANNEL_FAILURE
| CHANNEL_REQUEST_DENIED
| CHANNEL_UNKNOWN
| CHANNEL_WINDOW_EXCEEDED
| CHANNEL_PACKET_EXCEEDED
| CHANNEL_CLOSED
| CHANNEL_EOF_SENT
| SCP_PROTOCOL
| ZLIB
| SOCKET_TIMEOUT
| SFTP_PROTOCOL
| REQUEST_DENIED
| METHOD_NOT_SUPPORTED
| INVAL
| INVALID_POLL_TYPE
| PUBLICKEY_PROTOCOL
| EAGAIN
| BUFFER_TOO_SMALL
| BAD_USE
| COMPRESS
| OUT_OF_BOUNDARY
| AGENT_PROTOCOL
| SOCKET_RECV
| ENCRYPT
| BAD_SOCKET
| ERROR_KNOWN_HOSTS
deriving (Eq, Show, Ord, Enum, Data, Typeable)
instance Exception ErrorCode
error2int :: (Num i) => ErrorCode -> i
error2int = fromIntegral . negate . fromEnum
int2error :: (Integral i) => i -> ErrorCode
int2error = toEnum . negate . fromIntegral
data NULL_POINTER = NULL_POINTER
deriving (Eq, Show, Data, Typeable)
instance Exception NULL_POINTER
class IntResult a where
intResult :: a -> Int
instance IntResult Int where
intResult = id
instance IntResult (Int, a) where
intResult = fst
instance IntResult (Int, a, b) where
intResult = \(i, _, _) -> i
instance IntResult (Int, a, b, c) where
intResult = \(i, _, _, _) -> i
instance IntResult CInt where
intResult = fromIntegral
instance IntResult CLong where
intResult = fromIntegral
instance IntResult CLLong where
intResult = fromIntegral
getLastError_ :: (Session) -> (Ptr Int) -> (Int) -> IO ((Int), (String))
getLastError_ a1 a3 a4 =
let {a1' = toPointer a1} in
alloca $ \a2' ->
let {a3' = castPtr a3} in
let {a4' = fromIntegral a4} in
getLastError_'_ a1' a2' a3' a4' >>= \res ->
let {res' = fromIntegral res} in
peekCStringPtr a2'>>= \a2'' ->
return (res', a2'')
getLastError :: Session -> IO (Int, String)
getLastError s = getLastError_ s nullPtr 0
handleInt :: (IntResult a, SshCtx ctx) => Maybe ctx -> IO a -> IO a
handleInt s io = do
x <- io
let r = intResult x
if r < 0
then case int2error r of
EAGAIN -> threadWaitSession s >> handleInt s io
err ->
case s of
Nothing -> throw err
Just ctx -> throwCtxSpecificError ctx err
else return x
handleBool :: CInt -> IO Bool
handleBool x
| x == 0 = return False
| x > 0 = return True
| otherwise = throw (int2error x)
handleNullPtr :: (SshCtx c) => Maybe c -> (Ptr () -> IO a) -> IO (Ptr ()) -> IO a
handleNullPtr m_ctx fromPointer io = do
ptr <- io
if ptr == nullPtr
then case m_ctx of
Nothing -> throw NULL_POINTER
Just ctx -> do
let session = getSession ctx
(r, _) <- getLastError session
case int2error r of
EAGAIN -> threadWaitSession (Just session) >> handleNullPtr m_ctx fromPointer io
err -> throwCtxSpecificError ctx err
else fromPointer ptr
blockedDirections :: (Session) -> IO (([Direction]))
blockedDirections a1 =
let {a1' = toPointer a1} in
blockedDirections'_ a1' >>= \res ->
let {res' = int2dir res} in
return (res')
threadWaitSession :: (SshCtx ctx) => Maybe ctx -> IO ()
threadWaitSession Nothing = error "EAGAIN thrown without session present"
threadWaitSession (Just ctx) = do
let s = getSession ctx
mSocket <- sessionGetSocket s
case mSocket of
Nothing -> error "EAGAIN thrown on session without socket"
Just socket -> do
dirs <- blockedDirections s
if (OUTBOUND `elem` dirs)
then threadWaitWrite socket
else threadWaitRead socket
getLastSftpError_ :: (Sftp) -> IO ((Int))
getLastSftpError_ a1 =
let {a1' = toPointer a1} in
getLastSftpError_'_ a1' >>= \res ->
let {res' = fromIntegral res} in
return (res')
getLastSftpError :: Sftp -> IO Int
getLastSftpError sftp = getLastSftpError_ sftp
sftperror2int :: (Num i) => SftpErrorCode -> i
sftperror2int = fromIntegral . fromEnum
int2sftperror :: (Integral i) => i -> SftpErrorCode
int2sftperror = toEnum . fromIntegral
data SftpErrorCode =
FX_OK
| FX_EOF
| FX_NO_SUCH_FILE
| FX_PERMISSION_DENIED
| FX_FAILURE
| FX_BAD_MESSAGE
| FX_NO_CONNECTION
| FX_CONNECTION_LOST
| FX_OP_UNSUPPORTED
| FX_INVALID_HANDLE
| FX_NO_SUCH_PATH
| FX_FILE_ALREADY_EXISTS
| FX_WRITE_PROTECT
| FX_NO_MEDIA
| FX_NO_SPACE_ON_FILESYSTEM
| FX_QUOTA_EXCEEDED
| FX_UNKNOWN_PRINCIPAL
| FX_LOCK_CONFLICT
| FX_DIR_NOT_EMPTY
| FX_NOT_A_DIRECTORY
| FX_INVALID_FILENAME
| FX_LINK_LOOP
deriving (Eq, Show, Ord, Enum, Data, Typeable)
instance Exception SftpErrorCode
class SshCtx a where
getSession :: a -> Session
throwCtxSpecificError :: a -> ErrorCode -> IO b
instance SshCtx Session where
getSession = id
throwCtxSpecificError _ er = throw er
instance SshCtx Sftp where
getSession = sftpSession
throwCtxSpecificError ctx SFTP_PROTOCOL = do
er <- getLastSftpError ctx
throw (int2sftperror er)
throwCtxSpecificError _ er = throw er
instance SshCtx SftpHandle where
getSession = getSession . sftpHandleSession
throwCtxSpecificError ctx =
throwCtxSpecificError (sftpHandleSession ctx)
foreign import ccall safe "Network/SSH/Client/LibSSH2/Errors.chs.h libssh2_session_last_error"
getLastError_'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Errors.chs.h libssh2_session_block_directions"
blockedDirections'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))
foreign import ccall safe "Network/SSH/Client/LibSSH2/Errors.chs.h libssh2_sftp_last_error"
getLastSftpError_'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong))