diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for irc-core +## 2.6.0 + +* Process CAP commands in library instead of client +* Add support for SASL EXTERNAL +* Add support for CHGHOST + ## 2.5.0 * Add support for extended JOIN and ACCOUNT messages diff --git a/irc-core.cabal b/irc-core.cabal --- a/irc-core.cabal +++ b/irc-core.cabal @@ -1,5 +1,5 @@ name: irc-core -version: 2.5.0 +version: 2.6.0 synopsis: IRC core library for glirc description: IRC core library for glirc . @@ -32,7 +32,7 @@ Irc.UserInfo other-modules: View - build-depends: base >=4.11 && <4.12, + build-depends: base >=4.11 && <4.13, base64-bytestring >= 1.0.0.1 && <1.1, attoparsec >=0.13 && <0.14, bytestring >=0.10 && <0.11, diff --git a/src/Irc/Codes.hs b/src/Irc/Codes.hs --- a/src/Irc/Codes.hs +++ b/src/Irc/Codes.hs @@ -57,6 +57,7 @@ pattern RPL_SAVENICK = ReplyCode 043 pattern RPL_ATTEMPTINGJUNC = ReplyCode 050 pattern RPL_ATTEMPTINGREROUTE = ReplyCode 051 +pattern RPL_REMOTESUPPORT = ReplyCode 105 -- ircd-seven unnamed code pattern RPL_TRACELINK = ReplyCode 200 pattern RPL_TRACECONNECTING = ReplyCode 201 pattern RPL_TRACEHANDSHAKE = ReplyCode 202 @@ -402,6 +403,7 @@ pattern RPL_TESTMASK = ReplyCode 724 pattern RPL_TESTLINE = ReplyCode 725 pattern RPL_NOTESTLINE = ReplyCode 726 +pattern RPL_TESTMASKGECOS = ReplyCode 727 pattern RPL_QUIETLIST = ReplyCode 728 pattern RPL_ENDOFQUIETLIST = ReplyCode 729 pattern RPL_MONONLINE = ReplyCode 730 @@ -484,6 +486,7 @@ , (RPL_SAVENICK , ReplyCodeInfo ClientServerReply "save-nick") , (RPL_ATTEMPTINGJUNC , ReplyCodeInfo ClientServerReply "attempting-junc") , (RPL_ATTEMPTINGREROUTE , ReplyCodeInfo ClientServerReply "attempting-reroute") + , (RPL_REMOTESUPPORT , ReplyCodeInfo ClientServerReply "remote-support") , (RPL_TRACELINK , ReplyCodeInfo CommandReply "trace-link") , (RPL_TRACECONNECTING , ReplyCodeInfo CommandReply "trace-connecting") , (RPL_TRACEHANDSHAKE , ReplyCodeInfo CommandReply "trace-handshake") @@ -829,6 +832,7 @@ , (RPL_TESTMASK , ReplyCodeInfo CommandReply "test-mask") , (RPL_TESTLINE , ReplyCodeInfo CommandReply "test-line") , (RPL_NOTESTLINE , ReplyCodeInfo CommandReply "no-test-line") + , (RPL_TESTMASKGECOS , ReplyCodeInfo CommandReply "testmask-gecos") , (RPL_QUIETLIST , ReplyCodeInfo CommandReply "quiet-list") , (RPL_ENDOFQUIETLIST , ReplyCodeInfo CommandReply "end-of-quiet-list") , (RPL_MONONLINE , ReplyCodeInfo CommandReply "mon-online") diff --git a/src/Irc/Commands.hs b/src/Irc/Commands.hs --- a/src/Irc/Commands.hs +++ b/src/Irc/Commands.hs @@ -22,6 +22,7 @@ , ircJoin , ircKick , ircKill + , ircKline , ircKnock , ircLinks , ircList @@ -37,26 +38,29 @@ , ircPing , ircPong , ircPrivmsg - , ircRules , ircQuit , ircRemove + , ircRules , ircStats + , ircTestline + , ircTestmask , ircTime , ircTopic + , ircUnkline , ircUser , ircUserhost + , ircVersion , ircWho , ircWhois , ircWhowas - , ircVersion -- * ZNC support , ircZnc -- * SASL support , ircAuthenticate - , plainAuthenticationMode , encodePlainAuthentication + , encodeExternalAuthentication ) where import Irc.RawIrcMsg @@ -193,6 +197,33 @@ RawIrcMsg ircKill who msg = rawIrcMsg "KILL" (who : nonempty msg) +-- | KLINE command +ircKline :: + Text {- ^ minutes -} -> + Text {- ^ mask -} -> + Text {- ^ reason -} -> + RawIrcMsg +ircKline minutes mask reason = rawIrcMsg "KLINE" [minutes, mask, reason] + +-- | UNKLINE command +ircUnkline :: + Text {- ^ mask -} -> + RawIrcMsg +ircUnkline mask = rawIrcMsg "UNKLINE" [mask] + +-- | TESTLINE command +ircTestline :: + Text {- ^ mask -} -> + RawIrcMsg +ircTestline mask = rawIrcMsg "TESTLINE" [mask] + +-- | TESTLINE command +ircTestmask :: + Text {- ^ mask -} -> + Text {- ^ gecos -} -> + RawIrcMsg +ircTestmask mask gecos = rawIrcMsg "TESTMASK" (mask : nonempty gecos) + -- | REMOVE command ircRemove :: Identifier {- ^ channel -} -> @@ -329,15 +360,8 @@ -- | USER command ircUser :: Text {- ^ username -} -> - Bool {- ^ set +w -} -> - Bool {- ^ set +i -} -> Text {- ^ realname -} -> RawIrcMsg -ircUser user set_w set_i real = rawIrcMsg "USER" [user, modeTxt, "*", real] - where - modeTxt = Text.pack (show mode) - mode :: Int - mode = (if set_w then 4 else 0) -- bit 2 - + (if set_i then 8 else 0) -- bit 3 +ircUser user real = rawIrcMsg "USER" [user, "0", "*", real] -- | CAP REQ command ircCapReq :: @@ -349,9 +373,9 @@ ircCapEnd :: RawIrcMsg ircCapEnd = rawIrcMsg "CAP" ["END"] --- | CAP LS command +-- | CAP LS command - support CAP version 3.2 ircCapLs :: RawIrcMsg -ircCapLs = rawIrcMsg "CAP" ["LS"] +ircCapLs = rawIrcMsg "CAP" ["LS", "302"] -- | ZNC command -- @@ -362,13 +386,11 @@ ircZnc = rawIrcMsg "ZNC" -- | AUTHENTICATE command -ircAuthenticate :: Text -> RawIrcMsg +ircAuthenticate :: + Text {- ^ authentication mechanism -} -> + RawIrcMsg ircAuthenticate msg = rawIrcMsg "AUTHENTICATE" [msg] --- | PLAIN authentiation mode -plainAuthenticationMode :: Text -plainAuthenticationMode = "PLAIN" - -- | Encoding of username and password in PLAIN authentication encodePlainAuthentication :: Text {- ^ username -} -> @@ -379,3 +401,12 @@ $ Enc.encode $ Text.encodeUtf8 $ Text.intercalate "\0" [user,user,pass] + +-- | Encoding of username in EXTERNAL authentication +encodeExternalAuthentication :: + Text {- ^ username -} -> + Text +encodeExternalAuthentication user + = Text.decodeUtf8 + $ Enc.encode + $ Text.encodeUtf8 user diff --git a/src/Irc/Message.hs b/src/Irc/Message.hs --- a/src/Irc/Message.hs +++ b/src/Irc/Message.hs @@ -17,6 +17,7 @@ -- * High-level messages IrcMsg(..) , CapCmd(..) + , CapMore(..) , cookIrcMsg -- * Properties of messages @@ -28,6 +29,7 @@ -- * Helper functions , nickSplit , computeMaxMessageLength + , capCmdText ) where import Control.Monad @@ -58,38 +60,41 @@ | Notice !UserInfo !Identifier !Text -- ^ source target txt | Mode !UserInfo !Identifier [Text] -- ^ source target txt | Authenticate !Text -- ^ parameters - | Cap !CapCmd [Text] -- ^ command parameters + | Cap !CapCmd -- ^ cap command and parameters | Ping [Text] -- ^ parameters | Pong [Text] -- ^ parameters | Error !Text -- ^ message - | BatchStart Text Text [Text] -- ^ reference-id type parameters - | BatchEnd Text -- ^ reference-id - | Account !UserInfo Text -- ^ user account name changed (account-notify extension) + | BatchStart !Text !Text [Text] -- ^ reference-id type parameters + | BatchEnd !Text -- ^ reference-id + | Account !UserInfo !Text -- ^ user account name changed (account-notify extension) + | Chghost !UserInfo !Text !Text -- ^ Target, new username and new hostname deriving Show --- | Sub-commands of the CAP command +data CapMore = CapMore | CapDone + deriving (Show, Read, Eq, Ord) + +-- | Sub-commands of the CAP command sent by server data CapCmd - = CapLs -- ^ request list of supported caps - | CapList -- ^ request list of active caps - | CapReq -- ^ request activation of cap - | CapAck -- ^ request accepted - | CapNak -- ^ request denied - | CapEnd -- ^ end negotiation - | CapNew -- ^ new capability available (cap-notify extension) - | CapDel -- ^ capability removed (cap-notify extension) - deriving (Show, Eq, Ord) + = CapLs !CapMore [(Text, Maybe Text)] -- ^ list of supported caps + | CapList [Text] -- ^ list of active caps + | CapAck [Text] -- ^ request accepted + | CapNak [Text] -- ^ request denied + | CapNew [(Text, Maybe Text)] -- ^ new capability available (cap-notify extension) + | CapDel [Text] -- ^ capability removed (cap-notify extension) + deriving (Show, Read, Eq, Ord) -- | Match command text to structured cap sub-command -cookCapCmd :: Text -> Maybe CapCmd -cookCapCmd "LS" = Just CapLs -cookCapCmd "LIST" = Just CapList -cookCapCmd "ACK" = Just CapAck -cookCapCmd "NAK" = Just CapNak -cookCapCmd "END" = Just CapEnd -cookCapCmd "REQ" = Just CapReq -cookCapCmd "NEW" = Just CapNew -cookCapCmd "DEL" = Just CapDel -cookCapCmd _ = Nothing +cookCapCmd :: Text -> [Text] -> Maybe CapCmd +cookCapCmd cmd args = + case (cmd, args) of + ("LS" , ["*", caps]) -> Just (CapLs CapMore (splitCapList caps)) + ("LS" , [ caps]) -> Just (CapLs CapDone (splitCapList caps)) + ("LIST", [ caps]) -> Just (CapList (Text.words caps)) + ("ACK" , [ caps]) -> Just (CapAck (Text.words caps)) + ("NAK" , [ caps]) -> Just (CapNak (Text.words caps)) + ("NEW" , [ caps]) -> Just (CapNew (splitCapList caps)) + ("DEL" , [ caps]) -> Just (CapDel (Text.words caps)) + _ -> Nothing -- | Interpret a low-level 'RawIrcMsg' as a high-level 'IrcMsg'. -- Messages that can't be understood are wrapped in 'UnknownMsg'. @@ -99,8 +104,7 @@ cmd | Right (n,"") <- decimal cmd -> Reply (ReplyCode n) (view msgParams msg) "CAP" | _target:cmdTxt:rest <- view msgParams msg - , Just cmd <- cookCapCmd cmdTxt -> - Cap cmd rest + , Just cmd <- cookCapCmd cmdTxt rest -> Cap cmd "AUTHENTICATE" | x:_ <- view msgParams msg -> Authenticate x @@ -170,6 +174,10 @@ , [acct] <- view msgParams msg -> Account user (if acct == "*" then "" else acct) + "CHGHOST" | Just user <- view msgPrefix msg + , [newuser, newhost] <- view msgParams msg -> + Chghost user newuser newhost + _ -> UnknownMsg msg -- | Parse a CTCP encoded message: @@ -189,6 +197,7 @@ | TargetWindow !Identifier -- ^ Directed message to channel or from user | TargetNetwork -- ^ Network-level message | TargetHidden -- ^ Completely hidden message + deriving (Show) -- | Target information for the window that could be appropriate to -- display this message in. @@ -216,7 +225,8 @@ Reply code args -> replyTarget code args BatchStart{} -> TargetHidden BatchEnd{} -> TargetHidden - Account{} -> TargetHidden + Account user _ -> TargetUser (userNick user) + Chghost user _ _ -> TargetUser (userNick user) where directed src tgt | Text.null (userHost src) = TargetNetwork -- server message @@ -275,13 +285,30 @@ Mode x _ xs -> Text.unwords (renderUserInfo x:"set mode":xs) Ping xs -> Text.unwords xs Pong xs -> Text.unwords xs - Cap _ xs -> Text.unwords xs + Cap cmd -> capCmdText cmd Error t -> t Account x a -> Text.unwords [renderUserInfo x, a] Authenticate{} -> "" BatchStart{} -> "" BatchEnd{} -> "" +capCmdText :: CapCmd -> Text +capCmdText cmd = + case cmd of + CapLs more caps -> capMoreText more <> capUnsplitCaps caps + CapNew caps -> capUnsplitCaps caps + CapList caps -> Text.unwords caps + CapAck caps -> Text.unwords caps + CapNak caps -> Text.unwords caps + CapDel caps -> Text.unwords caps + +capMoreText :: CapMore -> Text +capMoreText CapDone = "" +capMoreText CapMore = "* " + +capUnsplitCaps :: [(Text, Maybe Text)] -> Text +capUnsplitCaps xs = Text.unwords [ k <> maybe "" ("=" <>) v | (k, v) <- xs ] + -- nickname = ( letter / special ) *8( letter / digit / special / "-" ) -- letter = %x41-5A / %x61-7A ; A-Z / a-z -- digit = %x30-39 ; 0-9 @@ -314,3 +341,12 @@ - Text.length (renderUserInfo myUserInfo) - length (": PRIVMSG :\r\n"::String) - Text.length target + +splitCapList :: Text -> [(Text, Maybe Text)] +splitCapList caps = + [ (name, value) + | kv <- Text.words caps + , let (name, v) = Text.break ('=' ==) kv + , let value | Text.null v = Nothing + | otherwise = Just $! Text.tail v + ]