Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- serve :: (DuplexStream stream, AuthAgent agent) => Config identity -> agent -> stream -> IO Disconnect
- data Config identity = Config {
- transportConfig :: TransportConfig
- userAuthConfig :: UserAuthConfig identity
- connectionConfig :: ConnectionConfig identity
- data UserAuthConfig identity = UserAuthConfig {
- onAuthRequest :: UserName -> ServiceName -> PublicKey -> IO (Maybe identity)
- userAuthMaxTime :: Word16
- userAuthMaxAttempts :: Word16
- data ConnectionConfig identity = ConnectionConfig {
- onSessionRequest :: identity -> SessionRequest -> IO (Maybe SessionHandler)
- onDirectTcpIpRequest :: identity -> DirectTcpIpRequest -> IO (Maybe DirectTcpIpHandler)
- channelMaxCount :: Word16
- channelMaxQueueSize :: Word32
- channelMaxPacketSize :: Word32
- data SessionRequest = SessionRequest
- newtype SessionHandler = SessionHandler (forall stdin stdout stderr. (InputStream stdin, OutputStream stdout, OutputStream stderr) => Environment -> Maybe TermInfo -> Maybe Command -> stdin -> stdout -> stderr -> IO ExitCode)
- newtype Environment = Environment [(ByteString, ByteString)]
- data TermInfo
- newtype Command = Command ByteString
- data DirectTcpIpRequest = DirectTcpIpRequest {}
- newtype DirectTcpIpHandler = DirectTcpIpHandler (forall stream. DuplexStream stream => stream -> IO ())
Server
serve :: (DuplexStream stream, AuthAgent agent) => Config identity -> agent -> stream -> IO Disconnect Source #
Serve a single connection represented by a DuplexStream
.
- The actual server behaviour is only determined by its configuration. The default configuration rejects all authentication and service requests, so you will need to adapt it to your use-case.
- The
AuthAgent
will be used to authenticate to the client. It is usually sufficient to use aKeyPair
as agent. - This operation does not return unless the other side either gracefully closes the connection or an error occurs (like connection loss). All expected exceptional conditions get caught and are reflected in the return value.
- If the connection needs to be terminated by the server, this can be achieved by
throwing an asynchronous exception to the executing thread. All depdendant
threads and resources will be properly freed and a disconnect message will
be delivered to the client (if possible). It is a good idea to run
serve
within anAsync
which can be canceled on demand.
Example:
runServer :: Socket -> IO () runServer sock = do keyPair <-newKeyPair
serve
conf keyPair sock where conf =def
{ userAuthConfig =def
{onAuthRequest
= handleAuthRequest } , connectionConfig =def
{onSessionRequest
= handleSessionRequest ,onDirectTcpIpRequest
= handleDirectTcpIpRequest } } handleAuthRequest ::UserName
->ServiceName
->PublicKey
-> IO (MaybeUserName
) handleAuthRequest user service pubkey = case user of "simon" -> pure (Just user) _ -> pure Nothing handleSessionRequest :: identity ->SessionRequest
-> IO (MaybeSessionHandler
) handleSessionRequest _ _ = pure $ Just $ SessionHandler $ env mterm mcmd stdin stdout stderr -> dosendAll
stdout "Hello, world!\n" pureExitSuccess
handleDirectTcpIpRequest :: identity ->DirectTcpIpRequest
-> IO (Maybe DirectTcpIpHandler) handleDirectTcpIpRequest _ req = | port (dstPort req) == 80 = pure $ Just $ DirectTcpIpHandler $ stream -> do bs <-receive
stream 4096sendAll
stream "HTTP/1.1 200 OK\n" sendAll stream "Content-Type: text/plain\n\n" sendAll stream "Hello, world!\n" sendAll stream "\n" sendAll stream bs pure () | otherwise = pure Nothing
The server configuration.
- The type variable
identity
represents the return type of the user authentication process. It may be chosen freely. The identity object will be supplied to all subsequent service handler functions and can be used as connection state.
Config | |
|
Authentication Layer
data UserAuthConfig identity Source #
Configuration for the user authentication layer.
After a successful key exchange the client will usually
request the user-auth
service to authenticate against.
In this implementation, the user-auth
service is the
only service available after key exchange and the client
must request the connection layer through the authentication
layer. Except for transport messages, all other message types
will result in a disconnect as long as user authentication
is in progress (looking at you, libssh ;-)
UserAuthConfig | |
|
Instances
Default (UserAuthConfig identity) Source # | |
Defined in Network.SSH.Server.Service.UserAuth def :: UserAuthConfig identity # |
Connection Layer
data ConnectionConfig identity Source #
ConnectionConfig | |
|
Instances
Default (ConnectionConfig identity) Source # | |
Defined in Network.SSH.Server.Service.Connection def :: ConnectionConfig identity # |
Session
Request & Handler
data SessionRequest Source #
Information associated with the session request.
Might be exteded in the future.
Instances
Eq SessionRequest Source # | |
Defined in Network.SSH.Server.Service.Connection (==) :: SessionRequest -> SessionRequest -> Bool # (/=) :: SessionRequest -> SessionRequest -> Bool # | |
Ord SessionRequest Source # | |
Defined in Network.SSH.Server.Service.Connection compare :: SessionRequest -> SessionRequest -> Ordering # (<) :: SessionRequest -> SessionRequest -> Bool # (<=) :: SessionRequest -> SessionRequest -> Bool # (>) :: SessionRequest -> SessionRequest -> Bool # (>=) :: SessionRequest -> SessionRequest -> Bool # max :: SessionRequest -> SessionRequest -> SessionRequest # min :: SessionRequest -> SessionRequest -> SessionRequest # | |
Show SessionRequest Source # | |
Defined in Network.SSH.Server.Service.Connection showsPrec :: Int -> SessionRequest -> ShowS # show :: SessionRequest -> String # showList :: [SessionRequest] -> ShowS # |
newtype SessionHandler Source #
The session handler contains the application logic that serves a client's shell or exec request.
- The
Command
parameter will be present if this is an exec request and absent for shell requests. - The
TermInfo
parameter will be present if the client requested a pty. - The
Environment
parameter contains the set of all env requests the client issued before the actual shell or exec request. stdin
,stdout
andstderr
are streams. The former can only be read from while the latter can only be written to. After the handler has gracefully terminated, the implementation assures that all bytes will be sent before sending an eof and actually closing the channel. has gracefully terminated. The client will then receive an eof and close.- A
SIGILL
exit signal will be sent if the handler terminates with an exception. Otherwise the client will receive the returned exit code.
handler :: SessionHandler handler = SessionHandler $ \env mterm mcmd stdin stdout stderr -> case mcmd of Just "echo" -> do bs <-receive
stdin 1024sendAll
stdout bs pureExitSuccess
Nothing -> pure (ExitFailure
1)
SessionHandler (forall stdin stdout stderr. (InputStream stdin, OutputStream stdout, OutputStream stderr) => Environment -> Maybe TermInfo -> Maybe Command -> stdin -> stdout -> stderr -> IO ExitCode) |
Environment
newtype Environment Source #
The Environment
is list of key-value pairs.
Environment [ ("LC_ALL", "en_US.UTF-8") ]
Instances
Eq Environment Source # | |
Defined in Network.SSH.Server.Service.Connection (==) :: Environment -> Environment -> Bool # (/=) :: Environment -> Environment -> Bool # | |
Ord Environment Source # | |
Defined in Network.SSH.Server.Service.Connection compare :: Environment -> Environment -> Ordering # (<) :: Environment -> Environment -> Bool # (<=) :: Environment -> Environment -> Bool # (>) :: Environment -> Environment -> Bool # (>=) :: Environment -> Environment -> Bool # max :: Environment -> Environment -> Environment # min :: Environment -> Environment -> Environment # | |
Show Environment Source # | |
Defined in Network.SSH.Server.Service.Connection showsPrec :: Int -> Environment -> ShowS # show :: Environment -> String # showList :: [Environment] -> ShowS # |
TermInfo
Command
The Command
is what the client wants to execute when making an exec request
(shell requests don't have a command).
Direct TCP/IP
Request & Handler
data DirectTcpIpRequest Source #
When the client makes a DirectTcpIpRequest
it requests a TCP port forwarding.
DirectTcpIpRequest | |
|
Instances
Eq DirectTcpIpRequest Source # | |
Defined in Network.SSH.Server.Service.Connection (==) :: DirectTcpIpRequest -> DirectTcpIpRequest -> Bool # (/=) :: DirectTcpIpRequest -> DirectTcpIpRequest -> Bool # | |
Ord DirectTcpIpRequest Source # | |
Defined in Network.SSH.Server.Service.Connection compare :: DirectTcpIpRequest -> DirectTcpIpRequest -> Ordering # (<) :: DirectTcpIpRequest -> DirectTcpIpRequest -> Bool # (<=) :: DirectTcpIpRequest -> DirectTcpIpRequest -> Bool # (>) :: DirectTcpIpRequest -> DirectTcpIpRequest -> Bool # (>=) :: DirectTcpIpRequest -> DirectTcpIpRequest -> Bool # max :: DirectTcpIpRequest -> DirectTcpIpRequest -> DirectTcpIpRequest # min :: DirectTcpIpRequest -> DirectTcpIpRequest -> DirectTcpIpRequest # | |
Show DirectTcpIpRequest Source # | |
Defined in Network.SSH.Server.Service.Connection showsPrec :: Int -> DirectTcpIpRequest -> ShowS # show :: DirectTcpIpRequest -> String # showList :: [DirectTcpIpRequest] -> ShowS # |
newtype DirectTcpIpHandler Source #
The DirectTcpIpHandler
contains the application logic
that handles port forwarding requests.
There is of course no need to actually do a real forwarding - this mechanism might also be used to give access to process internal services like integrated web servers etc.
- When the handler exits gracefully, the implementation assures that all bytes will be sent to the client before terminating the stream with an eof and actually closing the channel.
DirectTcpIpHandler (forall stream. DuplexStream stream => stream -> IO ()) |