Merge branch 'eric' of ssh://localhost:2222/srv/git/ssh-hans into eric

glguy · Dec 2, 2015 · 8b0516b · 8b0516b
2 parents 26cc0e4 + 9f85f23
commit 8b0516b
Show file tree

Hide file tree

Showing 3 changed files with 15 additions and 4 deletions.
diff --git 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
@@ -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
@@ -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