summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs38
1 files changed, 26 insertions, 12 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 5301c86..af7f3f4 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -36,7 +36,7 @@ import Data.Time.Clock.POSIX ( getPOSIXTime )
36import qualified Data.Map as Map 36import qualified Data.Map as Map
37import qualified Data.ByteString.Lazy as L ( unpack, pack, null, readFile, writeFile 37import qualified Data.ByteString.Lazy as L ( unpack, pack, null, readFile, writeFile
38 , ByteString, toChunks ) 38 , ByteString, toChunks )
39import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents ) 39import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile)
40import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break, concat, lines ) 40import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break, concat, lines )
41import qualified Crypto.Types.PubKey.ECC as ECC 41import qualified Crypto.Types.PubKey.ECC as ECC
42import qualified Codec.Binary.Base32 as Base32 42import qualified Codec.Binary.Base32 as Base32
@@ -52,6 +52,7 @@ import System.IO (hPutStrLn,withFile,IOMode(..))
52import Data.Binary ( encode ) 52import Data.Binary ( encode )
53import Data.IORef 53import Data.IORef
54import System.Posix.IO (fdToHandle,fdRead) 54import System.Posix.IO (fdToHandle,fdRead)
55import qualified Data.Traversable as Traversable (mapM,forM,sequence)
55 56
56 57
57 58
@@ -95,6 +96,15 @@ data RefType = ConstRef | MutableRef (Maybe Initializer)
95isMutable (MutableRef {}) = True 96isMutable (MutableRef {}) = True
96isMutable _ = False 97isMutable _ = False
97 98
99isring (KeyRingFile {}) = True
100isring _ = False
101
102pwfile (KeyRingFile f) = f
103pwfile _ = HomeSec
104
105iswallet (WalletFile {}) = True
106iswallet _ = False
107
98initializer (MutableRef x) = x 108initializer (MutableRef x) = x
99initializer _ = Nothing 109initializer _ = 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
132filesToLock k secring pubring = do 143filesToLock 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
617cachedContents :: Posix.Fd -> IO (IO S.ByteString) 628
618cachedContents fd = do 629cachedContents :: FilePath -> FilePath -> InputFile -> IO (IO S.ByteString)
630cachedContents 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
633importPEMKey db' tup = do 648importPEMKey db' tup = do
634 try db' $ \(db',report0) -> do 649 try db' $ \(db',report0) -> do
@@ -643,11 +658,7 @@ importPEMKey db' tup = do
643buildKeyDB :: FilePath -> FilePath -> Maybe String -> KeyRingData 658buildKeyDB :: 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)]))
645buildKeyDB secring pubring grip0 keyring = do 660buildKeyDB 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