Permalink
Browse files

Use lazy Bytestrings in ConnectionIO so we have efficient append.

This is needed to efficiently implement getLine on top of the
chunk-based socket.  Possibly network-bytestring should implement
this, so we don't have two levels of buffer management.
  • Loading branch information...
1 parent cf3ff31 commit 116dc71f70a6dbd916b0e37e0f511d26a4641c98 @nominolo nominolo committed May 26, 2009
View
@@ -46,7 +46,7 @@ $(DIST_LIB)/.installed_tag: $(DIST_LIB)/build/libHSscion-0.1.a $(SETUP)
@cd lib && ../$(SETUP) install --user --builddir=../$(DIST_LIB)
@touch $@
-$(DIST_SERVER)/build/scion_server/scion_server: $(SETUP) $(DIST_SERVER)/setup-config server/Main.hs server/Scion/Server/**/*.hs
+$(DIST_SERVER)/build/scion_server/scion_server: $(SETUP) $(DIST_SERVER)/setup-config server/Main.hs server/Scion/Server/*.hs server/Scion/Server/**/*.hs
@echo === Building scion-server ===
@cd server && \
../$(SETUP) build --builddir=../$(DIST_SERVER)
View
@@ -28,7 +28,7 @@ import System.IO (stdin, stdout, hSetBuffering, BufferMode(..))
import qualified System.Log.Logger as HL
import qualified System.Log.Handler.Simple as HL
import qualified System.Log.Handler.Syslog as HL
-import qualified Data.ByteString.Char8 as S
+import qualified Data.ByteString.Lazy.Char8 as S
import Network ( listenOn, PortID(..) )
import Network.Socket hiding (send, sendTo, recv, recvFrom)
import Network.Socket.ByteString
@@ -104,7 +104,8 @@ serve (TCPIP nr) = do
sock <- liftIO $ listenOn (PortNumber nr)
forever $ E.handle (\(e::E.IOException) -> logInfo ("caught :" ++ (show e) ++ "\n\nwaiting for next client")) $ do
(sock', _addr) <- liftIO $ accept sock
- handleClient sock'
+ sock_conn <- CIO.mkSocketConnection sock'
+ handleClient sock_conn
serve StdInOut = do
hSetBuffering stdout LineBuffering
hSetBuffering stdin LineBuffering
@@ -116,7 +117,8 @@ serve (Socketfile file) = do
-- no multithreading for now (I don't know yet when it may be used.. the
-- ghc library is using some IO refs)
(sock', _addr) <- liftIO $ accept sock
- handleClient sock'
+ sock_conn <- CIO.mkSocketConnection sock'
+ handleClient sock_conn
#endif
@@ -7,63 +7,104 @@
-- Stability : experimental
-- Portability : portable
--
--- abstraction over Socket and Handle IO
+-- Abstraction over Socket and Handle IO.
module Scion.Server.ConnectionIO (
- ConnectionIO(..)
-)where
+ ConnectionIO(..), mkSocketConnection
+) where
+
import Control.Exception (throw, IOException, Exception)
-- import System.IO.Error (mkIOError, IOErrorType(..) )
import Prelude hiding (log)
import System.IO (Handle, hClose, hPutStr, hPutStrLn, hFlush)
import Control.Monad (when)
import Network.Socket (Socket, sClose)
import Network.Socket.ByteString (recv, send)
+import Data.IORef
import qualified System.Log.Logger as HL
import qualified Data.ByteString.Char8 as S
+import qualified Data.ByteString.Lazy.Char8 as L
-log = HL.logM "__FILE__"
+log = HL.logM "io.connection"
logError = log HL.ERROR
logWarning = log HL.WARNING
class ConnectionIO con where
- getLine :: con -> IO S.ByteString
- getN :: con -> Int -> IO S.ByteString
- put :: con -> S.ByteString -> IO ()
- putLine :: con -> S.ByteString -> IO ()
- putLine c s = put c s >> put c (S.singleton '\n')
+ getLine :: con -> IO L.ByteString
+ getN :: con -> Int -> IO L.ByteString
+ put :: con -> L.ByteString -> IO ()
+ putLine :: con -> L.ByteString -> IO ()
+ putLine c s = put c s >> put c (L.singleton '\n')
-- (stdin,stdout) implemenation
instance ConnectionIO (Handle, Handle) where
- getLine (i, _) = S.hGetLine i
- getN (i,_) = S.hGet i
- put (_,o) = S.hPutStr o
+ getLine (i, _) = do l <- S.hGetLine i; return (L.fromChunks [l])
+ getN (i,_) = L.hGet i
+ put (_,o) = L.hPut o
putLine (_,o) = \l -> do
- -- ghc doesn't use the ghc api to print texts all the time. So mark scion replies by a leading "scion:"
- -- see README.markdown
- hPutStr o "scion:"
- S.hPutStrLn o l
+ -- ghc doesn't use the ghc api to print texts all the time. So mark
+ -- scion replies by a leading "scion:" see README.markdown
+ S.hPutStr o scionPrefix
+ L.hPut o l
+ S.hPutStr o newline
hFlush o -- don't ask me why this is needed. LineBuffering is set as well (!)
+scionPrefix :: S.ByteString
+scionPrefix = S.pack "scion:"
+
+newline :: S.ByteString
+newline = S.pack "\n"
+
+data SocketConnection = SockConn Socket (IORef S.ByteString)
+
+mkSocketConnection :: Socket -> IO SocketConnection
+mkSocketConnection sock =
+ do r <- newIORef S.empty; return $ SockConn sock r
+
-- Socket.ByteString implemenation
-instance ConnectionIO Socket where
- getLine con =
- -- not optimized. Does this matter, do we receive huge data chunks? (TODO)
- let nl = (S.pack "\n")
- gl got = do
- c <- getN con 1
- if c == nl then return got
- else gl $ S.concat [got, c] -- bad performance, memcpy !
- in do b <- gl S.empty
- when (S.length b > 1024) $
- logWarning "received chunk bigger than 1k. Check performance of implementation"
- return b
- getN con len = recv con len
- put con str = do
- let l = S.length str
- sent <- send con str
- when (sent /= l) $ do
- logError $ (show l) ++ " bytes to be sent but could only sent : " ++ (show sent)
+instance ConnectionIO SocketConnection where
+ -- TODO: Handle client side closing of connection.
+ getLine (SockConn sock r) = do
+ buf <- readIORef r
+ (line_chunks, buf') <- go buf
+ writeIORef r buf'
+ return (L.fromChunks line_chunks)
+ where
+ go buf | S.null buf = do
+ chunk <- recv sock 1024
+ if S.null chunk
+ then return ([], S.empty)
+ else go chunk
+ go buf =
+ let (before, rest) = S.breakSubstring newline buf in
+ case () of
+ _ | S.null rest -> do
+ -- no newline found
+ (cs', buf') <- go rest
+ return (before:cs', buf')
+ _ | otherwise ->
+ return ([before], S.drop (S.length newline) rest)
+
+ getN (SockConn sock r) len = do
+ buf <- readIORef r
+ if S.length buf > len
+ then do let (str, buf') = S.splitAt len buf
+ writeIORef r buf'
+ return (L.fromChunks [str])
+ else do
+ str <- recv sock (len - S.length buf)
+ writeIORef r S.empty
+ return (L.fromChunks [buf, str])
+
+ put (SockConn sock _) lstr = do
+ go (L.toChunks lstr)
-- is there a better excption which should be thrown instead? (TODO)
-- throw $ mkIOError ResourceBusy ("put in " ++ __FILE__) Nothing Nothing
+ where go [] = return ()
+ go (str:strs) = do
+ let l = S.length str
+ sent <- send sock str
+ if (sent /= l) then do
+ logError $ (show l) ++ " bytes to be sent but could only sent : " ++ (show sent)
+ else go strs
@@ -35,7 +35,7 @@ import qualified Control.Exception as E
import Prelude hiding (log)
import qualified System.Log.Logger as HL
-import qualified Data.ByteString.Char8 as S
+import qualified Data.ByteString.Lazy.Char8 as S
import qualified Data.Map as M
import Data.Maybe (isJust, Maybe(..))
import Data.List (intercalate, nub, isPrefixOf)
@@ -140,7 +140,7 @@ def connectscion():
b.append( "Do so by adding one of the following lines to your .vimrc:")
b.append( "TCP/IP, socket, stdio")
b.append( "py scionConnectionSetting = ('socket', \"socket file location\") # socket connection")
- b.append( "py scionConnectionSetting = ('socket', (127.0.0.1', 4005)) # host, port TCIP/IP connection")
+ b.append( "py scionConnectionSetting = ('socket', ('localhost', 4005)) # host, port TCIP/IP connection")
b.append( "py scionConnectionSetting = ('scion', \"scion_server location\") # stdio connection ")
told_user_about_missing_configuration = 1

0 comments on commit 116dc71

Please sign in to comment.