Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

67 lines (54 sloc) 2.085 kB
{-
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)
Jump to Line
Something went wrong with that request. Please try again.