diff options
author | joe <joe@jerkface.net> | 2014-04-30 21:28:40 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2014-04-30 21:28:40 -0400 |
commit | 6030b4359ed601dff8267f403fc6c7de21a20b1a (patch) | |
tree | abd64bc8c7bdc3769cc6dcbffdc771ee6933e34d /KeyRing.hs | |
parent | c218706406bd627758db320d8609c56e9b7bbbab (diff) |
new input style: Pipe
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 25 |
1 files changed, 22 insertions, 3 deletions
@@ -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 | ||
166 | data InputFile = HomeSec | 165 | data 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 | ||
269 | resolveForReport :: Maybe InputFileContext -> InputFile -> FilePath | 269 | resolveForReport :: Maybe InputFileContext -> InputFile -> FilePath |
270 | resolveForReport mctx (Pipe fdr fdw) = resolveForReport mctx (ArgFile str) | ||
271 | where str = case (fdr,fdw) of | ||
272 | (0,1) -> "-" | ||
273 | _ -> "&pipe" ++ show (fdr,fdw) | ||
270 | resolveForReport mctx (FileDesc fd) = resolveForReport mctx (ArgFile str) | 274 | resolveForReport mctx (FileDesc fd) = resolveForReport mctx (ArgFile str) |
271 | where str = "&" ++ show fd | 275 | where str = "&" ++ show fd |
272 | resolveForReport mctx f = concat $ resolveInputFile ctx f | 276 | resolveForReport mctx f = concat $ resolveInputFile ctx f |
@@ -850,19 +854,22 @@ data InputFileContext = InputFileContext | |||
850 | } | 854 | } |
851 | 855 | ||
852 | readInputFileS :: InputFileContext -> InputFile -> IO S.ByteString | 856 | readInputFileS :: InputFileContext -> InputFile -> IO S.ByteString |
857 | readInputFileS ctx (Pipe fd _) = fdToHandle fd >>= S.hGetContents | ||
853 | readInputFileS ctx (FileDesc fd) = fdToHandle fd >>= S.hGetContents | 858 | readInputFileS ctx (FileDesc fd) = fdToHandle fd >>= S.hGetContents |
854 | readInputFileS ctx inp = do | 859 | readInputFileS 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 | ||
858 | readInputFileL :: InputFileContext -> InputFile -> IO L.ByteString | 863 | readInputFileL :: InputFileContext -> InputFile -> IO L.ByteString |
864 | readInputFileL ctx (Pipe fd _) = fdToHandle fd >>= L.hGetContents | ||
859 | readInputFileL ctx (FileDesc fd) = fdToHandle fd >>= L.hGetContents | 865 | readInputFileL ctx (FileDesc fd) = fdToHandle fd >>= L.hGetContents |
860 | readInputFileL ctx inp = do | 866 | readInputFileL 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 | ||
865 | writeInputFileL ctx (FileDesc fd) bs = fdToHandle fd >>= (`L.hPut` bs) | 871 | writeInputFileL ctx (Pipe _ fd) bs = fdToHandle fd >>= (`L.hPut` bs) |
872 | writeInputFileL ctx (FileDesc fd) bs = fdToHandle fd >>= (`L.hPut` bs) | ||
866 | writeInputFileL ctx inp bs = do | 873 | writeInputFileL 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 | ||
880 | getWriteFD :: InputFile -> Maybe Posix.Fd | ||
881 | getWriteFD (Pipe _ fd) = Just fd | ||
882 | getWriteFD (FileDesc fd) = Just fd | ||
883 | getWriteFD _ = Nothing | ||
884 | |||
873 | writeStamped0 :: InputFileContext | 885 | writeStamped0 :: 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 () |
879 | writeStamped0 ctx (FileDesc fd) stamp dowrite bs = do | 891 | writeStamped0 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 | |||
895 | writeStamped ctx f stamp str = writeStamped0 ctx f stamp (either hPutStr writeFile) str | 907 | writeStamped ctx f stamp str = writeStamped0 ctx f stamp (either hPutStr writeFile) str |
896 | 908 | ||
897 | getInputFileTime :: InputFileContext -> InputFile -> IO CTime | 909 | getInputFileTime :: InputFileContext -> InputFile -> IO CTime |
910 | getInputFileTime 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 | ||
898 | getInputFileTime ctx (FileDesc fd) = do | 917 | getInputFileTime 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 |