Changes to build in a unique temp directory per instance.

Fixes #360
google · Sep 25, 2016 · 0a82241 · 0a82241
1 parent 6375a53
commit 0a82241
Show file tree

Hide file tree

Showing 4 changed files with 21 additions and 17 deletions.
diff --git a/codeworld-server/codeworld-server.cabal b/codeworld-server/codeworld-server.cabal
@@ -33,6 +33,7 @@ Executable codeworld-server
     regex-tdfa,
     snap-core,
     snap-server,
+    temporary,
     text
 
   Ghc-options: -threaded -Wall -funbox-strict-fields -O2

diff --git a/codeworld-server/src/Build.hs b/codeworld-server/src/Build.hs
@@ -19,11 +19,13 @@
 
 module Build where
 
+import           Control.Monad
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import           System.Directory
 import           System.FilePath
 import           System.IO
+import           System.IO.Temp (withSystemTempDirectory)
 import           System.Process
 import           Text.Regex.TDFA
 
@@ -41,20 +43,21 @@ compileExistingSource mode programId = checkDangerousSource mode programId >>= \
         B.writeFile (buildRootDir mode </> resultFile programId) $
             "Sorry, but your program refers to forbidden language features."
         return False
-    False -> do
+    False -> withSystemTempDirectory "codeworld" $ \tmpdir -> do
+        copyFile (buildRootDir mode </> sourceFile programId) (tmpdir </> "program.hs")
         let baseArgs = case mode of
                 BuildMode "haskell"   -> haskellCompatibleBuildArgs
                 _                     -> standardBuildArgs
-            ghcjsArgs = baseArgs ++ [ sourceFile programId ]
-        success <- runCompiler mode userCompileMicros ghcjsArgs >>= \case
-            Nothing -> do
-                removeFileIfExists (buildRootDir mode </> resultFile programId)
-                removeFileIfExists (buildRootDir mode </> targetFile programId)
-                return False
+            ghcjsArgs = baseArgs ++ [ "program.hs" ]
+        success <- runCompiler tmpdir userCompileMicros ghcjsArgs >>= \case
+            Nothing -> return False
             Just output -> do
                 B.writeFile (buildRootDir mode </> resultFile programId) output
-                doesFileExist (buildRootDir mode </> targetFile programId)
-        mapM_ (removeFileIfExists . (buildRootDir mode </>)) (auxiliaryFiles programId)
+                let target = tmpdir </> "program.jsexe" </> "all.js"
+                hasTarget <- doesFileExist target
+                when hasTarget $
+                    copyFile target (buildRootDir mode </> targetFile programId)
+                return hasTarget
         return success
 
 userCompileMicros :: Int
@@ -70,11 +73,11 @@ checkDangerousSource mode programId = do
     matches :: ByteString -> ByteString -> Bool
     matches txt pat = txt =~ pat
 
-runCompiler :: BuildMode -> Int -> [String] -> IO (Maybe ByteString)
-runCompiler mode micros args = do
+runCompiler :: FilePath -> Int -> [String] -> IO (Maybe ByteString)
+runCompiler dir micros args = do
     (Just inh, Just outh, Just errh, pid) <-
         createProcess (proc "ghcjs" args) {
-            cwd       = Just (buildRootDir mode),
+            cwd       = Just dir,
             std_in    = CreatePipe,
             std_out   = CreatePipe,
             std_err   = CreatePipe,

diff --git a/codeworld-server/src/Util.hs b/codeworld-server/src/Util.hs
@@ -65,7 +65,7 @@ sourceXML :: ProgramId -> FilePath
 sourceXML programId = sourceBase programId <.> "xml"
 
 targetFile :: ProgramId -> FilePath
-targetFile programId = sourceBase programId <.> "jsexe" </> "all.js"
+targetFile programId = sourceBase programId <.> "js"
 
 resultFile :: ProgramId -> FilePath
 resultFile programId = sourceBase programId <.> "err.txt"

diff --git a/web/js/codeworld_shared.js b/web/js/codeworld_shared.js
@@ -275,10 +275,10 @@ function addToMessage(msg) {
         .replace(/&/g, '&amp;')
         .replace(/</g, '&lt;')
         .replace(/>/g, '&gt;')
-        .replace(/(user\/)?([PQ]..\/)?[PQ][A-Za-z0-9_=\-]*\.hs:(\d+):((\d+)(-\d+)?)/g,
-            '<a href="#" onclick="goto($3, $5);">Line $3, Column $4</a>')
-        .replace(/(user\/)?([PQ]..\/)?[PQ][A-Za-z0-9_=\-]*\.hs:\((\d+),(\d+)\)-\((\d+),(\d+)\)/g,
-            '<a href="#" onclick="goto($3, $4);">Line $3-$5, Column $4-$6</a>');
+        .replace(/program\.hs:(\d+):((\d+)(-\d+)?)/g,
+            '<a href="#" onclick="goto($1, $3);">Line $1, Column $2</a>')
+        .replace(/program\.hs:\((\d+),(\d+)\)-\((\d+),(\d+)\)/g,
+            '<a href="#" onclick="goto($1, $2);">Line $1-$3, Column $2-$4</a>');
 
     var message = document.getElementById('message');
     message.innerHTML += msg