summaryrefslogtreecommitdiff
path: root/lib/ProcessUtils.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2016-09-02 17:21:03 -0400
committerjoe <joe@jerkface.net>2016-09-02 17:34:46 -0400
commitad1aec70e7a38ba55c600e5d89fca3125d14b0c6 (patch)
treee48927ee9054f396cb198b34f341ed5e5486b028 /lib/ProcessUtils.hs
parentbbd209a3b83b11d1c46b13bea35b534598827c12 (diff)
Kiki now launches gpg-agent if neccessary.
Diffstat (limited to 'lib/ProcessUtils.hs')
-rw-r--r--lib/ProcessUtils.hs41
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
11import GHC.IO.Exception ( ioException, IOErrorType(..) ) 13import GHC.IO.Exception ( ioException, IOErrorType(..) )
@@ -13,16 +15,20 @@ import System.FilePath
13import System.Directory 15import System.Directory
14import System.Process 16import System.Process
15import System.Posix.Signals 17import System.Posix.Signals
18import System.Posix.Process
16import System.Process.Internals (runGenProcess_,defaultSignal) 19import System.Process.Internals (runGenProcess_,defaultSignal)
17import System.Environment 20import System.Environment
18import Data.Maybe ( isNothing, fromMaybe ) 21import Data.Maybe ( isNothing, fromMaybe, isJust, fromJust )
19import System.IO.Error ( mkIOError, ioeSetErrorString ) 22import System.IO.Error ( mkIOError, ioeSetErrorString )
20import System.Exit ( ExitCode(..) ) 23import System.Exit ( ExitCode(..) )
21import System.IO 24import System.IO
22import Control.Applicative 25import Control.Applicative
23import Control.Exception (bracket) 26import Control.Exception (bracket)
24import qualified Data.ByteString as S 27import qualified Data.ByteString as S
25 28import ControlMaybe (handleIO,handleIO_)
29import System.Posix.Files (fileAccess)
30import System.Posix.User (getRealUserID,getEffectiveUserID)
31import 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
162data SpawnError = SpawnOK | SpawnUIDCheck | SpawnBadAccess IOError | SpawnWaitPID | SpawnFork
163 deriving (Eq,Show)
164
165spawnDetached :: FilePath -> [String] -> Maybe [(String,String)] -> IO SpawnError
166spawnDetached 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