archiver 0.5.1 → 0.6.0
raw patch · 3 files changed
+36/−38 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Network/URL/Archiver.hs +25/−32
- archiver.cabal +1/−1
- archiver.hs +10/−5
Network/URL/Archiver.hs view
@@ -1,65 +1,58 @@ module Network.URL.Archiver (checkArchive) where -import Control.Monad (when)+import Control.Monad (when, unless, void) import Data.Char (isAlphaNum, isAscii) import Data.List (isPrefixOf)-import Data.Maybe (fromJust)-import Network.Browser (browse, formToRequest, request, Form(..))-import Network.HTTP (getRequest, rspBody, simpleHTTP, RequestMethod(POST))-import Network.URI (isURI, parseURI, uriPath)+import Network.HTTP (getRequest, simpleHTTP)+import Network.URI (isURI) import System.Random (getStdGen, randomR) import Text.Printf (printf) --- | Open a URL, and return either the HTML source or an error.--- openURL :: String -> IO (Result (Response String))-openURL = simpleHTTP . getRequest+-- | Open a URL+pingURL :: String -> IO ()+pingURL = void . simpleHTTP . getRequest --- | Error check the URL and then archive it using 'webciteArchive', 'alexaArchive', and 'alexaToolbar'+-- | Error check the URL and then archive it using 'webciteArchive', 'wikiwixArchive', 'internetArchiveLive', and 'alexaToolbar' checkArchive :: String -- ^ email for WebCite to send status to -> String -- ^ URL to archive -> IO ()-checkArchive email url = when (isURI url) (alexaToolbar url >> webciteArchive email url >> alexaArchive url >> internetArchiveLive url >> wikiwixArchive url)+checkArchive email url = when (isURI url) (alexaToolbar url >> webciteArchive email url >> internetArchiveLive url >> wikiwixArchive url >> googleSearch url) {- | Request <http://www.webcitation.org> to copy a supplied URL; WebCite does on-demand archiving, unlike Alexa/Internet Archive, and so in practice this is the most useful function. This function throws away any return status from WebCite (which may be changed in the future), so it is suggested that one test with a valid email address.- This and 'alexArchive' ignore any attempt to archive the archive's existing pages, since that is useless.+ This ignores any attempt to archive the archive's existing pages, since that is useless. /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 \~30 seconds between each URL request. -} webciteArchive :: String -> String -> IO ()-webciteArchive email url = when (not $ "http://www.webcitation.org" `isPrefixOf` url) $- void $ openURL ("http://www.webcitation.org/archive?url=" ++ url ++ "&email=" ++ email)- where void = (>> return ()) -- TODO replace with Control.Monad.void in GHC7+webciteArchive email url = unless ("http://www.webcitation.org" `isPrefixOf` url) $+ pingURL ("http://www.webcitation.org/archive?url="++url++ "&email="++email) -- | Request a URL through Internet Archive's live Internet mirror; this is completely speculative and may result in no archiving. -- This method is a guess based on my use of their mirror and a banner that is sometimes inserted; -- see <http://www.archive.org/post/380853/virus-operating-in-internet-archive> internetArchiveLive :: String -> IO ()-internetArchiveLive url = openURL ("http://liveweb.archive.org/"++url) >> return ()---- | Request <http://www.alexa.com> to spider a supplied URL. Alexa supplies the Internet Archive's caches.-alexaArchive :: String -> IO ()-alexaArchive url = when (not $ "http://www.archive.org" `isPrefixOf` 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") $- print $ "Request failed! Alexa changed webpages? Response:" ++ rspBody resp+internetArchiveLive url = pingURL ("http://liveweb.archive.org/"++url) -- | Ping Alexa's servers like the Toolbar does; this may or may not result in any archiving. alexaToolbar :: String -> IO () alexaToolbar url = do gen <- getStdGen let rint = fst $ randomR (1000::Int,20000) gen let payload = "wid=" ++ show rint ++ "&ref=&url=" ++ escape url- _ <- openURL $ "http://data.alexa.com/data/SbADd155Tq0000?cli=10&ver=spkyf-1.5.0&dat=ns&cdt=rq=0&" ++ payload+ pingURL ("http://data.alexa.com/data/SbADd155Tq0000?cli=10&ver=spkyf-1.5.0&dat=ns&cdt=rq=0&"++payload) return ()- where escape :: String -> String- escape = concatMap escapeURIChar- escapeURIChar :: Char -> String- escapeURIChar c | isAscii c && isAlphaNum c = [c]- | otherwise = concatMap (printf "%%%02X") [c] wikiwixArchive :: String -> IO ()-wikiwixArchive url = openURL ("http://archive.wikiwix.com/cache/?url="++url) >> return ()+wikiwixArchive url = pingURL ("http://archive.wikiwix.com/cache/?url="++url)++-- can't hurt to let Google know it exists+googleSearch :: String -> IO ()+googleSearch url = pingURL ("http://www.google.com/search?q=" ++ escape url)++-- | Utility function to URL-encode a string for use in URL arguments; copied from somewhere+escape :: String -> String+escape = concatMap escapeURIChar+escapeURIChar :: Char -> String+escapeURIChar c | isAscii c && isAlphaNum c = [c]+ | otherwise = concatMap (printf "%%%02X") [c]
archiver.cabal view
@@ -1,5 +1,5 @@ name: archiver-version: 0.5.1+version: 0.6.0 license: BSD3 license-file: LICENSE
archiver.hs view
@@ -1,14 +1,14 @@ {-# LANGUAGE ScopedTypeVariables #-} import Control.Concurrent (threadDelay) import qualified Control.Exception as CE (catch, IOException)-import Control.Monad (liftM, unless, when)+import Control.Monad (liftM, unless, void, when) import Data.List (delete) import qualified Data.Set as S (fromList, toList) import Data.Maybe (fromMaybe) import Network.HTTP (getRequest, simpleHTTP) import Network.URI (isURI) import System.Environment (getArgs)-import System.Process (runCommand)+import System.Process (runCommand, terminateProcess) import qualified Data.ByteString.Char8 as B (count, intercalate, length, readFile, singleton, split, unpack, writeFile, ByteString) import System.Random @@ -35,9 +35,14 @@ let email' = fromMaybe "nobody@mailinator.com" email when (isURI url') $ do checkArchive email' url' print url'- maybe (return ()) (\x -> runCommand (x ++ " " ++ url') >> return ()) sh+ hdl <- case sh of+ Nothing -> return Nothing+ Just sh' -> return $ Just (runCommand (sh' ++ " " ++ url')) -- banned >=100 requests/hour; choke it- threadDelay 26000000 -- ~26 seconds+ threadDelay 28000000 -- 28 seconds+ case hdl of+ Nothing -> return ()+ Just hdl' -> void $ liftM terminateProcess hdl' unless (null rest) (writePages file url >> archivePage file email sh) -- rid of leading \n -- re-reads a possibly modified 'file' from disk, removes the archived URL from it, and writes it back out for 'archivePage' to read immediately@@ -52,6 +57,6 @@ splitRandom s = do let ss = B.split '\n' s let l = B.count '\n' s i <- getStdRandom (randomR (0,l))- let randpick = if length ss > 1 then ss !! i else ss !! 0+ let randpick = if length ss > 1 then ss !! i else head ss let removed = Data.List.delete randpick ss return (randpick, removed)