{- |
Module : ./Static/AnalysisStructured.hs
Description : A test module for trying API communication via sockets.
The code is based on the TCP syslog server example in Real
World Haskell.
Copyright : (c) Till Mossakowski and Uni Bremen 2003-2006
License : GPLv2 or higher, see LICENSE.txt
Maintainer : mchan@inf.ed.ac.uk
Stability : provisional
Portability : non-portable (imports Logic.Grothendieck)
A test module for trying API communication via sockets. Use 'telnet <ip> <port>' to connect.
-}
import Data.Bits
import Network.Socket
import Network.BSD
import Data.List
import Control.Concurrent
import Control.Concurrent.MVar
import System.IO
import SyslogTypes
import Data.Maybe
type HandlerFunc = Maybe Handle -> SockAddr -> String -> IO ()
serveLog :: String -- ^ Port number or name; 514 is default
-> HandlerFunc -- ^ Function to handle incoming messages
-> IO ()
serveLog port handlerfunc = withSocketsDo $
do {- Look up the port. Either raises an exception or returns
a nonempty list. -}
addrinfos <- getAddrInfo
(Just (defaultHints {addrFlags = [AI_PASSIVE]}))
Nothing (Just port)
let serveraddr = head addrinfos
-- Create a socket
sock <- socket (addrFamily serveraddr) Stream defaultProtocol
-- Bind it to the address we're listening to
bindSocket sock (addrAddress serveraddr)
{- Start listening for connection requests. Maximum queue size
of 5 connection requests waiting to be accepted. -}
listen sock 5
-- Create a lock to use for synchronizing access to the handler
lock <- newMVar ()
-- Loop forever waiting for connections. Ctrl-C to abort.
procRequests lock sock
where
-- | Process incoming connection requests
procRequests :: MVar () -> Socket -> IO ()
procRequests lock mastersock =
do (connsock, clientaddr) <- accept mastersock
handle lock Nothing clientaddr
"syslogtcpserver.hs: client connnected"
forkIO $ procMessages lock connsock clientaddr
procRequests lock mastersock
-- | Process incoming messages
procMessages :: MVar () -> Socket -> SockAddr -> IO ()
procMessages lock connsock clientaddr =
do connhdl <- socketToHandle connsock ReadWriteMode
hSetBuffering connhdl LineBuffering
messages <- hGetContents connhdl
mapM_ (handle lock (Just connhdl) clientaddr) (lines messages)
hClose connhdl
handle lock (Just connhdl) clientaddr
"syslogtcpserver.hs: client disconnected"
-- Lock the handler before passing data to it.
handle :: MVar () -> HandlerFunc
{- This type is the same as
handle :: MVar () -> Handle -> SockAddr -> String -> IO () -}
handle lock h clientaddr msg =
withMVar lock
(\ a -> handlerfunc h clientaddr msg >> return a)
syslog :: Maybe Handle -> Facility -> Priority -> String -> IO ()
syslog syslogh fac pri msg = case syslogh of
Just h -> do hPutStrLn h sendmsg
-- Make sure that we send data immediately
hFlush h
where
sendmsg = msg
_ -> return ()
-- A simple handler that prints incoming packets
plainHandler :: HandlerFunc
plainHandler h addr msg = do
putStrLn $ "From " ++ show addr ++ ": " ++ msg
syslog h USER INFO $ "Message received: " ++ msg