12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667 |
- {-
- expireGititCache - (C) 2009 John MacFarlane, licensed under the GPL
- This program is designed to be used in post-update hooks and other scripts.
- Usage: expireGititCache base-url [file..]
- Example:
- expireGititCache http://localhost:5001 page1.page foo/bar.hs "Front Page.page"
- will produce POST requests to http://localhost:5001/_expire/page1,
- http://localhost:5001/_expire/foo/bar.hs, and
- http://localhost:5001/_expire/Front Page.
- Return statuses:
- 0 -> the cached page was successfully expired (or was not cached in the first place)
- 1 -> fewer than two arguments were supplied
- 3 -> did not receive a 200 OK response from the request
- 5 -> could not parse the uri
- -}
- module Main
- where
- import Network.HTTP
- import System.Environment
- import Network.URI
- import System.FilePath
- import Control.Monad
- import System.IO
- import System.Exit
- main :: IO ()
- main = do
- args <- getArgs
- (uriString : files) <- if length args < 2
- then usageMessage >> return [""]
- else return args
- uri <- case parseURI uriString of
- Just u -> return u
- Nothing -> do
- hPutStrLn stderr ("Could not parse URI " ++ uriString)
- exitWith (ExitFailure 5)
- forM_ files (expireFile uri)
- usageMessage :: IO ()
- usageMessage = do
- hPutStrLn stderr $ "Usage: expireGititCache base-url [file..]\n" ++
- "Example: expireGititCache http://localhost:5001 page1.page foo/bar.hs"
- exitWith (ExitFailure 1)
- expireFile :: URI -> FilePath -> IO ()
- expireFile uri file = do
- let path' = if takeExtension file == ".page"
- then dropExtension file
- else file
- let uri' = uri{uriPath = "/_expire/" ++ urlEncode path'}
- resResp <- simpleHTTP Request{rqURI = uri', rqMethod = POST, rqHeaders = [], rqBody = ""}
- case resResp of
- Left connErr -> error $ show connErr
- Right (Response (2,0,0) _ _ _) -> return ()
- _ -> do
- hPutStrLn stderr ("Request for " ++ show uri' ++ " did not return success status")
- exitWith (ExitFailure 3)
|