diff options
author | joe <joe@jerkface.net> | 2016-09-02 17:21:03 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2016-09-02 17:34:46 -0400 |
commit | ad1aec70e7a38ba55c600e5d89fca3125d14b0c6 (patch) | |
tree | e48927ee9054f396cb198b34f341ed5e5486b028 /lib/ProcessUtils.hs | |
parent | bbd209a3b83b11d1c46b13bea35b534598827c12 (diff) |
Kiki now launches gpg-agent if neccessary.
Diffstat (limited to 'lib/ProcessUtils.hs')
-rw-r--r-- | lib/ProcessUtils.hs | 41 |
1 files changed, 39 insertions, 2 deletions
diff --git a/lib/ProcessUtils.hs b/lib/ProcessUtils.hs index 1a9cc04..31f5cc9 100644 --- a/lib/ProcessUtils.hs +++ b/lib/ProcessUtils.hs | |||
@@ -6,6 +6,8 @@ module ProcessUtils | |||
6 | , readPipe | 6 | , readPipe |
7 | , readProcessWithErrorH | 7 | , readProcessWithErrorH |
8 | , runExternal | 8 | , runExternal |
9 | , SpawnError(..) | ||
10 | , spawnDetached | ||
9 | ) where | 11 | ) where |
10 | 12 | ||
11 | import GHC.IO.Exception ( ioException, IOErrorType(..) ) | 13 | import GHC.IO.Exception ( ioException, IOErrorType(..) ) |
@@ -13,16 +15,20 @@ import System.FilePath | |||
13 | import System.Directory | 15 | import System.Directory |
14 | import System.Process | 16 | import System.Process |
15 | import System.Posix.Signals | 17 | import System.Posix.Signals |
18 | import System.Posix.Process | ||
16 | import System.Process.Internals (runGenProcess_,defaultSignal) | 19 | import System.Process.Internals (runGenProcess_,defaultSignal) |
17 | import System.Environment | 20 | import System.Environment |
18 | import Data.Maybe ( isNothing, fromMaybe ) | 21 | import Data.Maybe ( isNothing, fromMaybe, isJust, fromJust ) |
19 | import System.IO.Error ( mkIOError, ioeSetErrorString ) | 22 | import System.IO.Error ( mkIOError, ioeSetErrorString ) |
20 | import System.Exit ( ExitCode(..) ) | 23 | import System.Exit ( ExitCode(..) ) |
21 | import System.IO | 24 | import System.IO |
22 | import Control.Applicative | 25 | import Control.Applicative |
23 | import Control.Exception (bracket) | 26 | import Control.Exception (bracket) |
24 | import qualified Data.ByteString as S | 27 | import qualified Data.ByteString as S |
25 | 28 | import ControlMaybe (handleIO,handleIO_) | |
29 | import System.Posix.Files (fileAccess) | ||
30 | import System.Posix.User (getRealUserID,getEffectiveUserID) | ||
31 | import DotLock (dotlock_disable) | ||
26 | 32 | ||
27 | -- | systemEnv | 33 | -- | systemEnv |
28 | -- This is like System.Process.system except that it lets you set | 34 | -- This is like System.Process.system except that it lets you set |
@@ -152,3 +158,34 @@ runExternal cmd input = do | |||
152 | ExitFailure x -> x | 158 | ExitFailure x -> x |
153 | return (code,(out,err)) | 159 | return (code,(out,err)) |
154 | 160 | ||
161 | |||
162 | data SpawnError = SpawnOK | SpawnUIDCheck | SpawnBadAccess IOError | SpawnWaitPID | SpawnFork | ||
163 | deriving (Eq,Show) | ||
164 | |||
165 | spawnDetached :: FilePath -> [String] -> Maybe [(String,String)] -> IO SpawnError | ||
166 | spawnDetached filepath args env = do | ||
167 | uidcheck <- (==) <$> getRealUserID <*> getEffectiveUserID | ||
168 | if not uidcheck then return SpawnUIDCheck else do | ||
169 | accesscheck <- do | ||
170 | handleIO (return . Just . SpawnBadAccess) $ do | ||
171 | b <- fileAccess filepath False False True | ||
172 | if not b then return $ Just $ SpawnBadAccess (userError $ "No execute permission on "++filepath) | ||
173 | else return Nothing | ||
174 | if isJust accesscheck then return (fromJust accesscheck) else do | ||
175 | handleIO_ (return SpawnFork) $ do | ||
176 | pid <- forkProcess $ do | ||
177 | dotlock_disable -- Disable dotlock atexit handler. | ||
178 | -- This wouldn't be neccessary if we used exec* | ||
179 | -- instead of fork. | ||
180 | -- clean up secure memory: | ||
181 | -- gcry_control (GCRYCTL_TERM_SECMEM); | ||
182 | -- if (setsid() == -1 || chdir ("/")) _exit (1); | ||
183 | |||
184 | -- Double fork to let init take over the new child. | ||
185 | handleIO_ (exitImmediately $ ExitFailure 1) $ do | ||
186 | pid2 <- forkProcess $ executeFile filepath False args env | ||
187 | exitImmediately ExitSuccess | ||
188 | exitImmediately ExitSuccess | ||
189 | handleIO_ (return SpawnWaitPID) $ do | ||
190 | _ <- getProcessStatus True False pid | ||
191 | return SpawnOK | ||