<commit_before>-- |
-- State data for one client-server pair, and many related types.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BangPatterns #-}

module Network.SSH.State where


import           Network.SSH.Ciphers
import           Network.SSH.Mac
import           Network.SSH.Messages
import           Network.SSH.Named
import           Network.SSH.Packet
import           Network.SSH.PubKey (PrivateKey)
import           Network.SSH.TerminalModes

import           Control.Concurrent
import           Control.Concurrent.STM ( TChan, TVar, newTVarIO )
import           Control.Monad
import           Crypto.Random
import           Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import           Data.Char (isControl)
import           Data.IORef
import           Data.Map.Strict ( Map )
import qualified Data.Map.Strict as Map
import           Data.Serialize
import           Data.Word

debug :: SshState -> String -> IO ()
debug st s = do
  when (sshDebugLevel st > 0) $
    putStrLn $ "debug: " ++ s

-- Server Internals ------------------------------------------------------------

data AuthResult
  = AuthFailed [ShortByteString] Bool
    -- ^ The 'Bool' is for "partial success"; see RFC 4252 Section
    -- 5.1.
  | AuthAccepted
  | AuthPkOk S.ByteString SshPubCert
    -- ^ Returned by the server to indicate that a public key is
    -- supported for authentication; see @SSH_MSG_USERAUTH_PK_OK@ in
    -- RFC 4252 Section 7.
  deriving Show

-- We might want to split this into separate types for separate
-- classes of channel events.
data SessionEvent
  -- Data messages.
  = SessionData S.ByteString               -- Needs window size accounting.
  {-
  | SessionExtendedDataStdErr S.ByteString -- Needs window size accounting.
  -}

  -- Could be considered data or non-data.
  | SessionClose
  | SessionEof

  -- Non-data messages.
  --
  -- May also want request messages here, in addition to request
  -- responses.
  | SessionWinsize SshWindowSize
  | SessionRequestResponse Bool -- ^ True for "channel success"
                                --   and false for "channel failure".
  {-
  | SessionRequest {}
  -}

-- | A mix of connection state and session handlers.
--
-- The session backends here -- 'cOpenShell', 'cDirectTcp',
-- 'cRequestSubsystem', 'cRequestExec' -- are expected to return
-- immediately with a boolean indicating whether the requested
-- operation was allowed or not. So, implementers probably want to use
-- 'forkIO' to run session backends in a separate thread.
--
-- TODO(conathan): rename, e.g 'ClientState', since we are adding
-- client support. Or maybe, refactor this into client specific state
-- (if any; the 'cOpenShell' may be client only) and general "other
-- end of the connection state". From this symmetric point of view, it
-- might make sense to call the other end the client, but that could
-- be confusing since we also define client and server modules. Better
-- to call it something else ...
data Client = Client
  { cGet         :: Int -> IO S.ByteString
  -- ^ Read up to 'n' bytes from network socket

  -- | Put bytes on network socket
  , cPut         :: L.ByteString -> IO ()

  -- | Close network socket
  , cClose       :: IO ()

  -- | Log messages for events related to this client
  , cLog         :: String -> IO ()

  -- | TERM, initial window dimensions, termios flags, incoming events, write callback
  , cOpenShell   :: S.ByteString -> SshWindowSize -> [(TerminalFlag, Word32)] ->
                    IO SessionEvent ->
                    (Maybe S.ByteString -> IO ()) ->
                    IO Bool

  , cDirectTcp   :: S.ByteString -> Word32 ->
                    IO SessionEvent ->
                    (Maybe S.ByteString -> IO ()) ->
                    IO Bool

  -- | Client requested a subsystem. Return 'True' to accept.
  --
  -- The 'S.ByteString' argument is the subsystem requested.
  --
  -- The @IO SessionEvent@ argument is used to read events from the
  -- channel.
  --
  -- The @Maybe S.ByteString -> IO ()@ argument is used to write back
  -- to the channel: send @Just bs@ to send @bs@, and @Nothing@ to
  -- close the channel.
  --
  -- The subsystem mechanism allows for arbitrary "built in" commands
  -- in SSH. The only subsystem that ships with an OpenSSH SSH server
  -- is SFTP. An OpenSSH client requests the subsystem @<subsystem>@
  -- using the syntax @ssh <host> -s <subsystem>@. Strangely, the @-s@
  -- arg has to come *after* the host name.
  , cRequestSubsystem
                 :: S.ByteString ->
                    IO SessionEvent ->
                    (Maybe S.ByteString -> IO ()) ->
                    IO Bool

  -- | Client requested executing a command. Return True to accept.
  --
  -- See 'cRequestSubsystem' for explanation of arguments.
  --
  -- Exec requests are typically handled by running the requested
  -- command through the user's shell. An OpenSSH client makes an exec
  -- request for command @<command>@ using the syntax
  -- @ssh <host> <command>@.
  , cRequestExec :: S.ByteString ->
                    IO SessionEvent ->
                    (Maybe S.ByteString -> IO ()) ->
                    IO Bool

  -- | ByteString argument is user name
  , cAuthHandler :: SshSessionId  ->
                    S.ByteString  ->
                    SshService    ->
                    SshAuthMethod ->
                    IO AuthResult
  }

-- | Default them state.
--
-- The fields defined with 'error' always need to be overridden. The
-- other fields are unused when we're a client. When we're a server,
-- the other fields are used, but default to rejecting all requests,
-- including authentication.
defaultClient :: Client
defaultClient = Client
  { cGet   = error "cGet undefined!"
  , cPut   = error "cPut undefined!"
  , cClose = error "cClose undefined!"
  , cLog   = error "cLog undefined!"<commit_msg>Name the auth-handler and request-subsystem types.<commit_after>-- |
-- State data for one client-server pair, and many related types.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BangPatterns #-}

module Network.SSH.State where


import           Network.SSH.Ciphers
import           Network.SSH.Mac
import           Network.SSH.Messages
import           Network.SSH.Named
import           Network.SSH.Packet
import           Network.SSH.PubKey (PrivateKey)
import           Network.SSH.TerminalModes

import           Control.Concurrent
import           Control.Concurrent.STM ( TChan, TVar, newTVarIO )
import           Control.Monad
import           Crypto.Random
import           Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import           Data.Char (isControl)
import           Data.IORef
import           Data.Map.Strict ( Map )
import qualified Data.Map.Strict as Map
import           Data.Serialize
import           Data.Word

debug :: SshState -> String -> IO ()
debug st s = do
  when (sshDebugLevel st > 0) $
    putStrLn $ "debug: " ++ s

-- Server Internals ------------------------------------------------------------

data AuthResult
  = AuthFailed [ShortByteString] Bool
    -- ^ The 'Bool' is for "partial success"; see RFC 4252 Section
    -- 5.1.
  | AuthAccepted
  | AuthPkOk S.ByteString SshPubCert
    -- ^ Returned by the server to indicate that a public key is
    -- supported for authentication; see @SSH_MSG_USERAUTH_PK_OK@ in
    -- RFC 4252 Section 7.
  deriving Show

-- We might want to split this into separate types for separate
-- classes of channel events.
data SessionEvent
  -- Data messages.
  = SessionData S.ByteString               -- Needs window size accounting.
  {-
  | SessionExtendedDataStdErr S.ByteString -- Needs window size accounting.
  -}

  -- Could be considered data or non-data.
  | SessionClose
  | SessionEof

  -- Non-data messages.
  --
  -- May also want request messages here, in addition to request
  -- responses.
  | SessionWinsize SshWindowSize
  | SessionRequestResponse Bool -- ^ True for "channel success"
                                --   and false for "channel failure".
  {-
  | SessionRequest {}
  -}

type CAuthHandler =
     SshSessionId ->
     S.ByteString ->
     SshService ->
     SshAuthMethod ->
     IO AuthResult

type CRequestSubsystem =
     S.ByteString ->
     IO SessionEvent ->
     (Maybe S.ByteString -> IO ()) ->
     IO Bool

-- | A mix of connection state and session handlers.
--
-- The session backends here -- 'cOpenShell', 'cDirectTcp',
-- 'cRequestSubsystem', 'cRequestExec' -- are expected to return
-- immediately with a boolean indicating whether the requested
-- operation was allowed or not. So, implementers probably want to use
-- 'forkIO' to run session backends in a separate thread.
--
-- TODO(conathan): rename, e.g 'ClientState', since we are adding
-- client support. Or maybe, refactor this into client specific state
-- (if any; the 'cOpenShell' may be client only) and general "other
-- end of the connection state". From this symmetric point of view, it
-- might make sense to call the other end the client, but that could
-- be confusing since we also define client and server modules. Better
-- to call it something else ...
data Client = Client
  { cGet         :: Int -> IO S.ByteString
  -- ^ Read up to 'n' bytes from network socket

  -- | Put bytes on network socket
  , cPut         :: L.ByteString -> IO ()

  -- | Close network socket
  , cClose       :: IO ()

  -- | Log messages for events related to this client
  , cLog         :: String -> IO ()

  -- | TERM, initial window dimensions, termios flags, incoming events, write callback
  , cOpenShell   :: S.ByteString -> SshWindowSize -> [(TerminalFlag, Word32)] ->
                    IO SessionEvent ->
                    (Maybe S.ByteString -> IO ()) ->
                    IO Bool

  , cDirectTcp   :: S.ByteString -> Word32 ->
                    IO SessionEvent ->
                    (Maybe S.ByteString -> IO ()) ->
                    IO Bool

  -- | Client requested a subsystem. Return 'True' to accept.
  --
  -- The 'S.ByteString' argument is the subsystem requested.
  --
  -- The @IO SessionEvent@ argument is used to read events from the
  -- channel.
  --
  -- The @Maybe S.ByteString -> IO ()@ argument is used to write back
  -- to the channel: send @Just bs@ to send @bs@, and @Nothing@ to
  -- close the channel.
  --
  -- The subsystem mechanism allows for arbitrary "built in" commands
  -- in SSH. The only subsystem that ships with an OpenSSH SSH server
  -- is SFTP. An OpenSSH client requests the subsystem @<subsystem>@
  -- using the syntax @ssh <host> -s <subsystem>@. Strangely, the @-s@
  -- arg has to come *after* the host name.
  , cRequestSubsystem :: CRequestSubsystem

  -- | Client requested executing a command. Return True to accept.
  --
  -- See 'cRequestSubsystem' for explanation of arguments.
  --
  -- Exec requests are typically handled by running the requested
  -- command through the user's shell. An OpenSSH client makes an exec
  -- request for command @<command>@ using the syntax
  -- @ssh <host> <command>@.
  , cRequestExec :: S.ByteString ->
                    IO SessionEvent ->
                    (Maybe S.ByteString -> IO ()) ->
                    IO Bool

  -- | ByteString argument is user name
  , cAuthHandler :: CAuthHandler
  }

-- | Default them state.
--
-- The fields defined with 'error' always need to be overridden. The
-- other fields are unused when we're a client. When we're a server,
-- the other fields are used, but default to rejecting all requests,
-- including authentication.
defaultClient :: Client
defaultClient = Client
  { cGet   = error "cGet undefined!"
  , cPut   = error "cPut undefined!"
  , cClose = error "cClose undefined!"
  , cLog   = error "cLog undefined!"
{'fraction_non_alphanumeric': 0.10525877849891829, 'fraction_numerical': 0.0029955067398901645, 'mean_word_length': 2.184684684684685, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 75, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3677835', 'n_tokens_mistral': 3377, 'n_tokens_neox': 3243, 'n_words': 1270}