hssh-0.1.0.0: SSH protocol implementation

Safe HaskellNone
LanguageHaskell2010

Network.SSH.Server

Contents

Synopsis

Server

serve :: (DuplexStream stream, AuthAgent agent) => Config identity -> agent -> stream -> IO Disconnect Source #

Serve a single connection represented by a DuplexStream.

  1. 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.
  2. The AuthAgent will be used to authenticate to the client. It is usually sufficient to use a KeyPair as agent.
  3. 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.
  4. 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 an Async 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 (Maybe UserName)
handleAuthRequest user service pubkey = case user of
  "simon" -> pure (Just user)
  _       -> pure Nothing

handleSessionRequest :: identity -> SessionRequest -> IO (Maybe SessionHandler)
handleSessionRequest _ _ = pure $ Just $ SessionHandler $ env mterm mcmd stdin stdout stderr -> do
    sendAll stdout "Hello, world!\n"
    pure ExitSuccess

handleDirectTcpIpRequest :: identity -> DirectTcpIpRequest -> IO (Maybe DirectTcpIpHandler)
handleDirectTcpIpRequest _ req =
    | port (dstPort req) == 80 = pure $ Just $ DirectTcpIpHandler $ stream -> do
          bs <- receive stream 4096
          sendAll 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

data Config identity Source #

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.
Instances
Default (Config identity) Source # 
Instance details

Defined in Network.SSH.Server

Methods

def :: Config identity #

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 ;-)

Constructors

UserAuthConfig 

Fields

  • onAuthRequest :: UserName -> ServiceName -> PublicKey -> IO (Maybe identity)

    This handler will be called for each authentication attempt.

    1. The client might try several methods and keys: Just return Nothing for every request that is not sufficient to determine the user's identity.
    2. When access shall be granted, return Just. The identity may contain whatever is desired; it may be just the UserName.
    3. When the client uses public key authentication, the transport layer has already determined that the client is in posession of the corresponding private key (by requesting and validating a signature).
    4. The default rejects all authentication attempts unconditionally.
  • userAuthMaxTime :: Word16

    Timeout for user authentication in seconds (default is 60).

    1. A SSH_DISCONNECT_BY_APPLICATION will be sent to the client when the timeout occurs before successful authentication.
  • userAuthMaxAttempts :: Word16

    A limit for the number of failed attempts per connection (default is 20).

    1. A SSH_DISCONNECT_BY_APPLICATION will be sent to the client when limit has been exceeded.
Instances
Default (UserAuthConfig identity) Source # 
Instance details

Defined in Network.SSH.Server.Service.UserAuth

Methods

def :: UserAuthConfig identity #

Connection Layer

data ConnectionConfig identity Source #

Constructors

ConnectionConfig 

Fields

Instances
Default (ConnectionConfig identity) Source # 
Instance details

Defined in Network.SSH.Server.Service.Connection

Methods

def :: ConnectionConfig identity #

Session

Request & Handler

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 and stderr 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 1024
        sendAll stdout bs
        pure ExitSuccess
    Nothing ->
        pure (ExitFailure 1)

Constructors

SessionHandler (forall stdin stdout stderr. (InputStream stdin, OutputStream stdout, OutputStream stderr) => Environment -> Maybe TermInfo -> Maybe Command -> stdin -> stdout -> stderr -> IO ExitCode) 

Environment

TermInfo

data TermInfo Source #

The TermInfo describes the client's terminal settings if it requested a pty.

NOTE: This will follow in a future release. You may access the constructor through the Internal module, but should not rely on it yet.

Command

newtype Command Source #

The Command is what the client wants to execute when making an exec request (shell requests don't have a command).

Constructors

Command ByteString 

Direct TCP/IP

Request & Handler

data DirectTcpIpRequest Source #

When the client makes a DirectTcpIpRequest it requests a TCP port forwarding.

Constructors

DirectTcpIpRequest 

Fields

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.

Constructors

DirectTcpIpHandler (forall stream. DuplexStream stream => stream -> IO ())