From f4f837595ddcfaed8d4d7164e5b16a555e682bc6 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Tue, 19 Feb 2013 13:11:51 +0100 Subject: Send user agent in ./site check Closes #110 --- src/Hakyll/Check.hs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/Hakyll/Check.hs b/src/Hakyll/Check.hs index 5f8f4f7..a426f87 100644 --- a/src/Hakyll/Check.hs +++ b/src/Hakyll/Check.hs @@ -16,11 +16,12 @@ import Control.Monad.RWS (RWST, runRWST) import Control.Monad.State (get, modify) import Control.Monad.Trans (liftIO) import Control.Monad.Writer (tell) -import Data.List (isPrefixOf) +import Data.List (intercalate, isPrefixOf) import Data.Monoid (Monoid (..)) import Data.Set (Set) import qualified Data.Set as S import Data.Typeable (cast) +import GHC.Exts (fromString) import qualified Network.HTTP.Conduit as Http import qualified Network.HTTP.Types as Http import System.Directory (doesDirectoryExist, doesFileExist) @@ -30,11 +31,13 @@ import qualified Text.HTML.TagSoup as TS -------------------------------------------------------------------------------- +import Data.Version (versionBranch) import Hakyll.Core.Configuration import Hakyll.Core.Logger (Logger, Verbosity) import qualified Hakyll.Core.Logger as Logger import Hakyll.Core.Util.File import Hakyll.Web.Html +import qualified Paths_hakyll as Paths_hakyll -------------------------------------------------------------------------------- @@ -172,11 +175,17 @@ checkExternalUrl url = do modify $ S.insert url if isOk then ok url else faulty url where + -- Add additional request info settings r = r - { Http.method = "HEAD" - , Http.redirectCount = 10 + { Http.method = "HEAD" + , Http.redirectCount = 10 + , Http.requestHeaders = ("User-Agent", ua) : Http.requestHeaders r } + -- Nice user agent info + ua = fromString $ "hakyll-check/" ++ + (intercalate "." $ map show $ versionBranch $ Paths_hakyll.version) + -- Catch all the things except UserInterrupt failure logger (SomeException e) = case cast e of Just UserInterrupt -> throw UserInterrupt -- cgit v1.2.3