diff options
author | joe <joe@jerkface.net> | 2014-04-16 01:32:14 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2014-04-16 01:32:14 -0400 |
commit | f1560618fe37f7ec434e78cabd681802048cfb4c (patch) | |
tree | 304697313f97754f04d21df0fc8f0c9d1dccea83 /ProcessUtils.hs | |
parent | 7761528025b4288527c34d0bb68c71ef2e90a51a (diff) |
create nonexistent PEM files via external shell commands
Diffstat (limited to 'ProcessUtils.hs')
-rw-r--r-- | ProcessUtils.hs | 44 |
1 files changed, 44 insertions, 0 deletions
diff --git a/ProcessUtils.hs b/ProcessUtils.hs new file mode 100644 index 0000000..7f7928c --- /dev/null +++ b/ProcessUtils.hs | |||
@@ -0,0 +1,44 @@ | |||
1 | module ProcessUtils | ||
2 | ( ExitCode(ExitFailure,ExitSuccess) | ||
3 | , systemEnv | ||
4 | ) where | ||
5 | |||
6 | import GHC.IO.Exception ( ioException, IOErrorType(..) ) | ||
7 | import System.Process | ||
8 | import System.Posix.Signals | ||
9 | import System.Process.Internals (runGenProcess_,defaultSignal) | ||
10 | import System.Environment | ||
11 | import Data.Maybe ( isNothing ) | ||
12 | import System.IO.Error ( mkIOError, ioeSetErrorString ) | ||
13 | import System.Exit ( ExitCode(..) ) | ||
14 | |||
15 | |||
16 | -- | systemEnv | ||
17 | -- This is like System.Process.system except that it lets you set | ||
18 | -- some environment variables. | ||
19 | systemEnv _ "" = | ||
20 | ioException (ioeSetErrorString (mkIOError InvalidArgument "system" Nothing Nothing) "null command") | ||
21 | systemEnv vars cmd = do | ||
22 | env0 <- getEnvironment | ||
23 | let env1 = filter (isNothing . flip lookup vars . fst) env0 | ||
24 | env = vars ++ env1 | ||
25 | syncProcess "system" $ (shell cmd) {env=Just env} | ||
26 | where | ||
27 | -- This is a non-exported function from System.Process | ||
28 | syncProcess fun c = do | ||
29 | -- The POSIX version of system needs to do some manipulation of signal | ||
30 | -- handlers. Since we're going to be synchronously waiting for the child, | ||
31 | -- we want to ignore ^C in the parent, but handle it the default way | ||
32 | -- in the child (using SIG_DFL isn't really correct, it should be the | ||
33 | -- original signal handler, but the GHC RTS will have already set up | ||
34 | -- its own handler and we don't want to use that). | ||
35 | old_int <- installHandler sigINT Ignore Nothing | ||
36 | old_quit <- installHandler sigQUIT Ignore Nothing | ||
37 | (_,_,_,p) <- runGenProcess_ fun c | ||
38 | (Just defaultSignal) (Just defaultSignal) | ||
39 | r <- waitForProcess p | ||
40 | _ <- installHandler sigINT old_int Nothing | ||
41 | _ <- installHandler sigQUIT old_quit Nothing | ||
42 | return r | ||
43 | |||
44 | |||