diff --git a/Network/URL/Archiver.hs b/Network/URL/Archiver.hs --- a/Network/URL/Archiver.hs +++ b/Network/URL/Archiver.hs @@ -18,7 +18,7 @@ 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) +checkArchive email url = when (isURI url) (alexaToolbar url >> webciteArchive email url >> alexaArchive url >> internetArchiveLive url >> wikiwixArchive url) {- | Request 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 @@ -32,6 +32,12 @@ void $ openURL ("http://www.webcitation.org/archive?url=" ++ url ++ "&email=" ++ email) where void = (>> return ()) -- TODO replace with Control.Monad.void in GHC7 +-- | 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 +internetArchiveLive :: String -> IO () +internetArchiveLive url = openURL ("http://liveweb.archive.org/"++url) >> return () + -- | Request 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) $ @@ -46,11 +52,14 @@ alexaToolbar :: String -> IO () alexaToolbar url = do gen <- getStdGen let rint = fst $ randomR (1000::Int,20000) gen - let payload = "rq=0&wid=" ++ show rint ++ "&ref=&url=" ++ escape url - _ <- openURL $ "http://data.alexa.com/data/SbADd155Tq0000?cli=10&ver=spkyf-1.5.0&dat=ns&cdt=" ++ payload + 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 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 () diff --git a/archiver.cabal b/archiver.cabal --- a/archiver.cabal +++ b/archiver.cabal @@ -1,5 +1,5 @@ name: archiver -version: 0.5 +version: 0.5.1 license: BSD3 license-file: LICENSE @@ -10,9 +10,9 @@ synopsis: Archive supplied URLs in WebCite & Internet Archive description: archiver is a daemon which will process a specified text file, each line of which is a URL, and will (randomly) one by one request that - the URLs be archived or spidered by and - for future reference. (One may optionally specify - an arbitrary `sh` command like "wget --page-requisites" to download URLs locally.) + the URLs be archived or spidered by , + , and for future reference. + (One may optionally specify an arbitrary `sh` command like `wget` to download URLs locally.) . Because the interface is a simple text file, this can be combined with other scripts; for example, a script using Sqlite to extract diff --git a/archiver.hs b/archiver.hs --- a/archiver.hs +++ b/archiver.hs @@ -9,7 +9,7 @@ import Network.URI (isURI) import System.Environment (getArgs) import System.Process (runCommand) -import qualified Data.ByteString.Char8 as B (count, intercalate, readFile, singleton, split, unpack, writeFile, ByteString) +import qualified Data.ByteString.Char8 as B (count, intercalate, length, readFile, singleton, split, unpack, writeFile, ByteString) import System.Random import Network.URL.Archiver (checkArchive) @@ -29,15 +29,15 @@ threadDelay 90000000 >> archivePage file email sh Right _ -> do -- we have access to the WWW, it seems. proceeding with mission! contents <- B.readFile file + when (B.length contents == 0) $ threadDelay 90000000 (url,rest) <- splitRandom contents let url' = B.unpack url let email' = fromMaybe "nobody@mailinator.com" email when (isURI url') $ do checkArchive email' url' print url' + maybe (return ()) (\x -> runCommand (x ++ " " ++ url') >> return ()) sh -- banned >=100 requests/hour; choke it threadDelay 26000000 -- ~26 seconds - - maybe (return ()) (\x -> runCommand (x ++ " " ++ url') >> return ()) sh 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 +52,6 @@ splitRandom s = do let ss = B.split '\n' s let l = B.count '\n' s i <- getStdRandom (randomR (0,l)) - let randpick = ss !! i + let randpick = if length ss > 1 then ss !! i else ss !! 0 let removed = Data.List.delete randpick ss return (randpick, removed)