diff options
author | Julien Dessaux | 2011-08-08 11:39:41 +0200 |
---|---|---|
committer | Julien Dessaux | 2011-08-08 11:39:41 +0200 |
commit | 1c8cab09cb00abc3e3a0ee2e4a2d7bd6cf703d2f (patch) | |
tree | 0e580504f8cd421bf8619cf59c9dd46997a4b7b2 /Hsbot/Utils.hs | |
parent | Updated TODO list (diff) | |
download | hsbot-1c8cab09cb00abc3e3a0ee2e4a2d7bd6cf703d2f.tar.gz hsbot-1c8cab09cb00abc3e3a0ee2e4a2d7bd6cf703d2f.tar.bz2 hsbot-1c8cab09cb00abc3e3a0ee2e4a2d7bd6cf703d2f.zip |
Added access controls to hsbot.
Diffstat (limited to '')
-rw-r--r-- | Hsbot/Utils.hs | 19 |
1 files changed, 17 insertions, 2 deletions
diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs index e56e9f7..912e746 100644 --- a/Hsbot/Utils.hs +++ b/Hsbot/Utils.hs @@ -1,6 +1,7 @@ module Hsbot.Utils ( addThreadIdToQuitMVar , delThreadIdFromQuitMVar + , hasAccess , initTLSEnv , sendStr , setGlobalQuitMVar @@ -8,8 +9,10 @@ module Hsbot.Utils import Control.Concurrent import Control.Monad.Reader +import Control.Monad.State import qualified Data.ByteString.Lazy.UTF8 as L -import Data.List +import qualified Data.List as L +import qualified Network.IRC as IRC import Network.TLS import System.IO @@ -24,13 +27,25 @@ addThreadIdToQuitMVar thrId = do delThreadIdFromQuitMVar :: ThreadId -> Env IO () delThreadIdFromQuitMVar thrId = do threadIdsMv <- asks envThreadIdsMv - liftIO $ modifyMVar_ threadIdsMv (return . delete thrId) + liftIO $ modifyMVar_ threadIdsMv (return . L.delete thrId) setGlobalQuitMVar :: BotStatus -> Env IO () setGlobalQuitMVar status = do quitMv <- asks envQuitMv liftIO $ putMVar quitMv status +-- Access rights +hasAccess :: Maybe IRC.Prefix -> AccessRight -> Env IO (Bool) +hasAccess Nothing _ = return False +hasAccess (Just mask) right = do + botMVar <- asks envBotState + liftIO (readMVar botMVar) >>= evalStateT (gets botAccess >>= return . or . map accessMatch) + where + accessMatch :: AccessList -> Bool + accessMatch (AccessList amask arights) + | mask == amask = or [L.elem Admin arights, L.elem right arights] + | otherwise = False + -- Helpers sendStr :: Handle -> Maybe TLSCtx -> String -> IO () sendStr _ (Just ctx) msg = sendData ctx . L.fromString $ msg ++ "\r\n" |