diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Network/URL/Archiver.hs b/Network/URL/Archiver.hs new file mode 100644 --- /dev/null +++ b/Network/URL/Archiver.hs @@ -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 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 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 diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/archiver.cabal b/archiver.cabal new file mode 100644 --- /dev/null +++ b/archiver.cabal @@ -0,0 +1,31 @@ +name: archiver +version: 0.1 + +license: BSD3 +license-file: LICENSE +author: Gwern +maintainer: Gwern + +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 and + 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 diff --git a/archiver.hs b/archiver.hs new file mode 100644 --- /dev/null +++ b/archiver.hs @@ -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