rss2irc 1.0.6 → 1.1
raw patch · 9 files changed
+120/−61 lines, 9 filesdep +SafeSemaphoredep +network-uridep +stmdep −cabal-file-thdep ~feeddep ~http-clientdep ~http-conduit
Dependencies added: SafeSemaphore, network-uri, stm
Dependencies removed: cabal-file-th
Dependency ranges changed: feed, http-client, http-conduit, http-types, irc, network, resourcet, text, time, transformers
Files
- Base.hs +14/−8
- CHANGES +12/−4
- Feed.hs +10/−4
- Irc.hs +17/−15
- README.md +17/−0
- Utils.hs +14/−14
- rss2irc.cabal +24/−15
- rss2irc.hs +2/−1
- stack.yaml +10/−0
Base.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE PatternGuards, BangPatterns, DeriveDataTypeable, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}+-- DeriveGeneric, StandaloneDeriving {- | Types and settings.@@ -10,27 +11,29 @@ module Base where -import Control.Concurrent.Chan (Chan)-import Control.DeepSeq (NFData)+import Control.Concurrent.STM (TChan)+-- import Control.DeepSeq (NFData) import Control.Exception import Control.Monad.IO.Class (MonadIO, liftIO)+-- import GHC.Generics import Data.Time () import Data.Time.Clock import Data.Typeable-import Distribution.PackageDescription.TH (packageVariable, package, pkgName, pkgVersion) import Network.HTTP.Conduit (Manager) import System.Console.CmdArgs import System.IO (Handle)-import Text.Feed.Types (Item)+-- import Text.Feed.Types import Text.Printf (printf) -progname = $(packageVariable (pkgName . package))-version = $(packageVariable (pkgVersion . package))+progname = "rss2irc"+version = "1.1" -- sync with rss2irc.cabal progversion = progname ++ " " ++ version :: String defport = 6667 defusername = progname defrealname = progname ++ " feed announcer"+defuseragent :: String+defuseragent = progversion definterval = 5 defidle = 0 defmaxitems = 5@@ -53,6 +56,7 @@ defopts = Opts { ident = defrealname &= typ "STR" &= help "set the bot's identity string (useful for contact info)"+ ,uagent = defuseragent &= typ "STR" &= help "set the bot's Http UserAgent string " ,delay = def &= help "wait for N minutes before starting (helps avoid mass joins)" ,interval = definterval &= name "i" &= help ("polling and announcing interval in minutes (default "++(show definterval)++")") ,cache_control = def &= explicit &= name "cache-control" &= typ "STR" &= help ("set a HTTP cache-control header when polling")@@ -84,6 +88,7 @@ data Opts = Opts { ident :: String+ ,uagent :: String ,delay :: Int ,interval :: Int ,cache_control :: String@@ -121,7 +126,7 @@ , port :: !Int -- ^ the IRC server's port number , channel :: !String -- ^ the IRC channel to join , botnick :: !String -- ^ the bot's IRC nickname- , announcequeue :: !(Chan String) -- ^ a shared queue of messages to be announced+ , announcequeue :: !(TChan String) -- ^ a shared queue of messages to be announced , batchindex :: !Int -- ^ how many announcements have been made in the current batch , lastmsgtime :: !UTCTime -- ^ the last time somebody spoke on the IRC channel }@@ -152,7 +157,8 @@ instance Exception IrcException instance Show IrcException where show (IrcException msg) = printf "IRC error (%s)" msg -instance NFData Item+-- deriving instance Generic Item+-- instance NFData Item io :: MonadIO m => IO a -> m a io = liftIO
CHANGES view
@@ -1,3 +1,11 @@+1.1 (2016/11/1)++* update for GHC 8, stackage lts-7+* allow latest http-client, http-conduit, resourcet, network, transformers, text; drop cabal-file-th+* update to irc 0.6 (warning: probably not unicode-safe)+* use STM's TChan, fixing warnings and possibly hangs+* use safer MSampleVar, possibly fixing hangs+ 1.0.6 (2014/4/13) * minimal changes to build with feed 0.3.9.* and other libs in current Debian unstable (sid)@@ -6,19 +14,19 @@ * avoid feed 0.3.9.2 which has changed its API -1.0.4+1.0.4 (2013/9/5) * fix compilation with GHC 7.4 (Fabien Andre) -1.0.3+1.0.3 (2013/2/22) * fix http-conduit usage so the feed poller doesn't die within hours -1.0.2+1.0.2 (2013/2/18) * `--use-actions` works again -1.0.1+1.0.1 (2013/2/15) * fix release notes formatting on hackage
Feed.hs view
@@ -10,7 +10,8 @@ module Feed where -import Control.Concurrent+import Control.Concurrent (threadDelay)+import Control.Concurrent.STM import Control.Exception import Control.Monad import Control.Monad.Trans.Resource (ResourceT, runResourceT)@@ -20,7 +21,7 @@ import Data.List import System.IO.Storage import Network.HTTP.Conduit-import Network.HTTP.Types (hCacheControl)+import Network.HTTP.Types (hCacheControl, hUserAgent) import Network.URI import Prelude hiding (log) import Safe@@ -178,11 +179,12 @@ Just _ -> do -- LB8.unpack `fmap` simpleHttp s -- http-conduit is complex, cf https://github.com/snoyberg/http-conduit/issues/97- r <- parseUrl s+ r <- parseUrlThrow s let cachecontrol = cache_control opts r' | null cachecontrol = r | otherwise = r{requestHeaders=(hCacheControl, B8.pack cachecontrol):requestHeaders r}- rsp <- httpLbs r' manager+ r'' = r'{requestHeaders=(hUserAgent, B8.pack $ uagent opts):requestHeaders r'}+ rsp <- httpLbs r'' manager return $ LB8.unpack $ responseBody rsp Nothing -> opterror $ "could not parse URI: " ++ s @@ -264,3 +266,7 @@ ,let i = maybe "" show $ getItemId item ] +writeList2Chan :: TChan a -> [a] -> IO ()+writeList2Chan q as = do+ atomically $ forM as $ \a -> writeTChan q a+ return ()
Irc.hs view
@@ -10,14 +10,16 @@ module Irc where -import Control.Concurrent+import Control.Concurrent (threadDelay)+import Control.Concurrent.STM import Control.Exception import Control.Monad+import Data.ByteString.Char8 as B8 (pack, unpack) import Data.List import Data.Maybe import Data.Time.Clock (getCurrentTime,diffUTCTime) import Network (PortID(PortNumber), connectTo)-import Network.IRC (Message(Message),msg_command,msg_params,decode,encode,nick,user,joinChan,privmsg)+import Network.IRC (Message(Message),msg_command,msg_params,decode,encode,joinChan,privmsg) import Prelude hiding (log) import System.IO (BufferMode(NoBuffering),stdout,hSetBuffering,hFlush,hClose,hGetLine,hPutStr) import Text.Printf@@ -38,12 +40,12 @@ h <- connectTo srv (PortNumber $ fromIntegral p) hSetBuffering h NoBuffering return bot{socket=h}- ircWrite opts bot' $ encode $ nick n- ircWrite opts bot' $ encode $ user defusername "0" "*" (ident opts)+ ircWrite opts bot' n+ ircWrite opts bot' $ if null (ident opts) then defusername else ident opts (connected,err) <- if null srv then return (True,"") else ircWaitForConnectConfirmation opts bot' -- some servers require this unless connected $ throw $ IrcException err- ircWrite opts bot' $ encode $ joinChan c+ ircWrite opts bot' $ B8.unpack $ encode $ joinChan $ B8.pack c unless (quiet opts) $ log "connected." return app{aBot=bot'} @@ -118,7 +120,7 @@ ircAnnouncer !appvar = do -- wait for something to announce App{aBot=Bot{announcequeue=q}} <- getSharedVar appvar- ann <- readChan q+ ann <- atomically $ readTChan q -- re-read bot to get an up-to-date idle time app@App{aOpts=opts, aBot=bot@Bot{server=srv,batchindex=i}} <- getSharedVar appvar idletime <- channelIdleTime bot@@ -132,7 +134,7 @@ when (debug_irc opts) $ log $ printf "sent %d messages in this batch, max is %d, sleeping for %dm" i batchsize pollinterval threadDelay $ pollinterval * minutes- unGetChan q ann+ atomically $ unGetTChan q ann putSharedVar appvar app{aBot=bot{batchindex=0}} ircAnnouncer appvar | requiredidle > 0 && (idletime < requiredidle) = do@@ -141,7 +143,7 @@ when (debug_irc opts) $ log $ printf "channel has been idle %dm, %dm required, sleeping for %dm" idletime requiredidle idleinterval threadDelay $ idleinterval * minutes- unGetChan q ann+ atomically $ unGetTChan q ann ircAnnouncer appvar | otherwise = do -- ok, announce it@@ -150,7 +152,7 @@ | otherwise = printf " and channel has been idle %dm" idletime log $ printf "sent %d messages in this batch%s, sending next" i s let (a,rest) = splitAnnouncement ann- when (not $ null rest) $ unGetChan q rest+ when (not $ null rest) $ atomically $ unGetTChan q rest ircPrivmsg opts bot a threadDelay $ sendinterval * seconds putSharedVar appvar app{aBot=bot{batchindex=i+1}}@@ -173,7 +175,7 @@ -- | Send a privmsg to the bot's irc server & channel, and to stdout unless --quiet is in effect. ircPrivmsg :: Opts -> Bot -> String -> IO () ircPrivmsg opts bot@(Bot{channel=c}) msg = do- ircWrite opts bot $ encode $ privmsg c msg'+ ircWrite opts bot $ B8.unpack $ encode $ privmsg (B8.pack c) (B8.pack msg') unless (quiet opts) $ putStrLn msg >> hFlush stdout where msg' | use_actions opts = "\1ACTION " ++ msg ++ "\1"@@ -186,13 +188,13 @@ unless (null srv) $ hPutStr h (s++"\r\n") isMessage :: String -> Bool-isMessage s = isPrivmsg s && not ("VERSION" `elem` (msg_params $ fromJust $ decode s))+isMessage s = isPrivmsg s && not ("VERSION" `elem` (maybe [] msg_params $ decode $ B8.pack s)) isPrivmsg :: String -> Bool-isPrivmsg s = case decode s of Just Message{msg_command="PRIVMSG"} -> True- _ -> False+isPrivmsg s = case decode $ B8.pack s of Just Message{msg_command="PRIVMSG"} -> True+ _ -> False isPing :: String -> Bool-isPing s = case decode s of Just Message{msg_command="PING"} -> True- _ -> False+isPing s = case decode $ B8.pack s of Just Message{msg_command="PING"} -> True+ _ -> False
+ README.md view
@@ -0,0 +1,17 @@+rss2irc is an IRC bot that polls an RSS or Atom feed and announces+updates to an IRC channel, with options for customizing output and+behavior. It aims to be an easy-to-use, reliable, well-behaved bot.++Usage: `rss2irc [OPTIONS] FEEDURL [IRCSERVER[:PORT]/[#]CHANNEL/NICK]`++Example:++ $ rss2irc http://hackage.haskell.org/packages/archive/recent.rss irc.freenode.net/mychannel/mybot++Known limitations:++- If the feed goes down for a while and then comes back up, the bot may re-announce all items.++- Memory is leaked on each poll, causing rss2irc bots to consume more memory over time.+ This will be more noticeable when feeds have large content and are polled frequently.+ Restarting rss2irc bots daily is recommended.
Utils.hs view
@@ -14,17 +14,17 @@ ) where import Codec.Binary.UTF8.String as UTF8 (decodeString, encodeString, isUTF8Encoded)-import Control.Concurrent+import Control.Concurrent.MSampleVar import Control.Monad import Data.List import Data.Maybe import Data.Time.Clock (UTCTime,getCurrentTime)-import Data.Time.Format (parseTime)+import Data.Time.Format (parseTimeM) import Data.Time.LocalTime (LocalTime,getCurrentTimeZone,utcToLocalTime) import Prelude hiding (log) import System.Info import System.IO (stdout,hFlush)-import System.Locale (defaultTimeLocale)+import Data.Time.Format (defaultTimeLocale) import Text.Feed.Query import Text.Feed.Types (Item) import Text.ParserCombinators.Parsec hiding (label)@@ -50,19 +50,19 @@ -- Light abstraction layer for thread-safe mutable data -type Shared a = SampleVar a+type Shared a = MSampleVar a -newSharedVar :: a -> IO (SampleVar a)-newSharedVar = newSampleVar+newSharedVar :: a -> IO (MSampleVar a)+newSharedVar = newSV -getSharedVar :: SampleVar a -> IO a+getSharedVar :: MSampleVar a -> IO a getSharedVar v = do- x <- readSampleVar v- writeSampleVar v x+ x <- readSV v+ writeSV v x return x -putSharedVar :: SampleVar a -> a -> IO ()-putSharedVar v x = writeSampleVar v x+putSharedVar :: MSampleVar a -> a -> IO ()+putSharedVar v x = writeSV v x -- Option parsing helpers @@ -211,7 +211,7 @@ -- | Parse a datetime string if possible, trying at least the formats -- likely to be used in RSS/Atom feeds. parseDateTime :: String -> Maybe UTCTime-parseDateTime s = firstJust [parseTime defaultTimeLocale f s' | f <- formats]+parseDateTime s = firstJust [parseTimeM True defaultTimeLocale f s' | f <- formats] where s' = adaptForParseTime s adaptForParseTime = gsubRegexPR "(....-..-..T..:..:..[\\+\\-]..):(..)" "\\1\\2" -- 2009-09-22T13:10:56+00:00@@ -268,10 +268,10 @@ strip = lstrip . rstrip lstrip = dropws rstrip = reverse . dropws . reverse-dropws = dropWhile (`elem` " \t")+dropws = dropWhile (`elem` (" \t"::String)) chomp :: String -> String-chomp = reverse . dropWhile (`elem` "\n\r") . reverse+chomp = reverse . dropWhile (`elem` ("\n\r"::String)) . reverse isLeft :: Either a b -> Bool isLeft (Left _) = True
rss2irc.cabal view
@@ -1,5 +1,6 @@ name: rss2irc-version: 1.0.6+-- also set version in Base.hs+version: 1.1 homepage: http://hackage.haskell.org/package/rss2irc license: BSD3 license-file: LICENSE@@ -18,39 +19,47 @@ > $ rss2irc http://hackage.haskell.org/packages/archive/recent.rss mybot@irc.freenode.org/#haskell stability: beta-tested-with: GHC==7.6.3-cabal-version: >= 1.6+tested-with: GHC==8.0+cabal-version: >= 1.10 build-type: Simple-extra-source-files: CHANGES +extra-source-files:+ CHANGES+ README.md+ stack.yaml+ executable rss2irc main-is: rss2irc.hs other-modules: Base, Utils, Feed, Irc+ default-language: Haskell2010 ghc-options: -threaded -Wall -fno-warn-orphans -fno-warn-unused-do-bind build-depends: base >= 4 && < 5+ ,SafeSemaphore >= 0.10 && < 1.1 ,bytestring- ,cabal-file-th ,cmdargs ,containers ,deepseq- ,irc >= 0.5 && < 0.6- ,feed >= 0.3.9 && < 0.3.10- ,http-client >= 0.2.1 && < 0.2.3- ,http-conduit >= 1.9 && < 2.1- ,resourcet >= 0.4.4 && < 0.5- ,http-types >= 0.6.4 && < 0.9+ ,irc >= 0.6 && < 0.7+ ,feed >= 0.3.9 && < 0.4+ ,http-client >= 0.2.1 && < 0.5+ ,http-conduit >= 1.9 && < 2.2+ ,resourcet >= 0.4.4 && < 1.2+ ,http-types >= 0.6.4 && < 1.0 ,io-storage >= 0.3 && < 0.4- ,network >= 2.4 && < 2.5+ ,network >= 2.6 && < 2.7+ ,network-uri >= 2.6 && < 2.7 ,old-locale ,parsec ,regexpr >= 0.5 && < 0.6 ,safe >= 0.2 && < 0.4 ,split >= 0.2 && < 0.3- ,text == 0.11.*- ,transformers >= 0.2 && < 0.4- ,time >= 1.1 && < 1.5+ ,stm >= 2.1 && < 3.0+ ,text >= 0.11 && < 1.3+ ,transformers >= 0.2 && < 0.6+ ,time >= 1.5 && < 1.7 ,utf8-string+ ,SafeSemaphore source-repository head type: darcs
rss2irc.hs view
@@ -12,6 +12,7 @@ module Main where import Control.Concurrent+import Control.Concurrent.STM import Control.Exception import Control.Monad (when,unless) import Data.Maybe@@ -40,7 +41,7 @@ opterror "--interval 0 requires --num-iterations 10 or less" seq (applyReplacements opts "") $ return () -- report any bad --replace regexp return opts- q <- newChan+ q <- atomically $ newTChan t <- getCurrentTime let reader = Reader{httpManager=Nothing ,iterationsleft=num_iterations opts
+ stack.yaml view
@@ -0,0 +1,10 @@+resolver: lts-7.7++packages:+- '.'++#flags: {}++extra-deps:+- mtlparse-0.1.4.0+- regexpr-0.5.4