archiver 0.1 → 0.2
raw patch · 3 files changed
+42/−29 lines, 3 filesdep −hinotifyPVP ok
version bump matches the API change (PVP)
Dependencies removed: hinotify
API changes (from Hackage documentation)
Files
- Network/URL/Archiver.hs +3/−2
- archiver.cabal +11/−5
- archiver.hs +28/−22
Network/URL/Archiver.hs view
@@ -18,17 +18,18 @@ in the future), so it is suggested that one test with a valid email address. /Warning!/ WebCite has throttling mechanisms; if you request more than 100 URLs per hour, your IP may be banned! It is- suggested that one sleep for \~40 seconds between each URL request. -}+ suggested that one sleep for \~30 seconds between each URL request. -} webciteArchive :: String -> String -> IO () webciteArchive email url = openURL ("http://www.webcitation.org/archive?url=" ++ url ++ "&email=" ++ email) >> return () where openURL = simpleHTTP . getRequest -- | Request <http://www.alexa.com> to spider a supplied URL. Alexa supplies the Internet Archive's caches.+-- TODO: currently broken? Alexa changed pages? is down? alexaArchive :: String -> IO () alexaArchive url = do let archiveform = Form POST (fromJust $ parseURI "http://www.alexa.com/help/crawlrequest") [("url", url), ("submit", "")] (uri, resp) <- browse $ request $ formToRequest archiveform when (uriPath uri /= "/help/crawlthanks") $- error $ "Request failed! Alexa changed webpages? Response:" ++ rspBody resp+ print $ "Request failed! Alexa changed webpages? Response:" ++ rspBody resp
archiver.cabal view
@@ -1,5 +1,5 @@ name: archiver-version: 0.1+version: 0.2 license: BSD3 license-file: LICENSE@@ -8,7 +8,7 @@ category: Documentation, Network synopsis: Archive supplied URLs in WebCite & Internet Archive-description: archiver is a daemon which will watch a specified text file,+description: archiver is a daemon which will process a specified text file, each line of which is a URL, and will one by one request that the URLs be archived or spidered by <http://www.webcitation.org> and <http://www.archive.org> for future reference.@@ -19,13 +19,19 @@ documents. build-type: Simple-Cabal-Version: >= 1.2+Cabal-Version: >= 1.6+stability: provisional+tested-with: GHC==6.12.1 +source-repository head+ type: darcs+ location: http://community.haskell.org/~gwern/archiver/+ Library exposed-modules: Network.URL.Archiver- build-Depends: base>=4 && < 5, network, HTTP, curl, hinotify+ build-Depends: base>=4 && < 5, network, HTTP, curl ghc-options: -Wall Executable archiver main-is: archiver.hs- build-depends: base>=4 && < 5, bytestring, hinotify+ build-depends: base>=4 && < 5, bytestring
archiver.hs view
@@ -1,34 +1,40 @@+{-# LANGUAGE ScopedTypeVariables #-} import Control.Concurrent (threadDelay)-import Control.Monad (forever, when)-import qualified Data.ByteString.Char8 as B (break, drop, length, readFile, unpack, writeFile)+import qualified Control.Exception as CE (catch, IOException)+import Control.Monad (liftM, when)+import Data.List (nub, sort) import Data.Maybe (fromMaybe)+import Network.HTTP (getRequest, simpleHTTP) import System.Environment (getArgs)--import System.INotify (addWatch, initINotify, EventVariety(AllEvents))+import qualified Data.ByteString.Char8 as B (break, intercalate, length, readFile, singleton, split, unpack, writeFile, ByteString) import Network.URL.Archiver (checkArchive) main :: IO () main = do args <- getArgs case args of- (f:[]) -> watch Nothing f- (f:e:[]) -> watch (Just e) f+ (f:[]) -> archivePage Nothing f+ (f:e:[]) -> archivePage (Just e) f _ -> error "must supply a filename or a filename and an email address" -watch :: Maybe String -> FilePath -> IO ()-watch user file = do i <- initINotify- archivePage user file -- empty out existing file, then we add a watch & sleep- _ <- addWatch i [AllEvents] file (\_ -> archivePage user file)- forever $ threadDelay maxBound -- sleep... forever- archivePage :: Maybe String -> FilePath -> IO ()-archivePage user file = do contents <- B.readFile file- let (url,rest) = B.break (=='\n') contents- checkArchive email (B.unpack url)- print url- -- banned >=100 requests/hour; choke to ~1/minute- threadDelay 40000000 -- ~40 seconds- when (B.length rest /= 0) (B.writeFile file (B.drop 1 rest) >> archivePage user file) -- drop to get rid of leading \n- return ()- where- email = fromMaybe "nobody@mailinator.com" user+archivePage usr file = do connectedp <- CE.catch (simpleHTTP (getRequest "http://www.webcitation.org")) (\(_::CE.IOException) -> return (Left undefined))+ case connectedp of+ Left _ -> -- Left = ConnError, network not working! sleep for a minute and try again later+ threadDelay 90000000 >> archivePage usr file+ Right _ -> do -- we have access to the WWW, it seems. proceeding with mission!+ contents <- B.readFile file+ let (url,rest) = B.break (=='\n') contents+ checkArchive email (B.unpack url)+ print url+ -- banned >=100 requests/hour; choke it+ threadDelay 20000000 -- ~20 seconds+ when (B.length rest /= 0) (writePages file url >> archivePage usr file) -- drop to get rid of leading \n+ where email = fromMaybe "nobody@mailinator.com" usr++-- re-reads a possibly modified 'file' from disk, removes the archived URL from it, and writes it back out for 'archivePage' to read immediately+writePages :: FilePath -> B.ByteString -> IO ()+writePages file done = do original <- liftM (B.split '\n') $ B.readFile file+ let new = nub $ sort original+ let final = B.intercalate (B.singleton '\n') $ filter (not . (== done)) new+ B.writeFile file final