[Fencommits] fenserve: make sure that we control the input list of code we execute (didn't yet make sure that there is no unsafe stuff on it; this just makes sure that the pages we execute can't import more)
Benja Fallenstein
benja.fallenstein at gmail.com
Fri Mar 23 05:11:57 EET 2007
Fri Mar 23 05:11:35 EET 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* make sure that we control the input list of code we execute (didn't yet make sure that there is no unsafe stuff on it; this just makes sure that the pages we execute can't import more)
diff -rN -u old-fenserve/FenServe.hs new-fenserve/FenServe.hs
--- old-fenserve/FenServe.hs 2007-03-23 05:11:57.000000000 +0200
+++ new-fenserve/FenServe.hs 2007-03-23 05:11:57.000000000 +0200
@@ -52,6 +52,7 @@
import System.IO
import System.IO.Unsafe (unsafePerformIO)
import qualified System.Plugins as Plugins
+import System.Time
fs = "http://fenfire.org/2007/fenserve#"
fs_Directory = IRI "http://fenfire.org/2007/fenserve#Directory"
@@ -268,31 +269,31 @@
s <- getBlock (bID code)
let errH stage msg = return $ \req -> return $
mkResult 500 "text/plain" $ toUTF $ stage ++ " failed:\n" ++ msg
- h <- case Hsx.parseModuleWithMode (Hsx.ParseMode "Page.hs") $ fromUTF s of
+ s2 = "module Page_" ++ (blockId $ bID code) ++ " where\n" ++
+ "dummyAssignment = 0\n" ++ fromUTF s
+ -- the 'dummyAssignment' is to make sure that
+ -- pages can't import anything -- imports are
+ -- syntactically disallowed except at the beginning
+ h <- case Hsx.parseModuleWithMode (Hsx.ParseMode "Page.hs") $ s2 of
ParseFailed (SrcLoc file line col) err -> errH "HSP preprocessing" $
"At "++show line++":"++show col++" in "++file++": "++err
ParseOk parsed -> return $ unsafePerformIO $ do
- --putStrLn "STARTING"
let s' = Hsx.prettyPrintWithMode (Hsx.defaultMode
{Hsx.linePragmas=True}) $ Hsx.transform parsed
- --putStrLn "FOO"
+
+ putStrLn (unlines $ take 10 $ lines s')
+
(fp,hdl) <- openTempFile "/tmp" "fenserve.page"
- --putStrLn $ "BAR"
hPutStr hdl s'
- --putStrLn "BAZ"
hClose hdl
- --putStrLn "MAKING"
let dir = "dist/build/fenserve/fenserve-tmp"
homedir <- getEnv "HOME"
makeResult <- Plugins.makeWith fp "Page.stub" ["-i"++dir, "-fglasgow-exts", "-fallow-overlapping-instances"]
- --putStrLn "MADE"
h' <- case makeResult of
Plugins.MakeFailure err ->
errH "Make" $ concat (List.intersperse "\n" err)
Plugins.MakeSuccess _ o -> do
- --putStrLn "LOADING"
loadResult <- Plugins.load o [dir] [homedir ++ "/.ghc/i386-linux-6.6/package.conf"] "handler"
- --putStrLn "LOADED"
case loadResult of
Plugins.LoadSuccess _ v -> return v
Plugins.LoadFailure err ->
@@ -301,6 +302,21 @@
h req -- run the loaded handler
+-------------------------------------------------------------------------
+-- Unsafe function for getting current time as a literal
+-- -- this shouldn't be here, just needs to be accessible from pages
+-------------------------------------------------------------------------
+
+unsafeGetW3CTime () = Literal (iso8601 y (fromEnum mo + 1) d h m s) Plain where
+ time = unsafePerformIO $ getClockTime -- XXX
+ CalendarTime y mo d h m s ps wd yd tzn tz isDST = toUTCTime $ time
+
+iso8601 y mo d h m s =
+ let p n i = take (n - length (show i)) (repeat '0') ++ show i
+ in p 4 y ++ '-':p 2 mo ++ '-':p 2 d ++
+ 'T':p 2 h ++ ':':p 2 m ++ ':':p 2 s ++ ['Z']
+
+
--------------------------------------------------------------------------
-- Copied from HAppS.Protocols.SimpleHTTP2, which is BSD3-licensed
--------------------------------------------------------------------------
diff -rN -u old-fenserve/Page.stub new-fenserve/Page.stub
--- old-fenserve/Page.stub 2007-03-23 05:11:57.000000000 +0200
+++ new-fenserve/Page.stub 2007-03-23 05:11:57.000000000 +0200
@@ -3,12 +3,20 @@
-}
module PageStub where
+import Fenfire.RDF
+
import HAppS hiding (Handler, query)
-import Storm (toUTF)
+import Storm
import FenServe
-import qualified Data.Map
+import Control.Monad
+
+import qualified Data.ByteString as ByteString
+import qualified Data.List as List
+import qualified Data.Map as Map
+import Data.Maybe
+
pageHandler :: HTML -> Handler
pageHandler html _request =
diff -rN -u old-fenserve/board-demo.page new-fenserve/board-demo.page
--- old-fenserve/board-demo.page 2007-03-23 05:11:57.000000000 +0200
+++ new-fenserve/board-demo.page 2007-03-23 05:11:57.000000000 +0200
@@ -1,12 +1,4 @@
-import Fenfire.RDF
-
-import qualified Data.List as List
-import Data.Maybe (fromMaybe, catMaybes)
-
-import System.Time
-import System.IO.Unsafe (unsafePerformIO)
-
dc = "http://purl.org/dc/elements/1.1/"
dcterms = "http://purl.org/dc/terms/"
sioc = "http://rdfs.org/sioc/ns#"
@@ -151,19 +143,3 @@
(Just "post", POST) -> postHandler req
(Just "edit", POST) -> editHandler req
_ -> pageHandler (renderBoard blog) req
-
-
--------------------------------------------------------------------------
--- Utilities.
--------------------------------------------------------------------------
-
-unsafeGetW3CTime () = Literal (iso8601 y (fromEnum mo + 1) d h m s) Plain where
- time = unsafePerformIO $ getClockTime -- XXX
- CalendarTime y mo d h m s ps wd yd tzn tz isDST = toUTCTime $ time
-
-iso8601 y mo d h m s =
- let p n i = take (n - length (show i)) (repeat '0') ++ show i
- in p 4 y ++ '-':p 2 mo ++ '-':p 2 d ++
- 'T':p 2 h ++ ':':p 2 m ++ ':':p 2 s ++ ['Z']
-
-
diff -rN -u old-fenserve/code-demo.page new-fenserve/code-demo.page
--- old-fenserve/code-demo.page 2007-03-23 05:11:57.000000000 +0200
+++ new-fenserve/code-demo.page 2007-03-23 05:11:57.000000000 +0200
@@ -1,10 +1,4 @@
-import Storm (getBlock, addBlock, fromUTF, toUTF)
-
-import Control.Monad (liftM)
-import qualified Data.ByteString as ByteString
-import Data.Maybe (fromMaybe)
-
handler req = do
let path' = fromMaybe "/edit" $ lookM req "path"
More information about the Fencommits
mailing list