Make Mailcap entry aware of temporary files

When opening attachments with mailcap entries, it is sometimes possible that the
actual binary just sends a message to the main program and exits. Deleting the
temporary file upon process exit would cause the main program upon opening the
temporary file to fail since the file would have been deleted by that time.
Sometimes opening the file from the main program just works, because the time
difference between exiting and opening is really quick, but mostly it doesn't.

Instead, make the mailcap entry flexible so that depending on the command we
either keep or delete the temporary file.

Fixes #276

src/Config/Main.hs

@@ -15,6 +15,7 @@ import qualified Data.Text as T
 import System.Environment (lookupEnv)
 import System.Directory (getHomeDirectory)
 import Data.Maybe (fromMaybe)
+import GHC.Exts (fromList)
 import System.Exit (ExitCode(..))
 
 import Data.MIME (contentTypeTextPlain, matchContentType)
@@ -178,9 +179,11 @@ defaultConfig =
       , _mvMailListOfAttachmentsKeybindings = mailAttachmentsKeybindings
       , _mvOpenWithKeybindings = openWithKeybindings
       , _mvPipeToKeybindings = pipeToKeybindings
-      , _mvMailcap = [
-            ((matchContentType "text" (Just "html")), "elinks -force-html")
-          , (const True, "xdg-open")
+      , _mvMailcap =
+          [ ( matchContentType "text" (Just "html")
+            , MailcapHandler (Shell (fromList "elinks -force-html")) False)
+          , ( const True
+            , MailcapHandler (Process (fromList "xdg-open") []) True)
           ]
       }
     , _confIndexView = IndexViewSettings

src/Purebred/System/Process.hs

@@ -22,6 +22,7 @@ module Purebred.System.Process
   , tmpfileResource
   , emptyResource
   , afterExitNoop
+  , toProcessConfigWithTempfile
 
   -- * Re-exports from @System.Process.Typed@
   , ProcessConfig
@@ -41,6 +42,7 @@ import System.IO.Temp (emptySystemTempFile)
 import System.Directory (removeFile)
 import Control.Lens (set, (&))
 import Data.Semigroup ((<>))
+import GHC.Exts (toList)
 
 import Control.Monad.IO.Class (MonadIO)
 import qualified Data.Text as T
@@ -82,11 +84,22 @@ readProcess
 readProcess = (fmap . fmap) (bimap taint taint) System.Process.Typed.readProcess
 
 
-tmpfileResource :: ResourceSpec FilePath
-tmpfileResource = ResourceSpec (emptySystemTempFile "purebred") removeFile B.writeFile
+tmpfileResource ::
+  Bool -- ^ removeFile upon cleanup?
+  -> ResourceSpec FilePath
+tmpfileResource keepTempfile =
+  let cleanUp =
+        if keepTempfile
+          then mempty
+          else removeFile
+   in ResourceSpec (emptySystemTempFile "purebred") cleanUp B.writeFile
 
 emptyResource :: ResourceSpec ()
 emptyResource = ResourceSpec mempty (const mempty) (const mempty)
 
 afterExitNoop :: AppState -> a -> IO AppState
 afterExitNoop s _ = pure s
+
+toProcessConfigWithTempfile :: MakeProcess -> FilePath -> ProcessConfig () () ()
+toProcessConfigWithTempfile (Shell cmd) fp = shell (toList cmd <> " " <> fp)
+toProcessConfigWithTempfile (Process cmd args) fp = proc (toList cmd) (args <> [fp])

src/Types.hs

@@ -31,6 +31,7 @@ import qualified Data.Vector as V
 import qualified Graphics.Vty.Input.Events as Vty
 import Data.Time (UTCTime)
 import qualified Data.CaseInsensitive as CI
+import Data.List.NonEmpty (NonEmpty)
 import System.Process.Typed (ProcessConfig)
 
 import Notmuch (Tag)
@@ -348,7 +349,7 @@ data MailViewSettings = MailViewSettings
     , _mvMailListOfAttachmentsKeybindings :: [Keybinding 'ViewMail 'MailListOfAttachments]
     , _mvOpenWithKeybindings :: [Keybinding 'ViewMail 'MailAttachmentOpenWithEditor]
     , _mvPipeToKeybindings :: [Keybinding 'ViewMail 'MailAttachmentPipeToEditor]
-    , _mvMailcap :: [(ContentType -> Bool, String)]
+    , _mvMailcap :: [(ContentType -> Bool, MailcapHandler)]
     }
     deriving (Generic, NFData)
 
@@ -376,7 +377,7 @@ mvOpenWithKeybindings = lens _mvOpenWithKeybindings (\s x -> s { _mvOpenWithKeyb
 mvPipeToKeybindings :: Lens' MailViewSettings [Keybinding 'ViewMail 'MailAttachmentPipeToEditor]
 mvPipeToKeybindings = lens _mvPipeToKeybindings (\s x -> s { _mvPipeToKeybindings = x })
 
-mvMailcap :: Lens' MailViewSettings [(ContentType -> Bool, String)]
+mvMailcap :: Lens' MailViewSettings [(ContentType -> Bool, MailcapHandler)]
 mvMailcap = lens _mvMailcap (\s x -> s { _mvMailcap = x })
 
 data ViewName
@@ -615,6 +616,24 @@ rsFree = lens _rsFree (\rs x -> rs { _rsFree = x })
 rsUpdate :: Lens' (ResourceSpec a) (a -> B.ByteString -> IO ())
 rsUpdate = lens _rsUpdate (\rs x -> rs { _rsUpdate = x })
 
+data MakeProcess
+  = Shell (NonEmpty Char)
+  | Process (NonEmpty Char)
+            [String]
+  deriving (Generic, NFData)
+
+data MailcapHandler = MailcapHandler
+  { _mhMakeProcess :: MakeProcess
+  , _mhKeepTemp :: Bool
+  } deriving (Generic, NFData)
+
+mhMakeProcess :: Lens' MailcapHandler MakeProcess
+mhMakeProcess = lens _mhMakeProcess (\h x -> h { _mhMakeProcess = x })
+
+mhKeepTemp :: Lens' MailcapHandler Bool
+mhKeepTemp = lens _mhKeepTemp (\h x -> h { _mhKeepTemp = x })
+
+
 -- | Command configuration which is bound to an acquired resource (e.g. a
 -- tempfile) which may or may not be cleaned up after exit of it's process.
 data EntityCommand a = EntityCommand

src/UI/Actions.hs

@@ -67,6 +67,7 @@ module UI.Actions (
 
 import Data.Functor.Identity (Identity(..))
 
+import GHC.Exts (fromList)
 import qualified Brick
 import Brick.BChan (writeBChan)
 import qualified Brick.Focus as Brick
@@ -579,11 +580,14 @@ openAttachment =
 openWithCommand :: Action 'ViewMail 'MailAttachmentOpenWithEditor (T.Next AppState)
 openWithCommand =
   Action
-  { _aDescription = ["ask for command to open attachment"]
-  , _aAction = \s ->
-    let cmd = view (asMailView . mvOpenCommand . E.editContentsL . to (T.unpack . currentLine)) s
-    in Brick.suspendAndResume $ liftIO $ openCommand' s cmd
-  }
+    { _aDescription = ["ask for command to open attachment"]
+    , _aAction =
+        \s ->
+          let cmd = view (asMailView . mvOpenCommand . E.editContentsL . to (T.unpack . currentLine)) s
+           in if null cmd
+                then Brick.continue $ setError (GenericError "Empty command") s
+                else Brick.suspendAndResume $ liftIO $ openCommand' s (MailcapHandler (Process (fromList cmd) []) False)
+    }
 
 pipeToCommand :: Action 'ViewMail 'MailAttachmentPipeToEditor (T.Next AppState)
 pipeToCommand =
@@ -1027,26 +1031,28 @@ invokeEditor' s =
    in either
         (pure . flip setError s)
         (flip runEntityCommand s .
-         EntityCommand updatePart tmpfileResource (\_ fp -> proc cmd [fp]))
+         EntityCommand updatePart (tmpfileResource True) (\_ fp -> proc cmd [fp]))
         mkEntity
 
 -- | Write the serialised WireEntity to a temporary file. Pass the FilePath of
 -- the temporary file to the command. Do not remove the temporary file, so
 -- programs using sub-shells will be able to read the temporary file. Return an
 -- error if either the WireEntity doesn't exist (e.g. not selected) or it can
 -- not be serialised.
-openCommand' :: AppState -> FilePath -> IO AppState
-openCommand' s cmd
-  | null cmd = pure $ s & setError (GenericError "Empty command")
-  | otherwise =
-      let maybeEntity = preview (asMailView . mvAttachments . to L.listSelectedElement . _Just . _2) s
-          mkConfig :: Either Error (EntityCommand FilePath)
-          mkConfig =
-            case maybeEntity of
-              Nothing -> Left (GenericError "No attachment selected")
-              Just e ->
-                EntityCommand afterExitNoop tmpfileResource (\_ fp -> proc cmd [fp]) <$> entityToBytes e
-      in either (pure . flip setError s) (`runEntityCommand` s) mkConfig
+openCommand' :: AppState -> MailcapHandler -> IO AppState
+openCommand' s cmd =
+  let maybeEntity = preview (asMailView . mvAttachments . to L.listSelectedElement . _Just . _2) s
+      mkConfig :: Either Error (EntityCommand FilePath)
+      mkConfig =
+        case maybeEntity of
+          Nothing -> Left (GenericError "No attachment selected")
+          Just e ->
+            EntityCommand
+              afterExitNoop
+              (tmpfileResource (view mhKeepTemp cmd))
+              (\_ fp -> toProcessConfigWithTempfile (view mhMakeProcess cmd) fp) <$>
+            entityToBytes e
+   in either (pure . flip setError s) (`runEntityCommand` s) mkConfig
 
 -- | Pass the serialized WireEntity to a Bytestring as STDIN to the process. No
 -- temporary file is used. If either no WireEntity exists (e.g. none selected)
@@ -1076,10 +1082,12 @@ runEntityCommand ::
 runEntityCommand cmd s = do
   tmpfile <- view (ccResource . rsAcquire) cmd
   view (ccResource . rsUpdate) cmd tmpfile (view ccEntity cmd)
-  tryRunProcess (view ccProcessConfig cmd (view ccEntity cmd) tmpfile) >>=
+  s' <- tryRunProcess (view ccProcessConfig cmd (view ccEntity cmd) tmpfile) >>=
     either
       (handleIOException s)
       (flip (view ccAfterExit cmd) tmpfile <$> handleExitCode s)
+  view (ccResource . rsFree) cmd tmpfile
+  pure s'
 
 editAttachment :: AppState -> IO AppState
 editAttachment s =