This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap".
The branch, hint-fix has been updated
via dbf1eade901c372411ae222bd28309ee60d36b7c (commit)
from 188cee0547c0e93ceaed0f7c90210620dbaf1596 (commit)
Summary of changes:
snap.cabal | 5 ++++
src/Snap/Loader/Hint.hs | 3 +-
src/Snap/Loader/Hint/Helper.hs | 43 ++++++++++++++++++++++++++++++++++++++++
3 files changed, 50 insertions(+), 1 deletions(-)
create mode 100644 src/Snap/Loader/Hint/Helper.hs
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit dbf1eade901c372411ae222bd28309ee60d36b7c
Author: Carl Howells <[email protected]>
Date: Tue Dec 14 12:30:56 2010 -0800
Integrate a fix for the ghc api breaking signal handling. Untested on
windows.
diff --git a/snap.cabal b/snap.cabal
index 7a1c5f8..8f5f2b4 100644
--- a/snap.cabal
+++ b/snap.cabal
@@ -54,6 +54,7 @@ Library
Snap.Loader.Static
other-modules:
+ Snap.Loader.Hint.Helper
build-depends:
base >= 4 && < 5,
@@ -68,6 +69,10 @@ Library
template-haskell >= 2.3 && < 2.5,
time >= 1.0 && < 1.3
+ if !os(windows) {
+ build-depends: unix >= 2.2.0.0 && < 2.5
+ }
+
if impl(ghc >= 6.12.0)
ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
-fno-warn-orphans -fno-warn-unused-do-bind
diff --git a/src/Snap/Loader/Hint.hs b/src/Snap/Loader/Hint.hs
index 4102d13..71e1581 100644
--- a/src/Snap/Loader/Hint.hs
+++ b/src/Snap/Loader/Hint.hs
@@ -30,6 +30,7 @@ import System.Environment (getArgs)
------------------------------------------------------------------------------
import Snap.Types
import qualified Snap.Loader.Static as Static
+import Snap.Loader.Hint.Helper
------------------------------------------------------------------------------
-- | This function derives all the information necessary to use the
@@ -142,7 +143,7 @@ hintSnap opts modules initialization handler = do
-- Protect the interpreter from concurrent and high-speed serial
-- access.
- loadAction <- protectedActionEvaluator 3 loadInterpreter
+ loadAction <- protectedActionEvaluator 3 $ protectHandlers loadInterpreter
return $ do
interpreterResult <- liftIO loadAction
diff --git a/src/Snap/Loader/Hint/Helper.hs b/src/Snap/Loader/Hint/Helper.hs
new file mode 100644
index 0000000..361c2d4
--- /dev/null
+++ b/src/Snap/Loader/Hint/Helper.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE CPP #-}
+module Snap.Loader.Hint.Helper (protectHandlers) where
+
+import Control.Exception (bracket)
+
+#ifdef mingw32_HOST_OS
+import GHC.ConsoleHandler as C
+
+
+saveHandlers :: IO C.Handler
+saveHandlers = C.installHandler Ignore
+
+
+restoreHandlers :: C.Handler -> IO C.Handler
+restoreHandlers = C.installHandler
+
+
+#else
+import qualified System.Posix.Signals as S
+
+helper :: S.Handler -> S.Signal -> IO S.Handler
+helper handler signal = S.installHandler signal handler Nothing
+
+
+signals :: [S.Signal]
+signals = [ S.sigQUIT
+ , S.sigINT
+ , S.sigHUP
+ , S.sigTERM
+ ]
+
+
+saveHandlers :: IO [S.Handler]
+saveHandlers = mapM (helper S.Ignore) signals
+
+
+restoreHandlers :: [S.Handler] -> IO [S.Handler]
+restoreHandlers h = sequence $ zipWith helper h signals
+
+
+#endif
+protectHandlers :: IO a -> IO a
+protectHandlers a = bracket saveHandlers restoreHandlers $ const a
-----------------------------------------------------------------------
hooks/post-receive
--
snap
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
