From 4ec9cc5e6e1c71184c0537fb2fbd4387f27b3ac2 Mon Sep 17 00:00:00 2001
From: James Crayne <jim.crayne@gmail.com>
Date: Thu, 28 Apr 2016 17:25:01 -0400
Subject: remove kikid, moved to separate repo

---
 kikid.hs | 112 ---------------------------------------------------------------
 1 file changed, 112 deletions(-)
 delete mode 100644 kikid.hs

(limited to 'kikid.hs')

diff --git a/kikid.hs b/kikid.hs
deleted file mode 100644
index 059a5df..0000000
--- a/kikid.hs
+++ /dev/null
@@ -1,112 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DoAndIfThenElse #-}
-
-import System.Posix.Daemonize
-import Control.Concurrent
-import System.Posix.Syslog
-import System.Posix.Signals
-import System.Posix.User (getEffectiveUserID)
-
-import Control.Concurrent.STM
-import Control.Concurrent.STM.TBMQueue
-import Control.Concurrent.Async
-import Control.Monad
-import Control.Monad.Loops
-import Control.Exception
-import Data.Monoid
-import qualified Data.ByteString.Char8 as B
---import Data.Serialize
-import qualified Data.Map as M
-import qualified Data.Bytes.Serial as Bytes
-import qualified Data.Bytes.Get as Bytes
-import qualified Data.Bytes.Put as Bytes
-
-import KikiD.PortServer
-import KikiD.Multiplex
-import KikiD.Message
-import KikiD.ClientState
-
--- TODO: Set this in config file
-port = 9800
-max_conns = 100
-qsize = 20
-qdelay = 5*10^5
-
-doNothing = return ()
-
-main = do
-    me <- getEffectiveUserID
-    if me == 0 then     
-     serviced simpleDaemon { privilegedAction = startupAsRoot
-                           , program = kikidMain
-                           , user = Just "root", group = Just "root" }
-     else putStrLn "Kiki Daemon must be run as root."
-
-startupAsRoot = syslog Notice "kikid Started."
-
-kikidMain _ = do
-    refreshFlag <- atomically $ newTVar True
-    whileM_ (atomically $ readTVar refreshFlag) $ do
-        incomming <- newTBMQueueIO qsize :: IO (TBMQueue KikiDMessage)
-        newchans <- newTBMQueueIO qsize :: IO (TBMQueue (ThreadId, TBMQueue KikiDMessage))
-        currentClients <- atomically $ newTVar (M.empty) :: IO (TVar (M.Map clientID ClientState))
-        let timeToQuit = atomically . isClosedTBMQueue $ newchans
-        installHandler sigTERM (Catch (do syslog Notice ("Caught sigTERM: Shutting down.")
-                                          atomically $ writeTVar refreshFlag False
-                                          atomically $ closeTBMQueue newchans
-                                          atomically $ closeTBMQueue incomming)) (Just fullSignalSet)
-        installHandler sigHUP (Catch (do  syslog Notice ("Caught sigHUP: Refreshing..")
-                                          atomically $ closeTBMQueue newchans
-                                          atomically $ closeTBMQueue incomming)) (Just fullSignalSet)
-        (_,ex) <- join . fmap waitAnyCatch $ mapM async 
-                        [ createTCPPortListener port "KikiD" qdelay qsize max_conns newchans incomming handleMessage
-                        , addOpenConnections newchans currentClients
-                        , consumeQueueMicroseconds incomming (qdelay `div` 2) (consumeMessage currentClients)
-                        , purgeClosedConnections timeToQuit currentClients
-                        ]
-        case (ex::Either SomeException ()) of
-            Left e -> syslog Notice ("Exception: " <> show e)
-            Right _ -> doNothing
-
-        atomically $ closeTBMQueue newchans
-        atomically $ closeTBMQueue incomming
-
-addOpenConnections newchans currentClients = whileM_ (atomically . fmap not $ isClosedTBMQueue newchans) $ do
-    cliMap <- atomically $ readTVar currentClients :: IO (M.Map ClientID ClientState)
-    whileM_ (atomically . fmap not $ isEmptyTBMQueue newchans) $ do
-        x <- atomically $ readTBMQueue newchans
-        case x of
-            Just (newClientThread,clientQ) -> do -- Is clientQ input or output?
-                syslog Notice ("New connection, thread= " <> show newClientThread <> ", TODO: authenticate?")
-                atomically $ modifyTVar currentClients (M.insert (threadIdToClient newClientThread) (CState clientQ))
-            Nothing -> doNothing
-    threadDelay qdelay
-
-purgeClosedConnections quit currentClients = whileM_ (fmap not quit) $ do
-    map <- atomically $ readTVar currentClients
-    let k = M.keys map
-        e = M.elems map
-    closedClients <- mapM (\(CState q) -> atomically $ isClosedTBMQueue q) e
-    let f False a b = [(a,b)] -- still open
-        f True _ _  = []       -- closed
-        closing = filter fst (zip closedClients k)
-    if (not . null $ closing)
-        then syslog Notice ("Closing connections: " ++ show closing)
-        else doNothing
-    atomically . writeTVar currentClients . M.fromList . concat $ zipWith3 f closedClients k e
-    threadDelay qdelay
-
-handleMessage hdl outq = do 
-    line <- B.hGetLine hdl
-    tid <- myThreadId
-    case (Bytes.runGetS Bytes.deserialize line :: Either String KikiDMessage) of
-        Right msg -> do
-            syslog Notice ("Message decoded on thread=" <> show tid)
-            syslog Notice ("Message: " <> show msg)
-        Left str -> do
-            syslog Notice ("ERROR: " <> show line)
-            syslog Notice ("ERROR: Unable to decode message on thread=" <> show tid)
-            syslog Notice ("ERROR: " ++ str)
-
-consumeMessage currentClients msg = void $ syslog Notice ("Recieved Message: " ++ show msg)
--- TODO: Do more here...
-- 
cgit v1.2.3