GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-16 16:29:32 -06:00
Code Issues Packages Projects Releases Wiki Activity

refactoring pgfMain now takes the file path directly

Browse Source
This commit is contained in:
Krasimir Angelov
2024-05-16 19:34:02 +02:00
parent 02e8dcbb56
commit efe00f88e3
2 changed files with 4 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/compiler/api/GF/Server.hs
View File

@@ -117,8 +117,8 @@ handle logLn documentroot state0 cache execute stateVar conn = do
-- use/change the cwd. Access files by absolute paths only.
let path = translatePath rpath
in case (takeDirectory path,takeFileName path,takeExtension path) of
(_ ,_ ,".pgf") -> PS.pgfMain logLn conn cache [("PATH_TRANSLATED",path)] rq
(_ ,_ ,".ngf") -> PS.pgfMain logLn conn cache [("PATH_TRANSLATED",path)] rq
(_ ,_ ,".pgf") -> PS.pgfMain logLn conn cache path rq
(_ ,_ ,".ngf") -> PS.pgfMain logLn conn cache path rq
(dir,"grammars.cgi",_ ) -> addDate (grammarList dir query)
_ -> serveStaticFile conn rpath path
_ -> addDate (return $ resp400 upath)

7
src/server/PGFService.hs
View File

@@ -25,7 +25,6 @@ import System.IO.Error(isDoesNotExistError)
import System.FilePath(takeExtension)
import System.Mem(performGC)
import Network.HTTP
import Network.FastCGI hiding (Connection, writeHeaders)
import Numeric(showHex)
@@ -62,8 +61,8 @@ newCache' root rd = do
clean c = do threadDelay 2000000000 -- 2000 seconds, i.e. ~33 minutes
expireCache (24*60*60) c -- 24 hours
pgfMain :: (String -> IO ()) -> Connection -> Caches -> Env -> Request -> IO ()
pgfMain logLn conn cache env rq =
pgfMain :: (String -> IO ()) -> Connection -> Caches -> FilePath -> Request -> IO ()
pgfMain logLn conn cache path rq =
case fromMaybe "grammar" (lookup "command" query) of
"download"
| ext == ".pgf" -> do tpgf <- getFile (readCache' (pgfCache cache)) path
@@ -77,8 +76,6 @@ pgfMain logLn conn cache env rq =
handleErrors logLn (pgfCommand (qsem cache) command query tpgf) >>= respondHTTP conn
_ -> respondHTTP conn (Response 415 "Bad Request" [] "Extension must be .pgf or .ngf")
where
path = fromMaybe "" (lookup "PATH_TRANSLATED" env `mplus`
lookup "SCRIPT_FILENAME" env)
ext = takeExtension path
query = rqQuery rq