gf -server: include list of loaded PGFs in version info

This commit is contained in:
hallgren
2014-05-12 13:45:36 +00:00
parent ca0c203877
commit 3c110cbe8d
3 changed files with 11 additions and 4 deletions

View File

@@ -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*

View File

@@ -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

View File

@@ -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 =