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

3 files changed, 11 insertions, 4 deletions

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 =