archiver (empty) → 0.1

raw patch · 5 files changed

+130/−0 lines, 5 filesdep +HTTPdep +basedep +bytestringsetup-changed

Dependencies added: HTTP, base, bytestring, curl, hinotify, network

Files

• LICENSE +28/−0
• Network/URL/Archiver.hs +34/−0
• Setup.lhs +3/−0
• archiver.cabal +31/−0
• archiver.hs +34/−0

@@ -0,0 +1,28 @@+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,34 @@+module Network.URL.Archiver where++import Control.Monad (when)+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)+++-- | Error check the URL and then archive it using 'webciteArchive' and 'alexaArchive'+checkArchive :: String -- ^ email for WebCite to send status to +                -> String -- ^ URL to archive+                -> IO ()+checkArchive email url = when (isURI url) (webciteArchive email url >> alexaArchive 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.+ +   /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. -}+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.+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

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

@@ -0,0 +1,31 @@+name:                archiver+version:             0.1++license:             BSD3+license-file:        LICENSE+author:              Gwern+maintainer:          Gwern <gwern0@gmail.com>++category:            Documentation, Network+synopsis:            Archive supplied URLs in WebCite & Internet Archive+description:         archiver is a daemon which will watch 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.+                     .+                     Because the interface is a simple text file, this can be combined+                     with other scripts; for example, a script using Sqlite to extract+                     visited URLs from Firefox, or a program extracting URLs from Pandoc+                     documents.++build-type:          Simple+Cabal-Version:       >= 1.2++Library+        exposed-modules:     Network.URL.Archiver+        build-Depends:       base>=4 && < 5, network, HTTP, curl, hinotify+        ghc-options:         -Wall++Executable archiver+           main-is:       archiver.hs+           build-depends: base>=4 && < 5, bytestring, hinotify

@@ -0,0 +1,34 @@+import Control.Concurrent (threadDelay)+import Control.Monad (forever, when)+import qualified Data.ByteString.Char8 as B (break, drop, length, readFile, unpack, writeFile)+import Data.Maybe (fromMaybe)+import System.Environment (getArgs)++import System.INotify (addWatch, initINotify, EventVariety(AllEvents))++import Network.URL.Archiver (checkArchive)++main :: IO ()+main = do args <- getArgs+          case args of+           (f:[]) ->   watch Nothing f+           (f:e:[]) -> watch (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