content: {- |
  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
  