wp-archivebot (empty) → 0.1

raw patch · 4 files changed

+169/−0 lines, 4 filesdep +HTTPdep +basedep +feedsetup-changed

Dependencies added: HTTP, base, feed, network, parallel, tagsoup

Files

• LICENSE +30/−0
• Main.hs +102/−0
• Setup.lhs +3/−0
• wp-archivebot.cabal +34/−0

@@ -0,0 +1,30 @@+Copyright (c) 2009++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,102 @@+import Control.Concurrent (forkIO)+import Control.Monad (liftM, forM_)+import Data.Char (intToDigit)+import Data.List (isInfixOf, isPrefixOf, foldl', deleteBy, nubBy)+import Data.Maybe (fromJust)+import Network.HTTP hiding (port)+import Network.Stream (ConnError)+import Network.URI+import System.Environment (getArgs)++import Text.HTML.TagSoup (parseTags, Tag(TagOpen))++import Text.Feed.Import (parseFeedString)+import Text.Feed.Types (Feed(RSSFeed))+import Text.RSS.Syntax (rssChannel, rssItems, RSSItem(..))++main :: IO ()+main = do args <- getArgs+          -- Webcite requires a valid email, and they filter out public+          -- emails like mailinator.com. So we demand an email from the user.+          let email = head args+          -- This is largely intended for the English Wikipedia, so we default to En's NewPages+          -- but we let the user override; any second argument is assumed to be a MediaWiki RSS+          let url = if length args > 1 then args !! 1+                     else "http://en.wikipedia.org/w/index.php?title=Special:NewPages&feed=rss"+          reader email url++-- inspiried by rss2irc+-- | wait on an RSS thread, updating every so often. Each RSS item links to some diff or page,+-- in addition to whatever other content the RSS item may contain (date, summary, etc.)+-- This runs 'archiveBot' on just that link, ignoring the rest.+reader :: String -> String -> IO ()+reader email url = items url >>= go+ where+   go old = do new <- items url+               -- remove duplicates+               let diff = foldl' (flip $ deleteBy matchingTitles) new old+               forM_ (take 100 diff) $ \itm ->+                case rssItemLink itm of+                    Nothing -> return ()+                    Just t  -> ignore $ forkIO $ archiveBot email t+               go new++   matchingTitles :: RSSItem -> RSSItem -> Bool+   matchingTitles x y = let title = (fromJust . rssItemTitle) in title x == title y++   -- Actually fetch a RSS feed and turn it from String to [RSSItem]+   items :: String -> IO [RSSItem]+   items rurl = do s <- get' rurl+                   let RSSFeed r = fromJust $ parseFeedString s+                   return $ nubBy matchingTitles $ rssItems $ rssChannel r++-- | Given the URL of an article, we suck down the HTML, grep it for http:// links,+-- filter out certain links that we don't want to archive (boilerplate links, interwiki links)+-- and then fire off an archive request for each link left.+archiveBot :: String -> String -> IO ()+archiveBot email ls = liftM uniq (fetchArticleURLs ls) >>= mapM_ (archiveURL email)+ where  uniq :: [String] -> [String] -- So hideous+        uniq = filter (\x ->not $ any (flip isInfixOf x) exceptions)+        exceptions :: [String]+        exceptions = ["wikimediafoundation", "http://www.mediawiki.org/", "wikipedia",+                      "&curid=", "index.php?title=", "&action="]++-- | Run 'extractURLs' on some page's raw HTML+fetchArticleURLs ::  String -> IO [String]+fetchArticleURLs = fmap extractURLs . get'++-- | Use the TagSoup library to extract all the hyperlinks in a page. This is really parsing the HTML,+-- so hopefully there won't be any spurious links.+extractURLs :: String -> [String]+extractURLs arg = [x | TagOpen "a" atts <- parseTags arg, (_,x) <- atts, "http://" `isPrefixOf` x]++-- | Webcitation.org is set up so one can archive a url just by doing a request for 'webcitation.org/archive?url=url&email=email'+-- So it's very easy, given a URL and an email, to archive a page. You don't even need to see what the response was.+archiveURL :: String -> String -> IO ()+archiveURL email url = print url' >> ignore (get' url')+              where url' = "http://www.webcitation.org/archive?url=" ++ escapeURIString isAllowedInURI url ++ "&email=" ++ email++-- | Convenient wrapper over the complexity of Network.HTTP. Given a URL, we get the raw HTML. No fuss, no muss.+-- Of course, this means we paper over a bunch of possible errors and issues, but we've no time for them! There are links to archive!+get' :: String -> IO String+get' = get . fromJust . parseURI+ where get :: URI -> IO String+       get uri = do resp <- simpleHTTP (request uri) >>= handleE (error . show)+                    case rspCode resp of+                        (2,0,0) -> return (rspBody resp)+                        _ -> error (httpError resp)+           where+               httpError resp = showRspCode (rspCode resp) ++ " " ++ rspReason resp+               showRspCode (a,b,c) = map intToDigit [a,b,c]++               request :: URI -> Request String+               request ur = Request{rqURI=ur, rqMethod=GET, rqHeaders=[], rqBody=""}++               handleE :: Monad m => (ConnError -> m a) -> Either ConnError a -> m a+               handleE h (Left e) = h e+               handleE _ (Right v) = return v++-- | Convenience function. 'forkIO' and 'forM_' demand return types of 'IO ()', but most interesting+-- IO functions don't return void. So one adds a call to 'return ()'; this just factors it out.+ignore ::(Monad m) => m a -> m ()+ignore x = x >> return ()

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,34 @@+name:          wp-archivebot+version:       0.1+license:       BSD3+license-file:  LICENSE+author:        Gwern+maintainer:    gwern0@gmail.com+stability:     Experimental+tested-with:   GHC==6.10.2+category:      Network+synopsis:      Subscribe to a wiki's RSS feed and archive external links+description:   A MediaWiki's RecentChanges or NewPages links to every new edit or article; this bot will+               poll the corresponding RSS feeds (easier and more reliable than parsing the HTML), follow+               the links to the new edit/article, and then use TagSoup to filter out every off-wiki link+               (eg. to http://cnn.com).+               .+               With this list of external links, the bot will then fire off requests to http://webcitation.org/,+               which will make a backup (similar to the Internet Archive, but on-demand).+               .+               Example: to archive links from every article in the English Wikipedia's RecentChanges:+               .+               > wp-archivebot gwern0@gmail.com 'http://en.wikipedia.org/w/index.php?title=Special:RecentChanges&feed=rss'+               .+cabal-version: >= 1.2+build-type:    Simple++executable wp-archivebot+    main-is:       Main.hs++    build-depends: feed,+                   tagsoup,+                   network,+                   HTTP+    build-depends: base >= 3 && < 4, parallel+    ghc-options:   -Wall