diff options
| -rw-r--r-- | README.md | 19 | ||||
| -rw-r--r-- | reaktor2.cabal | 2 | ||||
| -rw-r--r-- | src/Reaktor.hs | 2 | ||||
| -rw-r--r-- | src/Reaktor/IRC.hs | 22 | ||||
| -rw-r--r-- | src/Reaktor/Plugins/SASL.hs | 107 | ||||
| -rw-r--r-- | src/main.hs | 2 |
6 files changed, 154 insertions, 0 deletions
@@ -70,3 +70,22 @@ curl -fsSv --unix-socket /path/to/reaktor.sock http://dontcare/ \ -H content-type:application/json \ -d "$(jq -n '{command:"PRIVMSG",params:["#somechannel","derp!"]}')" + +# SASL + + To use SASL for authentication, merge following snippet into your configuration: + + { + "plugins": [ + { + "plugin": "sasl", + "config": { + "mechanism": "PLAIN", + "username": "somename", + "password": "SOMEPASSWORD" + } + } + ] + } + + Note that at the moment only SASL PLAIN is supported. diff --git a/reaktor2.cabal b/reaktor2.cabal index 1a1c6b7..96cfb75 100644 --- a/reaktor2.cabal +++ b/reaktor2.cabal @@ -12,6 +12,7 @@ executable reaktor async, attoparsec, base, + base64, blessings, bytestring, containers, @@ -55,6 +56,7 @@ executable reaktor Reaktor.Plugins.Mention Reaktor.Plugins.Ping Reaktor.Plugins.Register + Reaktor.Plugins.SASL Reaktor.Plugins.System Reaktor.Plugins.System.Internal System.Posix.Files.Extended diff --git a/src/Reaktor.hs b/src/Reaktor.hs index 27d9003..76b11d5 100644 --- a/src/Reaktor.hs +++ b/src/Reaktor.hs @@ -165,6 +165,8 @@ splitter plugins takeInMsg = logMsgFilter :: Message -> Maybe Message logMsgFilter = \case + Message p AUTHENTICATE [s] | not (elem s ["PLAIN", "+"]) -> + Just (Message p AUTHENTICATE ["***REDACTED***"]) Message _ PING _ -> Nothing Message _ PONG _ -> Nothing Message p PRIVMSG ["NickServ",xs] | check -> do diff --git a/src/Reaktor/IRC.hs b/src/Reaktor/IRC.hs index 2000d08..3dbfedb 100644 --- a/src/Reaktor/IRC.hs +++ b/src/Reaktor/IRC.hs @@ -20,7 +20,9 @@ import Prelude.Extended data Command = UnknownCommand Text | UnknownReply Int | ADMIN + | AUTHENTICATE | AWAY + | CAP | CONNECT | DIE | ERROR @@ -207,6 +209,15 @@ data Command = | ERR_NOOPERHOST | ERR_UMODEUNKNOWNFLAG | ERR_USERSDONTMATCH + + | RPL_LOGGEDIN + | RPL_LOGGEDOUT + | ERR_NICKLOCKED + | RPL_SASLSUCCESS + | ERR_SASLFAIL + | ERR_SASLTOOLONG + | ERR_SASLABORTED + | ERR_SASLALREADY deriving (Eq,Generic,Hashable,Show) instance ConvertibleStrings Text Command where @@ -239,7 +250,9 @@ instance FromJSONKey Command where commands :: [(Text, Command)] commands = [ ("ADMIN", ADMIN) + , ("AUTHENTICATE", AUTHENTICATE) , ("AWAY", AWAY) + , ("CAP", CAP) , ("CONNECT", CONNECT) , ("DIE", DIE) , ("ERROR", ERROR) @@ -429,6 +442,15 @@ replies = , (491, ERR_NOOPERHOST) , (501, ERR_UMODEUNKNOWNFLAG) , (502, ERR_USERSDONTMATCH) + + , (900, RPL_LOGGEDIN) + , (901, RPL_LOGGEDOUT) + , (902, ERR_NICKLOCKED) + , (903, RPL_SASLSUCCESS) + , (904, ERR_SASLFAIL) + , (905, ERR_SASLTOOLONG) + , (906, ERR_SASLABORTED) + , (907, ERR_SASLALREADY) ] mCommandText :: HashMap Command Text diff --git a/src/Reaktor/Plugins/SASL.hs b/src/Reaktor/Plugins/SASL.hs new file mode 100644 index 0000000..e70a65d --- /dev/null +++ b/src/Reaktor/Plugins/SASL.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Reaktor.Plugins.SASL where + +import Data.Aeson +import Data.Aeson.Types (typeMismatch) +import Data.Base64.Types (extractBase64) +import Data.Text qualified as Text +import Data.Text.Encoding.Base64 (encodeBase64) +import Prelude.Extended +import Reaktor +import Text.Read (readMaybe) + + +data Mechanism = PLAIN + deriving (Read, Show) + +instance ToJSON Mechanism where + toJSON = String . Text.show + +instance FromJSON Mechanism where + parseJSON = withText "Mechanism" $ \s -> + case readMaybe (Text.unpack s) of + Just x -> pure x + Nothing -> fail "Invalid Mechanism value" + + +data Config = Config + { cMechanism :: Mechanism + , cUserName :: Text + , cPassword :: Text + } + +instance Default Config where + def = Config + { cMechanism = PLAIN + , cUserName = "" + , cPassword = "" + } + +instance FromJSON Config where + parseJSON = \case + Object v -> + Config + <$> v .:? "mechanism" .!= PLAIN + <*> v .: "username" + <*> v .: "password" + invalid -> + typeMismatch "Config" invalid + + +new :: Config -> Actions -> IO (Message -> IO ()) +new Config{..} Actions{..} = + return $ \case + Start | cUserName /= "" && cPassword /= "" -> do + aSend (Message Nothing CAP ["REQ", "sasl"]) + + Message _ CAP [_username, "ACK", "sasl"] -> do + aSend (Message Nothing AUTHENTICATE [Text.show cMechanism]) + + Message _ AUTHENTICATE ["+"] -> + case cMechanism of + PLAIN -> + mapM_ (\chunk -> aSend (Message Nothing AUTHENTICATE [chunk])) + (toAuthChunks (toBase64 ("\0" <> cUserName <> "\0" <> cPassword))) + + Message _ RPL_SASLSUCCESS _ -> + aSend (Message Nothing CAP ["END"]) + + Message _ ERR_SASLFAIL _ -> + aSend (Message Nothing CAP ["END"]) + + Message _ ERR_SASLTOOLONG _ -> + aSend (Message Nothing CAP ["END"]) + + Message _ ERR_SASLALREADY _ -> + aSend (Message Nothing CAP ["END"]) + + _ -> pure () + + +toBase64 :: Text -> Text +toBase64 = extractBase64 . encodeBase64 + + +-- Split input Text into chunks compatibe with the AUTHENTICATE command. +-- This function assumes that each character in the input Text is exactly one +-- byte long, which is true for any Base64 encoded Text. +-- +-- See also: https://ircv3.net/specs/extensions/sasl-3.1#the-authenticate-command +toAuthChunks :: Text -> [Text] +toAuthChunks s = + if not (null chunks) && Text.length (last chunks) == 400 then + chunks <> ["+"] + else + chunks + where + chunks = toChunksOf 400 s + + +toChunksOf :: Int -> Text -> [Text] +toChunksOf n s + | Text.null s = [] + | otherwise = let (a,b) = Text.splitAt n s + in a : toChunksOf n b diff --git a/src/main.hs b/src/main.hs index 51bc17c..b57d161 100644 --- a/src/main.hs +++ b/src/main.hs @@ -13,6 +13,7 @@ import qualified Reaktor import qualified Reaktor.Plugins.Mention import qualified Reaktor.Plugins.Ping import qualified Reaktor.Plugins.Register +import qualified Reaktor.Plugins.SASL import qualified Reaktor.Plugins.System import qualified System.Environment @@ -28,6 +29,7 @@ main = do Reaktor.Plugins.Mention.new actions, Reaktor.Plugins.Ping.new actions, Reaktor.Plugins.Register.new (pluginConfig "register" v) actions, + Reaktor.Plugins.SASL.new (pluginConfig "sasl" v) actions, Reaktor.Plugins.System.new (pluginConfig "system" v) actions ] |