glirc 2.33.1 → 2.34

raw patch · 9 files changed

+92/−26 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• glirc.cabal +1/−1
• src/Client/Commands.hs +40/−12
• src/Client/Configuration/ServerSettings.hs +25/−6
• src/Client/EventLoop.hs +6/−6
• src/Client/EventLoop/Network.hs +7/−0
• src/Client/Hook/Snotice.hs +1/−0
• src/Client/Image/Message.hs +2/−1
• src/Client/State/Window.hs +1/−0

@@ -1,5 +1,14 @@ # Revision history for glirc2 +## 2.34++* Add `/dump` command+* Fix command tab-completion with leading spaces+* Preserve last message timestamp across `/reconnect`+* Add regular expression for QUIT message that trigger reconnects+* Removes unused `userinfo` field from configuration+* Wallops are more noticable now+ ## 2.33.1  * Support for GHC 8.8.1

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                glirc-version:             2.33.1+version:             2.34 synopsis:            Console IRC client description:         Console IRC client                      .

@@ -34,6 +34,7 @@ import           Client.Configuration import           Client.Mask import           Client.Message+import           Client.Image.PackedImage (imageText) import           Client.State import           Client.State.Channel import           Client.State.DCC@@ -45,7 +46,7 @@ import           Client.UserHost import           Control.Applicative import           Control.Concurrent.Async (cancel)-import           Control.Exception (displayException, try)+import           Control.Exception (displayException, try, SomeException) import           Control.Lens import           Control.Monad import           Data.Foldable@@ -58,6 +59,8 @@ import           Data.Maybe (fromMaybe) import           Data.Text (Text) import qualified Data.Text as Text+import qualified Data.Text.Lazy as LText+import qualified Data.Text.Lazy.IO as LText import           Data.Time import           Irc.Commands import           Irc.Identifier@@ -219,7 +222,7 @@   ClientState      {- ^ client state   -} ->   IO CommandResult {- ^ command result -} tabCompletion isReversed st =-  case snd $ clientLine st of+  case dropWhile (' ' ==) $ snd $ clientLine st of     '/':command -> executeCommand (Just isReversed) command st     _           -> nickTabCompletion isReversed st @@ -424,6 +427,12 @@     $ NetworkCommand cmdCert noNetworkTab    , Command+      (pure "dump")+      (simpleToken "filename")+      "Dump current buffer to file.\n"+    $ ClientCommand cmdDump simpleClientTab++  , Command       (pure "help")       (optionalArg (simpleToken "[command]"))       "Show command documentation.\n\@@ -1184,13 +1193,13 @@    , Command       (pure "testmask")-      (liftA2 (,) (simpleToken "[nick!]user@host") (optionalArg (simpleToken "[gecos]")))+      (liftA2 (,) (simpleToken "[nick!]user@host") (remainingArg "[gecos]"))       "Test how many local and global clients match a mask.\n"     $ NetworkCommand cmdTestmask simpleNetworkTab    , Command       (pure "masktrace")-      (liftA2 (,) (simpleToken "[nick!]user@host") (optionalArg (simpleToken "[gecos]")))+      (liftA2 (,) (simpleToken "[nick!]user@host") (remainingArg "[gecos]"))       "Outputs a list of local users matching the given masks.\n"     $ NetworkCommand cmdMasktrace simpleNetworkTab @@ -1558,6 +1567,25 @@   where     focus = FocusHelp (fmap Text.pack mb) +-- | Implementation of @/dump@. Writes detailed contents of focused buffer+-- to the given filename.+cmdDump :: ClientCommand String+cmdDump st fp =+  do res <- try (LText.writeFile fp (LText.unlines outputLines))+     case res of+       Left e  -> commandFailureMsg (Text.pack (displayException (e :: SomeException))) st+       Right{} -> commandSuccess st++  where+    focus = view clientFocus st+    msgs  = preview (clientWindows . ix focus . winMessages) st+    outputLines =+      case msgs of+        Nothing  -> []+        Just wls -> convert [] wls+    convert acc Nil = acc+    convert acc (wl :- wls) = convert (views wlFullImage imageText wl : acc) wls+ -- | Tab completion for @/splits[+]@. When given no arguments this -- populates the current list of splits, otherwise it tab completes -- all of the currently available windows.@@ -1818,14 +1846,14 @@   do sendMsg cs (ircTestline (Text.pack mask))      commandSuccess st -cmdTestmask :: NetworkCommand (String, Maybe String)+cmdTestmask :: NetworkCommand (String, String) cmdTestmask cs st (mask, gecos) =-  do sendMsg cs (ircTestmask (Text.pack mask) (maybe "" Text.pack gecos))+  do sendMsg cs (ircTestmask (Text.pack mask) (Text.pack gecos))      commandSuccess st -cmdMasktrace :: NetworkCommand (String, Maybe String)+cmdMasktrace :: NetworkCommand (String, String) cmdMasktrace cs st (mask, gecos) =-  do sendMsg cs (ircMasktrace (Text.pack mask) (maybe "*" Text.pack gecos))+  do sendMsg cs (ircMasktrace (Text.pack mask) (Text.pack gecos))      commandSuccess st  cmdTrace :: NetworkCommand (Maybe (String, Maybe String))@@ -2098,8 +2126,8 @@ cmdReconnect st _   | Just network <- views clientFocus focusNetwork st = -      do tm <- getCurrentTime-         st' <- addConnection 0 (Just tm) Nothing network =<< abortNetwork network st+      do let tm = preview (clientConnection network . csLastReceived . folded) st+         st' <- addConnection 0 tm Nothing network =<< abortNetwork network st          commandSuccess            $ changeFocus (NetworkFocus network) st' @@ -2326,9 +2354,9 @@   do guard (cursorPos == n)      clientTextBox (wordComplete plainWordCompleteMode isReversed [] possibilities) st   where-    n = length leadingPart+    n = length white + length leadingPart     (cursorPos, line) = clientLine st-    leadingPart = takeWhile (/=' ') line+    (white, leadingPart) = takeWhile (' ' /=) <$> span (' '==) line     possibilities = Text.cons '/' <$> commandNames     commandNames = keys commands                 ++ keys (view (clientConfig . configMacros) st)

@@ -24,7 +24,6 @@   , ssNicks   , ssUser   , ssReal-  , ssUserInfo   , ssPassword   , ssSaslUsername   , ssSaslPassword@@ -45,6 +44,7 @@   , ssMessageHooks   , ssName   , ssReconnectAttempts+  , ssReconnectError   , ssAutoconnect   , ssNickCompletion   , ssLogDir@@ -62,6 +62,9 @@   , UseTls(..)   , Fingerprint(..) +  -- * Regex wrapper+  , KnownRegex(..)+  , getRegex   ) where  import           Client.Commands.Interpolation@@ -82,13 +85,14 @@ import           Network.Socket (HostName, PortNumber, Family(..)) import           Numeric (readHex) import           System.Environment+import           Text.Regex.TDFA+import           Text.Regex.TDFA.Text (compile)  -- | Static server-level settings data ServerSettings = ServerSettings   { _ssNicks            :: !(NonEmpty Text) -- ^ connection nicknames   , _ssUser             :: !Text -- ^ connection username   , _ssReal             :: !Text -- ^ connection realname / GECOS-  , _ssUserInfo         :: !Text -- ^ CTCP userinfo   , _ssPassword         :: !(Maybe Text) -- ^ server password   , _ssSaslUsername     :: !(Maybe Text) -- ^ SASL username   , _ssSaslPassword     :: !(Maybe Text) -- ^ SASL plain password@@ -109,6 +113,7 @@   , _ssMessageHooks     :: ![HookConfig] -- ^ Initial message hooks   , _ssName             :: !(Maybe Text) -- ^ The name referencing the server in commands   , _ssReconnectAttempts:: !Int -- ^ The number of reconnect attempts to make on error+  , _ssReconnectError   :: !(Maybe KnownRegex) -- ^ Regular expression for ERROR messages that trigger reconnect   , _ssAutoconnect      :: !Bool -- ^ Connect to this network on server startup   , _ssNickCompletion   :: WordCompletionMode -- ^ Nick completion mode for this server   , _ssLogDir           :: Maybe FilePath -- ^ Directory to save logs of chat@@ -121,6 +126,14 @@   }   deriving Show +-- | Regular expression matched with original source to help with debugging.+data KnownRegex = KnownRegex Text Regex++getRegex :: KnownRegex -> Regex+getRegex (KnownRegex _ r) = r++instance Show KnownRegex where show (KnownRegex x _) = show x+ -- | Hook name and configuration arguments data HookConfig = HookConfig Text [Text]   deriving Show@@ -153,7 +166,6 @@        { _ssNicks         = pure username        , _ssUser          = username        , _ssReal          = username-       , _ssUserInfo      = username        , _ssPassword      = Text.pack <$> lookup "IRCPASSWORD" env        , _ssSaslUsername  = Nothing        , _ssSaslPassword  = Text.pack <$> lookup "SASLPASSWORD" env@@ -174,6 +186,7 @@        , _ssMessageHooks     = []        , _ssName             = Nothing        , _ssReconnectAttempts= 6 -- six feels great+       , _ssReconnectError   = Nothing        , _ssAutoconnect      = False        , _ssNickCompletion   = defaultNickWordCompleteMode        , _ssLogDir           = Nothing@@ -225,9 +238,6 @@       , req "realname" ssReal anySpec         "\"GECOS\" name sent to server visible in /whois" -      , req "userinfo" ssUserInfo anySpec-        "CTCP userinfo (currently unused)"-       , opt "sasl-username" ssSaslUsername anySpec         "Username for SASL authentication to NickServ" @@ -276,6 +286,9 @@       , req "reconnect-attempts" ssReconnectAttempts anySpec         "Number of reconnection attempts on lost connection" +      , opt "reconnect-error" ssReconnectError regexSpec+        "Regular expression for disconnect messages that trigger reconnect."+       , req "autoconnect" ssAutoconnect yesOrNoSpec         "Set to `yes` to automatically connect at client startup" @@ -365,3 +378,9 @@  identifierSpec :: ValueSpec Identifier identifierSpec = mkId <$> anySpec++regexSpec :: ValueSpec KnownRegex+regexSpec = customSpec "regex" anySpec $ \str ->+  case compile defaultCompOpt ExecOption{captureGroups = False} str of+    Left e  -> Left  (Text.pack e)+    Right r -> Right (KnownRegex str r)

@@ -193,13 +193,13 @@   ClientState {- ^ client state -} ->   IO ClientState doNetworkClose networkId time st =-  do let (cs,st') = removeNetwork networkId st+  do let (cs,st1) = removeNetwork networkId st          msg = ClientMessage                  { _msgTime    = time                  , _msgNetwork = view csNetwork cs                  , _msgBody    = NormalBody "connection closed"                  }-     return (recordNetworkMessage msg st')+     return (recordNetworkMessage msg st1)   -- | Respond to a network connection closing abnormally.@@ -213,14 +213,14 @@   do let (cs,st1) = removeNetwork networkId st          st2 = foldl' (\acc msg -> recordError time (view csNetwork cs) (Text.pack msg) acc) st1              $ exceptionToLines ex-     reconnectLogic ex cs st2+     reconnectLogicOnFailure ex cs st2 -reconnectLogic ::+reconnectLogicOnFailure ::   SomeException {- ^ thread failure reason -} ->   NetworkState  {- ^ failed network        -} ->   ClientState   {- ^ client state          -} ->   IO ClientState-reconnectLogic ex cs st+reconnectLogicOnFailure ex cs st    | shouldReconnect =       do (attempts, mbDisconnectTime) <- computeRetryInfo@@ -241,7 +241,7 @@     shouldReconnect =       case view csPingStatus cs of         PingConnecting n _ | n == 0 || n > reconnectAttempts          -> False-        _ | Just ConnectionFailure{}  <-             fromException ex -> True+        _ | Just ConnectionFailure{}         <-      fromException ex -> True           | Just HostnameResolutionFailure{} <-      fromException ex -> True           | Just PingTimeout         <-              fromException ex -> True           | Just ResourceVanished    <- ioe_type <$> fromException ex -> True

@@ -33,6 +33,7 @@ import qualified Client.Authentication.Ecdsa as Ecdsa import qualified Data.Text as Text import qualified Data.Text.Read as Text+import           Text.Regex.TDFA.Text as Regex  -- | Client-level responses to specific IRC messages. -- This is in contrast to the connection state tracking logic in@@ -63,6 +64,12 @@      Cap (CapNew caps)       | Just stsVal <- join (lookup "sts" caps) -> processSts stsVal cs st++    Error msg+      | Just rx <- previews (csSettings . ssReconnectError . folded) getRegex cs+      , Right{} <- Regex.execute rx msg+      , let discoTime = view csLastReceived cs ->+         addConnection 1 discoTime Nothing (view csNetwork cs) st      _ -> return st 

@@ -162,6 +162,7 @@     (2, "o", [str|^[^ ]+( \([^ ]+\))? reopened #|]),     (3, "o", [str|^[^ ]+( \([^ ]+\))? reset the password for the account|]),     (3, "o", [str|^[^ ]+( \([^ ]+\))? enabled automatic klines on the channel|]),+    (3, "o", [str|^[^ ]+( \([^ ]+\))? disabled automatic klines on the channel|]),     (3, "o", [str|^[^ ]+( \([^ ]+\))? forbade the nickname |]),     (3, "o", [str|^[^ ]+( \([^ ]+\))? unforbade the nickname |]),     (3, "o", [str|^[^ ]+( \([^ ]+\))? is removing oper class for |]),

@@ -243,7 +243,8 @@       string (withForeColor defAttr red) ":"      Privmsg src _ _ -> who src <> ":"-    Wallops src _   -> who src <> "!!"+    Wallops src _   ->+      string (withForeColor defAttr red) "WALL " <> who src <> ":"      Ctcp src _dst "ACTION" _txt ->       string (withForeColor defAttr blue) "* " <> who src

@@ -23,6 +23,7 @@   , winHideMeta    -- * Window lines+  , WindowLines(..)   , WindowLine(..)   , wlSummary   , wlText