Kiki now launches gpg-agent if neccessary.

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
     , readPipe
     , readProcessWithErrorH
     , runExternal
+    , SpawnError(..)
+    , spawnDetached
     ) where
 
 import GHC.IO.Exception ( ioException, IOErrorType(..) )
@@ -13,16 +15,20 @@ import System.FilePath
 import System.Directory
 import System.Process
 import System.Posix.Signals
+import System.Posix.Process
 import System.Process.Internals (runGenProcess_,defaultSignal)
 import System.Environment
-import Data.Maybe ( isNothing, fromMaybe )
+import Data.Maybe ( isNothing, fromMaybe, isJust, fromJust )
 import System.IO.Error ( mkIOError, ioeSetErrorString ) 
 import System.Exit ( ExitCode(..) )
 import System.IO
 import Control.Applicative
 import Control.Exception (bracket)
 import qualified Data.ByteString as S
-
+import ControlMaybe (handleIO,handleIO_)
+import System.Posix.Files (fileAccess)
+import System.Posix.User (getRealUserID,getEffectiveUserID)
+import DotLock (dotlock_disable)
 
 -- | systemEnv
 -- This is like System.Process.system except that it lets you set
@@ -152,3 +158,34 @@ runExternal cmd input = do
                     ExitFailure x -> x
     return (code,(out,err))
 
+
+data SpawnError = SpawnOK | SpawnUIDCheck | SpawnBadAccess IOError | SpawnWaitPID | SpawnFork
+ deriving (Eq,Show)
+
+spawnDetached :: FilePath -> [String] -> Maybe [(String,String)] -> IO SpawnError
+spawnDetached filepath args env = do
+    uidcheck <- (==) <$> getRealUserID <*> getEffectiveUserID
+    if not uidcheck then return SpawnUIDCheck else do
+    accesscheck <- do
+        handleIO (return . Just . SpawnBadAccess) $ do
+            b <- fileAccess filepath False False True
+            if not b then return $ Just $ SpawnBadAccess (userError $ "No execute permission on "++filepath)
+                     else return Nothing
+    if isJust accesscheck then return (fromJust accesscheck) else do
+    handleIO_ (return SpawnFork) $ do
+        pid <- forkProcess $ do
+            dotlock_disable -- Disable dotlock atexit handler.
+                            -- This wouldn't be neccessary if we used exec*
+                            -- instead of fork.
+            -- clean up secure memory:
+            -- gcry_control (GCRYCTL_TERM_SECMEM);
+            -- if (setsid() == -1 || chdir ("/")) _exit (1);
+
+            -- Double fork to let init take over the new child.
+            handleIO_ (exitImmediately $ ExitFailure 1) $ do
+                pid2 <- forkProcess $ executeFile filepath False args env
+                exitImmediately ExitSuccess
+            exitImmediately ExitSuccess
+        handleIO_ (return SpawnWaitPID) $ do
+            _ <- getProcessStatus True False pid
+            return SpawnOK