read config

This commit is contained in:
Jon Doe 2020-09-27 20:43:01 +02:00 committed by Maciej Bonin
parent 9fa180ff6f
commit b2cfed3a39
5 changed files with 33 additions and 14 deletions

1
.gitignore vendored
View File

@ -55,3 +55,4 @@ Thumbs.db
dist-newstyle dist-newstyle
*.o *.o
*.hi *.hi
*.conf

View File

@ -36,7 +36,8 @@ library
network-conduit-tls >= 1.3.2, network-conduit-tls >= 1.3.2,
tls >= 1.5.4, tls >= 1.5.4,
x509-validation >= 1.6.11, x509-validation >= 1.6.11,
bytestring bytestring,
ini
extra-libraries: tcl8.6 extra-libraries: tcl8.6
Includes: /usr/include/tcl.h, Includes: /usr/include/tcl.h,
@ -68,7 +69,8 @@ executable GypsFulvus
network-conduit-tls >= 1.3.2, network-conduit-tls >= 1.3.2,
tls >= 1.5.4, tls >= 1.5.4,
x509-validation >= 1.6.11, x509-validation >= 1.6.11,
bytestring bytestring,
ini
ghc-options: ghc-options:
-O2 -O2

View File

@ -0,0 +1,4 @@
[Server]
hostname= "chat.freenode.org"
port= 6697
channels = "##politics"

View File

@ -12,7 +12,7 @@ import Network.TLS.Extra
import Data.X509.Validation import Data.X509.Validation
import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.Text.Encoding (decodeUtf8) import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Control.Lens import Control.Lens
import Control.Concurrent(threadDelay,forkIO) import Control.Concurrent(threadDelay,forkIO)
import qualified Data.Text as T import qualified Data.Text as T
@ -21,9 +21,12 @@ import Control.Monad(liftM,forever)
import Data.Monoid import Data.Monoid
import qualified Data.Map as M import qualified Data.Map as M
import Data.ByteString(ByteString) import Data.ByteString(ByteString)
import qualified Data.ByteString as BS
import Network.IRC.CTCP(CTCPByteString(..)) import Network.IRC.CTCP(CTCPByteString(..))
import Control.Applicative ((<$>), (<|>)) import Control.Applicative ((<$>), (<|>))
import Data.List(nub,(\\)) import Data.List(nub,(\\))
import Data.Ini
import qualified Data.Text.IO as TIO
type MyNicknames = M.Map (T.Text) ([T.Text]) type MyNicknames = M.Map (T.Text) ([T.Text])
@ -39,8 +42,8 @@ tellCommands = ["tcl"]
privateBotCommands = ["!join","!part","!kick","!op","!cycle","!reconnect","!ostracise","tcl"] privateBotCommands = ["!join","!part","!kick","!op","!cycle","!reconnect","!ostracise","tcl"]
myOwners = ["hastur"] myOwners = ["hastur"]
myChannels :: [T.Text] --myChannels :: [T.Text]
myChannels = ["#exquisitebot"] --myChannels = ["#exquisitebot"]
-- this dogshit irc library doesnt seem to have a concept of 'people in the channel(s)' -- this dogshit irc library doesnt seem to have a concept of 'people in the channel(s)'
rPL_NAMREPLY :: Int rPL_NAMREPLY :: Int
@ -97,8 +100,6 @@ matchNumeric' n intruder ev = case _message ev of
Numeric num args | n == num -> Just (intruder,args) Numeric num args | n == num -> Just (intruder,args)
_ -> Nothing _ -> Nothing
matchType' matchType'
:: Getting (First b) (Message a1) b :: Getting (First b) (Message a1) b
-> a2 -> Event a1 -> Maybe (a2, b) -> a2 -> Event a1 -> Maybe (a2, b)
@ -159,19 +160,30 @@ detectCommandHandler (nns,mh) = huntAlligators (matchType' _Privmsg (nns,mh)) $
Left _ -> return () Left _ -> return ()
stripCommandLocal :: T.Text -> Manhole -> IO (Maybe T.Text) stripCommandLocal :: T.Text -> Manhole -> IO (Maybe T.Text)
stripCommandLocal c m = stripCommandPrefix' c tellCommands m mySignature stripCommandLocal c m = stripCommandPrefix' c tellCommands m mySignature
getIRCConfig = do
c <- TIO.readFile "./exquisiterobot.conf" >>= return . parseIni
case c of
Left _ -> return (T.pack "",0,T.pack "")
Right i -> do
let host = lookupValue "Server" "hostname" i
port = lookupValue "Server" "port" i
channels = lookupValue "Server" "channels" i
case (host,port,channels) of
(Right h, Right p, Right cs) -> return (h,(read . T.unpack $ p),cs)
_ -> return ("",0,"")
initPlugin :: Manhole -> IO InitStatus initPlugin :: Manhole -> IO InitStatus
initPlugin mh = do initPlugin mh = do
let myHost = "darkarmy.chat" (myHost,myPort,myChannels') <- getIRCConfig
myPort = 6697 let myChannels = T.splitOn " " myChannels'
myNickname = "ExquisiteRobot" let myNickname = "ExquisiteRobot"
cpara = defaultParamsClient (unpack $ decodeUtf8 myHost) "" cpara = defaultParamsClient (unpack myHost) ""
validate cs vc sid cc = do validate cs vc sid cc = do
-- First validate with the standard function -- First validate with the standard function
res <- (onServerCertificate $ clientHooks cpara) cs vc sid cc res <- (onServerCertificate $ clientHooks cpara) cs vc sid cc
-- Then strip out non-issues -- Then strip out non-issues
return $ filter (`notElem` [UnknownCA, SelfSigned]) res return $ filter (`notElem` [UnknownCA, SelfSigned]) res
myClientConfig = (tlsClientConfig myPort myHost) { tlsClientTLSSettings = TLSSettings cpara myClientConfig = (tlsClientConfig myPort (encodeUtf8 myHost)) { tlsClientTLSSettings = TLSSettings cpara
{ clientHooks = (clientHooks cpara) { clientHooks = (clientHooks cpara)
{ onServerCertificate = validate } { onServerCertificate = validate }
, clientSupported = (clientSupported cpara) , clientSupported = (clientSupported cpara)

2
state

@ -1 +1 @@
Subproject commit 45e92f9730be1928fec14edcf5a653dec05a265c Subproject commit 15247c3a2941d6993f6734de0153e6e1758ee370