Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 67 lines (54 sloc) 2.085 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
{-
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)
Something went wrong with that request. Please try again.