diff options
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 38 |
1 files changed, 26 insertions, 12 deletions
@@ -36,7 +36,7 @@ import Data.Time.Clock.POSIX ( getPOSIXTime ) | |||
36 | import qualified Data.Map as Map | 36 | import qualified Data.Map as Map |
37 | import qualified Data.ByteString.Lazy as L ( unpack, pack, null, readFile, writeFile | 37 | import qualified Data.ByteString.Lazy as L ( unpack, pack, null, readFile, writeFile |
38 | , ByteString, toChunks ) | 38 | , ByteString, toChunks ) |
39 | import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents ) | 39 | import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile) |
40 | import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break, concat, lines ) | 40 | import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break, concat, lines ) |
41 | import qualified Crypto.Types.PubKey.ECC as ECC | 41 | import qualified Crypto.Types.PubKey.ECC as ECC |
42 | import qualified Codec.Binary.Base32 as Base32 | 42 | import qualified Codec.Binary.Base32 as Base32 |
@@ -52,6 +52,7 @@ import System.IO (hPutStrLn,withFile,IOMode(..)) | |||
52 | import Data.Binary ( encode ) | 52 | import Data.Binary ( encode ) |
53 | import Data.IORef | 53 | import Data.IORef |
54 | import System.Posix.IO (fdToHandle,fdRead) | 54 | import System.Posix.IO (fdToHandle,fdRead) |
55 | import qualified Data.Traversable as Traversable (mapM,forM,sequence) | ||
55 | 56 | ||
56 | 57 | ||
57 | 58 | ||
@@ -95,6 +96,15 @@ data RefType = ConstRef | MutableRef (Maybe Initializer) | |||
95 | isMutable (MutableRef {}) = True | 96 | isMutable (MutableRef {}) = True |
96 | isMutable _ = False | 97 | isMutable _ = False |
97 | 98 | ||
99 | isring (KeyRingFile {}) = True | ||
100 | isring _ = False | ||
101 | |||
102 | pwfile (KeyRingFile f) = f | ||
103 | pwfile _ = HomeSec | ||
104 | |||
105 | iswallet (WalletFile {}) = True | ||
106 | iswallet _ = False | ||
107 | |||
98 | initializer (MutableRef x) = x | 108 | initializer (MutableRef x) = x |
99 | initializer _ = Nothing | 109 | initializer _ = Nothing |
100 | 110 | ||
@@ -129,6 +139,7 @@ resolveInputFile secring pubring = resolve | |||
129 | resolve (ArgFile f) = return f | 139 | resolve (ArgFile f) = return f |
130 | resolve _ = [] | 140 | resolve _ = [] |
131 | 141 | ||
142 | |||
132 | filesToLock k secring pubring = do | 143 | filesToLock k secring pubring = do |
133 | (f,(rtyp,ftyp)) <- Map.toList (kFiles k) | 144 | (f,(rtyp,ftyp)) <- Map.toList (kFiles k) |
134 | case rtyp of | 145 | case rtyp of |
@@ -614,8 +625,9 @@ seek_key (KeyUidMatch pat) ps = if null bs | |||
614 | uidStr _ = "" | 625 | uidStr _ = "" |
615 | 626 | ||
616 | 627 | ||
617 | cachedContents :: Posix.Fd -> IO (IO S.ByteString) | 628 | |
618 | cachedContents fd = do | 629 | cachedContents :: FilePath -> FilePath -> InputFile -> IO (IO S.ByteString) |
630 | cachedContents secring pubring fd = do | ||
619 | ref <- newIORef Nothing | 631 | ref <- newIORef Nothing |
620 | return $ get ref fd | 632 | return $ get ref fd |
621 | where | 633 | where |
@@ -624,11 +636,14 @@ cachedContents fd = do | |||
624 | get ref fd = do | 636 | get ref fd = do |
625 | pw <- readIORef ref | 637 | pw <- readIORef ref |
626 | flip (flip maybe return) pw $ do | 638 | flip (flip maybe return) pw $ do |
627 | do pwh <- fdToHandle fd -- (read fd) | 639 | pw <- fmap trimCR $ getContents fd |
628 | pw <- fmap trimCR $ S.hGetContents pwh | 640 | writeIORef ref (Just pw) |
629 | writeIORef ref (Just pw) | 641 | return pw |
630 | return pw | ||
631 | 642 | ||
643 | getContents (FileDesc fd) = fdToHandle fd >>= S.hGetContents | ||
644 | getContents inp = do | ||
645 | let fname = resolveInputFile secring pubring inp | ||
646 | fmap S.concat $ mapM S.readFile fname | ||
632 | 647 | ||
633 | importPEMKey db' tup = do | 648 | importPEMKey db' tup = do |
634 | try db' $ \(db',report0) -> do | 649 | try db' $ \(db',report0) -> do |
@@ -643,11 +658,7 @@ importPEMKey db' tup = do | |||
643 | buildKeyDB :: FilePath -> FilePath -> Maybe String -> KeyRingData | 658 | buildKeyDB :: FilePath -> FilePath -> Maybe String -> KeyRingData |
644 | -> IO (KikiCondition ((KeyDB,Maybe String,Maybe Packet),[(FilePath,KikiReportAction)])) | 659 | -> IO (KikiCondition ((KeyDB,Maybe String,Maybe Packet),[(FilePath,KikiReportAction)])) |
645 | buildKeyDB secring pubring grip0 keyring = do | 660 | buildKeyDB secring pubring grip0 keyring = do |
646 | let isring (KeyRingFile {}) = True | 661 | let |
647 | isring _ = False | ||
648 | |||
649 | iswallet (WalletFile {}) = True | ||
650 | iswallet _ = False | ||
651 | 662 | ||
652 | files isring = do | 663 | files isring = do |
653 | (f,(rtyp,ftyp)) <- Map.toList (kFiles keyring) | 664 | (f,(rtyp,ftyp)) <- Map.toList (kFiles keyring) |
@@ -1137,6 +1148,9 @@ runKeyRing keyring = do | |||
1137 | 1148 | ||
1138 | let doDecrypt = todo | 1149 | let doDecrypt = todo |
1139 | 1150 | ||
1151 | pws <- | ||
1152 | Traversable.mapM (cachedContents secring pubring . pwfile . snd) | ||
1153 | (Map.filter (isring . snd) $ kFiles keyring) | ||
1140 | 1154 | ||
1141 | -- merge all keyrings, PEM files, and wallets | 1155 | -- merge all keyrings, PEM files, and wallets |
1142 | bresult <- buildKeyDB secring pubring grip0 keyring | 1156 | bresult <- buildKeyDB secring pubring grip0 keyring |