From 9f85f23b0df15dc4ad890c8b4baefc8eefd3c889 Mon Sep 17 00:00:00 2001
From: Eric Mertens <emertens@gmail.com>
Date: Tue, 1 Dec 2015 10:37:06 -0800
Subject: [PATCH] Factor out logging into Client

---
 server/Main.hs                | 2 +-
 src/Network/SSH/Connection.hs | 9 +++++++--
 src/Network/SSH/State.hs      | 8 +++++++-
 3 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/server/Main.hs b/server/Main.hs
index 21fa5ed..588cabb 100644
--- a/server/Main.hs
+++ b/server/Main.hs
@@ -73,6 +73,7 @@ mkClient creds (h,_,_) = Client { .. }
   cGet   = S.hGetSome h
   cPut   = S.hPutStr  h . L.toStrict
   cClose =   hClose   h
+  cLog   = putStrLn
 
   cDirectTcp _host _port _events _writeback = return False
 
@@ -132,7 +133,6 @@ mkClient creds (h,_,_) = Client { .. }
       _ -> return (AuthFailed ["password","publickey"])
 
   cAuthHandler _session_id user _svc m =
-    do print (user,m)
        return (AuthFailed ["password","publickey"])
 
 loadServerKeys :: FilePath -> IO [ServerCredential]
diff --git a/src/Network/SSH/Connection.hs b/src/Network/SSH/Connection.hs
index 8122698..d040e85 100644
--- a/src/Network/SSH/Connection.hs
+++ b/src/Network/SSH/Connection.hs
@@ -50,6 +50,11 @@ connectionSend msg = Connection $
   do (client, state) <- ask
      liftIO (send client state msg)
 
+connectionLog :: String -> Connection ()
+connectionLog msg = Connection $
+  do (client, _) <- ask
+     liftIO (cLog client msg)
+
 connectionGetChannels :: Connection (Map Word32 SshChannel)
 connectionGetChannels = Connection (lift get)
 
@@ -113,11 +118,11 @@ connectionService =
             connectionService
 
        SshMsgDisconnect reason _desc _lang ->
-            liftIO (putStrLn ("Disconnect: " ++ show reason))
+            connectionLog ("Disconnect: " ++ show reason)
             -- TODO: tear down channels
 
        _ ->
-         do liftIO (putStrLn ("Unhandled message: " ++ show msg))
+         do connectionLog ("Unhandled message: " ++ show msg)
             connectionService
 
 
diff --git a/src/Network/SSH/State.hs b/src/Network/SSH/State.hs
index 0986192..98e7313 100644
--- a/src/Network/SSH/State.hs
+++ b/src/Network/SSH/State.hs
@@ -14,6 +14,7 @@ import           Network.SSH.Packet
 import           Network.SSH.PubKey (PrivateKey)
 import           Network.SSH.TerminalModes
 
+import           Data.Char (isControl)
 import           Data.IORef
 import           Data.Word
 import           Data.Serialize
@@ -47,6 +48,9 @@ data Client = Client
   -- | 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)] ->
                     Chan SessionEvent ->
@@ -123,7 +127,9 @@ receive client SshState { .. } = loop
        writeIORef sshRecvState (seqNum1, cipher', mac, comp)
        case msg of
          SshMsgIgnore _                      -> loop
-         SshMsgDebug display m _ | display   -> S8.putStrLn m >> loop -- XXX drop controls
+         SshMsgDebug display m _ | display   -> do cLog client (filter (not . isControl)
+                                                                       (S8.unpack m))
+                                                   loop -- XXX drop controls
                                  | otherwise -> loop
          _                                   -> return msg