diff --git a/src/compiler/GFServer.hs b/src/compiler/GFServer.hs index 049b60d26..f0c120b9c 100644 --- a/src/compiler/GFServer.hs +++ b/src/compiler/GFServer.hs @@ -18,7 +18,7 @@ import GF.System.Directory(doesDirectoryExist,doesFileExist,createDirectory, import Data.Time (getCurrentTime,formatTime) import System.Locale(defaultTimeLocale,rfc822DateFormat) import System.FilePath(dropExtension,takeExtension,takeFileName,takeDirectory, - ()) + (),makeRelative) #ifndef mingw32_HOST_OS import System.Posix.Files(getSymbolicLinkStatus,isSymbolicLink,removeLink, createSymbolicLink) @@ -158,7 +158,9 @@ handle logLn documentroot state0 cache execute1 stateVar -- "/stop" -> -- "/start" -> "/parse" -> parse (decoded qs) - "/version" -> return (ok200 gf_version) + "/version" -> do (c1,c2) <- PS.listPGFCache cache + let rel = map (makeRelative documentroot) + return $ ok200 (unlines (gf_version:"":rel c1++"":rel c2)) "/flush" -> do PS.flushPGFCache cache; return (ok200 "flushed") '/':rpath -> -- This code runs without mutual exclusion, so it must *not* diff --git a/src/server/Cache.hs b/src/server/Cache.hs index bde07745a..c845bb013 100644 --- a/src/server/Cache.hs +++ b/src/server/Cache.hs @@ -1,4 +1,4 @@ -module Cache (Cache,newCache,flushCache,readCache,readCache') where +module Cache (Cache,newCache,flushCache,listCache,readCache,readCache') where import Control.Concurrent.MVar import Data.Map (Map) @@ -22,6 +22,9 @@ flushCache :: Cache a -> IO () flushCache c = do modifyMVar_ (cacheObjects c) (const (return Map.empty)) performGC +listCache :: Cache a -> IO [FilePath] +listCache = fmap Map.keys . readMVar . cacheObjects + readCache :: Cache a -> FilePath -> IO a readCache c file = snd `fmap` readCache' c file diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs index 3441554ec..4024c0496 100644 --- a/src/server/PGFService.hs +++ b/src/server/PGFService.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} module PGFService(cgiMain,cgiMain',getPath, logFile,stderrToFile, - newPGFCache,flushPGFCache) where + newPGFCache,flushPGFCache,listPGFCache) where import PGF (PGF) import qualified PGF @@ -57,11 +57,13 @@ newPGFCache = do pgfCache <- newCache PGF.readPGF return (pgf,({-pc-})) return (pgfCache,cCache) flushPGFCache (c1,c2) = flushCache c1 >> flushCache c2 +listPGFCache (c1,c2) = (,) # listCache c1 % listCache c2 #else type Caches = (Cache PGF,()) newPGFCache = do pgfCache <- newCache PGF.readPGF return (pgfCache,()) flushPGFCache (c1,_) = flushCache c1 +listPGFCache (c1,_) = (,) # listCache c1 % return [] #endif getPath =