summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-04-30 21:28:40 -0400
committerjoe <joe@jerkface.net>2014-04-30 21:28:40 -0400
commit6030b4359ed601dff8267f403fc6c7de21a20b1a (patch)
treeabd64bc8c7bdc3769cc6dcbffdc771ee6933e34d /KeyRing.hs
parentc218706406bd627758db320d8609c56e9b7bbbab (diff)
new input style: Pipe
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs25
1 files changed, 22 insertions, 3 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 53e7438..c645e96 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -162,11 +162,11 @@ home = HomeDir
162 , optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"] 162 , optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"]
163 } 163 }
164 164
165-- TODO: Pipe Fd Fd
166data InputFile = HomeSec 165data InputFile = HomeSec
167 | HomePub 166 | HomePub
168 | ArgFile FilePath 167 | ArgFile FilePath
169 | FileDesc Posix.Fd 168 | FileDesc Posix.Fd
169 | Pipe Posix.Fd Posix.Fd
170 deriving (Eq,Ord) 170 deriving (Eq,Ord)
171 171
172-- type UsageTag = String 172-- type UsageTag = String
@@ -267,6 +267,10 @@ resolveInputFile ctx = resolve
267 resolve _ = [] 267 resolve _ = []
268 268
269resolveForReport :: Maybe InputFileContext -> InputFile -> FilePath 269resolveForReport :: Maybe InputFileContext -> InputFile -> FilePath
270resolveForReport mctx (Pipe fdr fdw) = resolveForReport mctx (ArgFile str)
271 where str = case (fdr,fdw) of
272 (0,1) -> "-"
273 _ -> "&pipe" ++ show (fdr,fdw)
270resolveForReport mctx (FileDesc fd) = resolveForReport mctx (ArgFile str) 274resolveForReport mctx (FileDesc fd) = resolveForReport mctx (ArgFile str)
271 where str = "&" ++ show fd 275 where str = "&" ++ show fd
272resolveForReport mctx f = concat $ resolveInputFile ctx f 276resolveForReport mctx f = concat $ resolveInputFile ctx f
@@ -850,19 +854,22 @@ data InputFileContext = InputFileContext
850 } 854 }
851 855
852readInputFileS :: InputFileContext -> InputFile -> IO S.ByteString 856readInputFileS :: InputFileContext -> InputFile -> IO S.ByteString
857readInputFileS ctx (Pipe fd _) = fdToHandle fd >>= S.hGetContents
853readInputFileS ctx (FileDesc fd) = fdToHandle fd >>= S.hGetContents 858readInputFileS ctx (FileDesc fd) = fdToHandle fd >>= S.hGetContents
854readInputFileS ctx inp = do 859readInputFileS ctx inp = do
855 let fname = resolveInputFile ctx inp 860 let fname = resolveInputFile ctx inp
856 fmap S.concat $ mapM S.readFile fname 861 fmap S.concat $ mapM S.readFile fname
857 862
858readInputFileL :: InputFileContext -> InputFile -> IO L.ByteString 863readInputFileL :: InputFileContext -> InputFile -> IO L.ByteString
864readInputFileL ctx (Pipe fd _) = fdToHandle fd >>= L.hGetContents
859readInputFileL ctx (FileDesc fd) = fdToHandle fd >>= L.hGetContents 865readInputFileL ctx (FileDesc fd) = fdToHandle fd >>= L.hGetContents
860readInputFileL ctx inp = do 866readInputFileL ctx inp = do
861 let fname = resolveInputFile ctx inp 867 let fname = resolveInputFile ctx inp
862 fmap L.concat $ mapM L.readFile fname 868 fmap L.concat $ mapM L.readFile fname
863 869
864 870
865writeInputFileL ctx (FileDesc fd) bs = fdToHandle fd >>= (`L.hPut` bs) 871writeInputFileL ctx (Pipe _ fd) bs = fdToHandle fd >>= (`L.hPut` bs)
872writeInputFileL ctx (FileDesc fd) bs = fdToHandle fd >>= (`L.hPut` bs)
866writeInputFileL ctx inp bs = do 873writeInputFileL ctx inp bs = do
867 let fname = resolveInputFile ctx inp 874 let fname = resolveInputFile ctx inp
868 mapM_ (`L.writeFile` bs) fname 875 mapM_ (`L.writeFile` bs) fname
@@ -870,13 +877,18 @@ writeInputFileL ctx inp bs = do
870-- writeStamped0 :: InputFileContext -> InputFile -> Posix.EpochTime -> L.ByteString -> IO () 877-- writeStamped0 :: InputFileContext -> InputFile -> Posix.EpochTime -> L.ByteString -> IO ()
871-- writeStamped0 :: InputFileContext -> InputFile 878-- writeStamped0 :: InputFileContext -> InputFile
872 879
880getWriteFD :: InputFile -> Maybe Posix.Fd
881getWriteFD (Pipe _ fd) = Just fd
882getWriteFD (FileDesc fd) = Just fd
883getWriteFD _ = Nothing
884
873writeStamped0 :: InputFileContext 885writeStamped0 :: InputFileContext
874 -> InputFile 886 -> InputFile
875 -> Posix.EpochTime 887 -> Posix.EpochTime
876 -> (Either Handle FilePath -> t -> IO ()) 888 -> (Either Handle FilePath -> t -> IO ())
877 -> t 889 -> t
878 -> IO () 890 -> IO ()
879writeStamped0 ctx (FileDesc fd) stamp dowrite bs = do 891writeStamped0 ctx (getWriteFD -> Just fd) stamp dowrite bs = do
880 h <- fdToHandle fd 892 h <- fdToHandle fd
881 dowrite (Left h) bs 893 dowrite (Left h) bs
882 handleIO_ (return ()) 894 handleIO_ (return ())
@@ -895,6 +907,13 @@ writeStamped :: InputFileContext -> InputFile -> Posix.EpochTime -> String -> IO
895writeStamped ctx f stamp str = writeStamped0 ctx f stamp (either hPutStr writeFile) str 907writeStamped ctx f stamp str = writeStamped0 ctx f stamp (either hPutStr writeFile) str
896 908
897getInputFileTime :: InputFileContext -> InputFile -> IO CTime 909getInputFileTime :: InputFileContext -> InputFile -> IO CTime
910getInputFileTime ctx (Pipe fdr fdw) = do
911 mt <- handleIO_ (return Nothing) $ Just <$> modificationTime <$> getFdStatus fdr
912 maybe tryw return mt
913 where
914 tryw = do
915 handleIO_ (error $ (resolveForReport Nothing $ Pipe fdr fdw) ++": modificaiton time?")
916 $ modificationTime <$> getFdStatus fdw
898getInputFileTime ctx (FileDesc fd) = do 917getInputFileTime ctx (FileDesc fd) = do
899 handleIO_ (error $ "&"++show fd++": modificaiton time?") $ 918 handleIO_ (error $ "&"++show fd++": modificaiton time?") $
900 modificationTime <$> getFdStatus fd 919 modificationTime <$> getFdStatus fd