From 6030b4359ed601dff8267f403fc6c7de21a20b1a Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Wed, 30 Apr 2014 21:28:40 -0400
Subject: new input style: Pipe

---
 KeyRing.hs | 25 ++++++++++++++++++++++---
 1 file changed, 22 insertions(+), 3 deletions(-)

(limited to 'KeyRing.hs')

diff --git a/KeyRing.hs b/KeyRing.hs
index 53e7438..c645e96 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -162,11 +162,11 @@ home = HomeDir
     , optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"]
     }
 
--- TODO: Pipe Fd Fd
 data InputFile = HomeSec
                | HomePub
                | ArgFile FilePath
                | FileDesc Posix.Fd
+               | Pipe Posix.Fd Posix.Fd
  deriving (Eq,Ord)
 
 -- type UsageTag = String
@@ -267,6 +267,10 @@ resolveInputFile ctx = resolve
     resolve _ = []
 
 resolveForReport :: Maybe InputFileContext -> InputFile -> FilePath
+resolveForReport mctx (Pipe fdr fdw) = resolveForReport mctx (ArgFile str)
+ where str = case (fdr,fdw) of
+                (0,1) -> "-"
+                _     -> "&pipe" ++ show (fdr,fdw)
 resolveForReport mctx (FileDesc fd) = resolveForReport mctx (ArgFile str)
  where str = "&" ++ show fd
 resolveForReport mctx f = concat $ resolveInputFile ctx f
@@ -850,19 +854,22 @@ data InputFileContext = InputFileContext
     }
 
 readInputFileS :: InputFileContext -> InputFile -> IO S.ByteString
+readInputFileS ctx (Pipe fd _)   = fdToHandle fd >>= S.hGetContents
 readInputFileS ctx (FileDesc fd) = fdToHandle fd >>= S.hGetContents
 readInputFileS ctx inp = do
     let fname = resolveInputFile ctx inp
     fmap S.concat $ mapM S.readFile fname
 
 readInputFileL :: InputFileContext -> InputFile -> IO L.ByteString
+readInputFileL ctx (Pipe fd _)   = fdToHandle fd >>= L.hGetContents
 readInputFileL ctx (FileDesc fd) = fdToHandle fd >>= L.hGetContents
 readInputFileL ctx inp = do
     let fname = resolveInputFile ctx inp
     fmap L.concat $ mapM L.readFile fname
 
 
-writeInputFileL ctx (FileDesc fd) bs =  fdToHandle fd >>= (`L.hPut` bs)
+writeInputFileL ctx (Pipe _ fd) bs   = fdToHandle fd >>= (`L.hPut` bs)
+writeInputFileL ctx (FileDesc fd) bs = fdToHandle fd >>= (`L.hPut` bs)
 writeInputFileL ctx inp bs = do
     let fname = resolveInputFile ctx inp
     mapM_ (`L.writeFile` bs) fname
@@ -870,13 +877,18 @@ writeInputFileL ctx inp bs = do
 -- writeStamped0 :: InputFileContext -> InputFile -> Posix.EpochTime -> L.ByteString -> IO ()
 -- writeStamped0 :: InputFileContext -> InputFile
 
+getWriteFD :: InputFile -> Maybe Posix.Fd
+getWriteFD (Pipe _ fd)   = Just fd
+getWriteFD (FileDesc fd) = Just fd
+getWriteFD _             = Nothing
+
 writeStamped0 :: InputFileContext
     -> InputFile
     -> Posix.EpochTime
     -> (Either Handle FilePath -> t -> IO ())
     -> t
     -> IO ()
-writeStamped0 ctx (FileDesc fd) stamp dowrite bs = do
+writeStamped0 ctx (getWriteFD -> Just fd) stamp dowrite bs = do
     h <- fdToHandle fd
     dowrite (Left h) bs
     handleIO_ (return ())
@@ -895,6 +907,13 @@ writeStamped :: InputFileContext -> InputFile -> Posix.EpochTime -> String -> IO
 writeStamped ctx f stamp str = writeStamped0 ctx f stamp (either hPutStr writeFile) str
 
 getInputFileTime :: InputFileContext -> InputFile -> IO CTime
+getInputFileTime ctx (Pipe fdr fdw) = do
+    mt <- handleIO_ (return Nothing) $ Just <$> modificationTime <$> getFdStatus fdr
+    maybe tryw return mt
+ where
+    tryw = do
+        handleIO_ (error $ (resolveForReport Nothing $ Pipe fdr fdw) ++": modificaiton time?")
+            $ modificationTime <$> getFdStatus fdw
 getInputFileTime ctx (FileDesc fd) = do
     handleIO_ (error $ "&"++show fd++": modificaiton time?") $
                     modificationTime <$> getFdStatus fd
-- 
cgit v1.2.3