[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit e016f8656aa9fe80acf11f10905987d224c2823e
Author: John Goerzen <jgoerzen at complete.org>
Date:   Sat Dec 18 05:48:30 2004 +0100

    Checkpointing
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-84)

diff --git a/ChangeLog b/ChangeLog
index 947fd14..567ab2f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,19 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-17 22:48:30 GMT	John Goerzen <jgoerzen at complete.org>	patch-84
+
+    Summary:
+      Checkpointing
+    Revision:
+      missingh--head--0.7--patch-84
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/Network.hs
+     libsrc/MissingH/Network/SocketServer.hs
+
+
 2004-12-17 22:03:09 GMT	John Goerzen <jgoerzen at complete.org>	patch-83
 
     Summary:
diff --git a/libsrc/MissingH/Network.hs b/libsrc/MissingH/Network.hs
index 556cf01..23f478a 100644
--- a/libsrc/MissingH/Network.hs
+++ b/libsrc/MissingH/Network.hs
@@ -85,4 +85,4 @@ showSockAddr :: SockAddr -> IO String
 showSockAddr (SockAddrUnix x) = return $ "UNIX socket at " ++ x
 showSockAddr (SockAddrInet port host) =
     do h <- inet_ntoa host
-       return $ "Host " ++ h ++ ", port " ++ (show port)
+       return $ "IPv4 host " ++ h ++ ", port " ++ (show port)
diff --git a/libsrc/MissingH/Network/SocketServer.hs b/libsrc/MissingH/Network/SocketServer.hs
index 8b26987..47b1a3b 100644
--- a/libsrc/MissingH/Network/SocketServer.hs
+++ b/libsrc/MissingH/Network/SocketServer.hs
@@ -77,6 +77,9 @@ serveTCPforever :: InetServerOptions     -- ^ Server options
 serveTCPforever options func =
     do proto <- getProtocolNumber "tcp"
        s <- socket (family options) Stream proto
+       setSocketOption s ReuseAddr (case (reuse options) of
+                                    True -> 1
+                                    False -> 0)
        bindSocket s (SockAddrInet (fromIntegral (portNumber options)) 
                      (interface options))
        listen s (listenQueueSize options)
@@ -88,8 +91,12 @@ serveTCPforever options func =
 -- Combinators
 ----------------------------------------------------------------------
 
--- | Log each incoming connection using the interface in
--- "MissingH.Logging.Logger".
+{- | Log each incoming connection using the interface in
+"MissingH.Logging.Logger".
+
+Log when the incoming connection disconnects.
+
+Also, log any failures that may occur in the child handler. -}
 
 loggingHandler :: String                -- ^ Name of logger to use
                -> MissingH.Logging.Logger.Priority -- ^ Priority of logged messages
@@ -99,7 +106,11 @@ loggingHandler hname prio nexth socket sockaddr =
     do sockStr <- showSockAddr sockaddr
        MissingH.Logging.Logger.logM hname prio 
                    ("Received connection from " ++ sockStr)
-       nexth socket sockaddr
+       MissingH.Logging.Logger.traplogging hname 
+               MissingH.Logging.Logger.WARNING "" (nexth socket sockaddr)
+       MissingH.Logging.Logger.logM hname prio
+                   ("Connection " ++ sockStr ++ " disconnected")
+       
 
 -- | Handle each incoming connection in its own thread to
 -- make the server multi-tasking.
@@ -109,8 +120,15 @@ threadedHandler nexth socket sockaddr =
     do forkIO (nexth socket sockaddr)
        return ()
 
--- | Give your handler function a Handle instead of a Socket and SockAddr.
+{- | Give your handler function a Handle instead of a Socket and SockAddr.
+
+The Handle will be opened with ReadWriteMode (you use one handle for both
+directions of the Socket).  Also, it will be initialized with LineBuffering.
+-}
 handleHandler :: (Handle -> IO ())      -- ^ Handler to call
               -> HandlerT
 handleHandler func socket _ = 
-    socketToHandle socket ReadWriteMode >>= func
+    do h <- socketToHandle socket ReadWriteMode
+       hSetBuffering h LineBuffering
+       func h
+

-- 
haskell-testpack