Make deployable with systemd.

GHCiOnline.cabal

@@ -36,6 +36,7 @@ Executable GHCiOnline
     Other-Modules:  GHCiManager,
                     GHCiParser,
                     Sessions,
+                    State,
                     Timeout,
                     CJail.System.Process
     Ghc-Options: -Wall

Makefile

@@ -0,0 +1,6 @@
+install:
+	cp dist/build/GHCiOnline/GHCiOnline /opt/ghc-online/ghci-online
+	cp -r static/ /opt/ghc-online/
+	cp prod.env /etc/conf.d/ghci-online
+	cp systemd/*.service /etc/systemd/system/
+

Procfile

@@ -0,0 +1 @@
+web: /opt/ghc-online/ghci-online

prod.env

@@ -0,0 +1,6 @@
+CJAIL_PATH=/opt/ghc-online/jail/
+
+GHCI_PATH=/usr/bin/ghci-safe
+GHCI_ARGS=-XSafe, -fpackage-trust, -distrust-all-packages, -trust base
+
+HTML_ROOT=/opt/ghc-online/static/

src/GHCiManager.hs

@@ -15,26 +15,17 @@ import qualified Data.Text.IO as T
 import System.IO
 
 import GHCiParser
-
-type GHCiHandle = ProcessHandle
-
-cjailConf :: CJailConf
-cjailConf = CJailConf Nothing Nothing "/opt/ghc-online/jail/"
-
-ghciPath :: FilePath
-ghciPath = "/usr/bin/ghci-safe"
-
-ghciArgs :: [String]
-ghciArgs = ["-XSafe", "-fpackage-trust", "-distrust-all-packages", "-trust base"]
+import State
 
 stdoutSentinel, stderrSentinel :: Text
 stdoutSentinel = "01234568909876543210"
 stderrSentinel = "oopsthisisnotavariable"
 
-newGHCi :: IO GHCiHandle
-newGHCi = do
+newGHCi :: GhciState -> IO GHCiHandle
+newGHCi gst = do
     phandle@(ProcessHandle hin hout herr _) <-
-      createProcess cjailConf (proc ghciPath ghciArgs)
+      createProcess (gsCJail gst) $
+        proc (gsGhciPath gst) (gsGhciArgs gst)
     -- TODO: check this actually worked...
     hSetBuffering hin NoBuffering
     hSetBuffering hout NoBuffering

src/Main.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings, PatternGuards #-}
+-- | GHCi Online entry point.
 module Main (
         main
     ) where
@@ -11,49 +12,47 @@ import qualified Data.IntMap as I
 import Data.Monoid
 import qualified Data.HashMap.Strict as H
 import Data.Text.Encoding
+import System.IO
 
 import Snap.Core
 import Snap.Http.Server
 import Snap.Util.FileServe
 
 import GHCiManager
 import Sessions
+import State
 import qualified Timeout as T
 
-data GhciState = GhciState {
-        gsClients :: Session ClientState,
-        gsTimeout :: T.Manager
-    }
-
-data ClientState = ClientState {
-        csGhci :: GHCiHandle,
-        csTout :: T.Handle
-    }
-
+-- | Snap server configuration.
 config :: Config Snap ()
 config = setPort 3222 mempty
 
+-- | Main entry point.
 main :: IO ()
 main = do
-    st <- newMVar I.empty
-    -- 15 seconds...
-    tm <- T.initialize (15 * 1000000)
-    httpServe config (site $ GhciState st tm)
+    putStrLn "Helo World!"
+    st <- initState
+    hFlush stdout
+    httpServe config $ site st
 
+-- | Routes for ghci online.
 site :: GhciState -> Snap ()
 site gst = do
     req <- getRequest
     routes req
   where
+    indexFile = (gsHtmlRoot gst) ++ "/index.html"
     routes req =
         if (rqServerName req == "www.ghc.io") then (redirect' "http://ghc.io" 301) else pass <|>
-        ifTop (index gst "static/index.html") <|>
+        ifTop (index gst indexFile) <|>
         path "ghci" (method POST (ghciIn gst)) <|>
-        dir "static" (serveDirectoryWith conf "static")
+        dir "static" (serveDirectoryWith conf $ gsHtmlRoot gst)
+
     -- somewhat of a hack to get UTF-8 info passed in headers...
     utf8mime = H.map (\v -> v `S8.append` "; charset=UTF-8") defaultMimeTypes
     conf = simpleDirectoryConfig { mimeTypes = utf8mime }
 
+-- | Server index page.
 index :: GhciState -> String -> Snap ()
 index gst file = do
     uid <- getSession <|> newSession (gsClients gst)
@@ -62,16 +61,18 @@ index gst file = do
     modifyResponse $ setHeader "Content-Language" "en"
     sendFile file
 
+-- | Start a new GHCi session for a user.
 startSession :: GhciState -> UID -> Snap ()
 startSession gst uid = liftIO $ modifyMVar_ (gsClients gst) $ \st ->
     case I.lookup uid st of
         Just _  -> return st
         Nothing -> do
-            h <- liftIO newGHCi
+            h <- liftIO $ newGHCi gst
             t <- T.register (gsTimeout gst) $ endSession gst uid
             -- let t = undefined
             return $ I.insert uid (ClientState h t) st
 
+-- | End a GHCi session for a user.
 endSession :: GhciState -> UID -> IO ()
 endSession gst uid = modifyMVar_ (gsClients gst) $ \st -> do
     -- lookup + delete in one operation
@@ -83,6 +84,7 @@ endSession gst uid = modifyMVar_ (gsClients gst) $ \st -> do
             T.cancel $ csTout client
             return st'
 
+-- | Process some input from the user.
 ghciIn :: GhciState -> Snap ()
 ghciIn gst = do
     (uid, cst) <- requireSession (gsClients gst)

src/State.hs

@@ -0,0 +1,55 @@
+-- | State associated with user or application.
+module State (
+        GHCiHandle, GhciState(..), ClientState(..), initState
+    ) where
+
+import CJail.System.Process
+import Control.Concurrent.MVar
+import Data.Functor
+import Data.List
+import qualified Data.IntMap as I
+import System.Environment
+
+import Sessions
+import qualified Timeout as T
+
+type GHCiHandle = ProcessHandle
+
+-- global application state.
+data GhciState = GhciState {
+        gsClients  :: Session ClientState,
+        gsTimeout  :: T.Manager,
+        gsCJail    :: CJailConf,
+        gsGhciPath :: FilePath,
+        gsGhciArgs :: [String],
+        gsHtmlRoot :: String
+    }
+
+-- Session data for a single user.
+data ClientState = ClientState {
+        csGhci :: GHCiHandle,
+        csTout :: T.Handle
+    }
+
+initState :: IO GhciState
+initState = do
+    st <- newMVar I.empty
+    tm <- T.initialize (15 * 1000000)
+    cjailPath <- getEnv "CJAIL_PATH"
+    let cj = CJailConf Nothing Nothing cjailPath
+    ghciPath <- getEnv "GHCI_PATH"
+    ghciArgs <- splitOn ',' <$> getEnv "GHCI_ARGS"
+    htmlRoot <- getEnv "HTML_ROOT"
+
+    putStrLn $ "CJAIL_PATH: " ++ cjailPath
+    putStrLn $ "GHCI_PATH: " ++ ghciPath
+    putStrLn $ "GHCI_ARGS: " ++ show ghciArgs
+    putStrLn $ "HTML_ROOT: " ++ htmlRoot
+
+    return $ GhciState st tm cj ghciPath ghciArgs htmlRoot
+
+splitOn :: Eq a => a -> [a] -> [[a]]
+splitOn chr = unfoldr sep where
+  sep [] = Nothing
+  sep l  = Just . fmap (drop 1) . break (==chr) $ l
+

systemd/cjail.service

@@ -0,0 +1,9 @@
+[Unit]
+Description=Setup CJail on the machine.
+
+[Service]
+Type=oneshot
+ExecStart=/usr/bin/cjail --init
+
+[Install]
+WantedBy=multi-user.target

systemd/ghci-online.service

@@ -0,0 +1,13 @@
+[Unit]
+Description=GHCiOnline Web App
+After=network.target cjail.service
+
+[Service]
+Type=simple
+EnvironmentFile=/etc/conf.d/ghci-online
+ExecStart=/opt/ghc-online/ghci-online
+Restart=on-abort
+#User=ghcio
+
+[Install]
+WantedBy=multi-user.target