summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/KeyRing.hs22
-rw-r--r--lib/KeyRing/BuildKeyDB.hs23
-rw-r--r--lib/KeyRing/Types.hs25
-rw-r--r--lib/Kiki.hs16
-rw-r--r--lib/PacketTranscoder.hs8
-rw-r--r--lib/Transforms.hs2
6 files changed, 54 insertions, 42 deletions
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index cd69042..8c92a81 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -425,7 +425,7 @@ selectPublicKeyAndSigs (spec,mtag) db =
425 : map (\(SubKey sub sigs)-> (packet sub, map (packet . fst) sigs)) 425 : map (\(SubKey sub sigs)-> (packet sub, map (packet . fst) sigs))
426 (Map.elems $ keySubKeys kd) 426 (Map.elems $ keySubKeys kd)
427 where 427 where
428 ismatch (p,sigs) = matchpr g p ==g 428 ismatch (p,sigs) = matchpr' g p
429 findbyspec spec kd = if matchSpec spec kd then [topresult kd] else [] 429 findbyspec spec kd = if matchSpec spec kd then [topresult kd] else []
430 430
431 findsubs tag (kk, KeyData topk _ _ subs) = Map.elems subs >>= gettag 431 findsubs tag (kk, KeyData topk _ _ subs) = Map.elems subs >>= gettag
@@ -673,7 +673,7 @@ isauth rt keydata = dont_have keydata && maybe False (`has_good_sig` keydata) wk
673 workingKey grip use_db = listToMaybe $ do 673 workingKey grip use_db = listToMaybe $ do
674 fp <- maybeToList grip 674 fp <- maybeToList grip
675 elm <- keyData use_db 675 elm <- keyData use_db
676 guard $ matchSpec (KeyGrip fp) elm 676 guard $ matchSpec (KeyGrip $ show fp) elm
677 return $ keyPacket elm 677 return $ keyPacket elm
678 678
679mkarmor :: Access -> L.ByteString -> [Armor] 679mkarmor :: Access -> L.ByteString -> [Armor]
@@ -734,7 +734,7 @@ writeRingKeys krd rt {- db wk secring pubring -} unspilled report_manips = do
734 case fill stream of 734 case fill stream of
735 KF_Match usage -> do grip <- maybeToList $ rtGrip rt 735 KF_Match usage -> do grip <- maybeToList $ rtGrip rt
736 flattenTop f only_public 736 flattenTop f only_public
737 $ filterNewSubs f (parseSpec grip usage) d -- TODO: parseSpec3 737 $ filterNewSubs f (parseSpec (Just grip) usage) d -- TODO: parseSpec3
738 _ -> flattenTop f only_public d 738 _ -> flattenTop f only_public d
739 new_packets = filter isnew x 739 new_packets = filter isnew x
740 where isnew p = isNothing (Map.lookup (resolveForReport Nothing f0) $ locations p) 740 where isnew p = isNothing (Map.lookup (resolveForReport Nothing f0) $ locations p)
@@ -945,7 +945,7 @@ writePEMKeys doDecrypt db exports = do
945initializeMissingPEMFiles :: 945initializeMissingPEMFiles ::
946 KeyRingOperation 946 KeyRingOperation
947 -> InputFileContext 947 -> InputFileContext
948 -> Maybe String 948 -> Maybe Fingerprint
949 -> Maybe MappedPacket 949 -> Maybe MappedPacket
950 -> PacketTranscoder 950 -> PacketTranscoder
951 -> KeyDB 951 -> KeyDB
@@ -974,7 +974,7 @@ initializeMissingPEMFiles operation ctx grip mwk transcode db = do
974 usage <- maybeToList mutableTag 974 usage <- maybeToList mutableTag
975 -- TODO: Use parseSpec3 975 -- TODO: Use parseSpec3
976 -- TODO: Report error if generating without specifying usage tag. 976 -- TODO: Report error if generating without specifying usage tag.
977 let (topspec,subspec) = parseSpec (fromMaybe "" grip) usage 977 let (topspec,subspec) = parseSpec grip usage
978 -- ms will contain duplicates if a top key has multiple matching 978 -- ms will contain duplicates if a top key has multiple matching
979 -- subkeys. This is intentional. 979 -- subkeys. This is intentional.
980 -- ms = map (keykey . fst) $ selectAll True (topspec,subspec) db 980 -- ms = map (keykey . fst) $ selectAll True (topspec,subspec) db
@@ -1026,7 +1026,7 @@ initializeMissingPEMFiles operation ctx grip mwk transcode db = do
1026 let internals = mapMaybe getParams $ do 1026 let internals = mapMaybe getParams $ do
1027 (f,stream) <- nonexistents 1027 (f,stream) <- nonexistents
1028 usage <- take 1 $ mapMaybe usageFromFilter [fill stream,spill stream] 1028 usage <- take 1 $ mapMaybe usageFromFilter [fill stream,spill stream]
1029 let (topspec,subspec) = parseSpec (fromMaybe "" grip) usage 1029 let (topspec,subspec) = parseSpec grip usage
1030 guard $ null $ do 1030 guard $ null $ do
1031 (kk,kd) <- filterMatches topspec $ kkData db 1031 (kk,kd) <- filterMatches topspec $ kkData db
1032 subkeysForExport subspec kd 1032 subkeysForExport subspec kd
@@ -1071,7 +1071,7 @@ runKeyRing operation =
1071 1071
1072withLockedKeyring :: Maybe FilePath 1072withLockedKeyring :: Maybe FilePath
1073 -> Map.Map InputFile StreamInfo 1073 -> Map.Map InputFile StreamInfo
1074 -> (InputFileContext -> Maybe String -> IO (KikiResult a)) 1074 -> (InputFileContext -> Maybe Fingerprint -> IO (KikiResult a))
1075 -> IO (KikiResult a) 1075 -> IO (KikiResult a)
1076withLockedKeyring homespec opfiles go = do 1076withLockedKeyring homespec opfiles go = do
1077 -- get homedir and keyring files + fingerprint for working key 1077 -- get homedir and keyring files + fingerprint for working key
@@ -1099,7 +1099,7 @@ withLockedKeyring homespec opfiles go = do
1099 return ret 1099 return ret
1100 1100
1101 1101
1102realRunKeyRing :: KeyRingOperation -> InputFileContext -> Maybe String -> IO (KikiResult KeyRingRuntime) 1102realRunKeyRing :: KeyRingOperation -> InputFileContext -> Maybe Fingerprint -> IO (KikiResult KeyRingRuntime)
1103realRunKeyRing operation ctx grip0 = do 1103realRunKeyRing operation ctx grip0 = do
1104 bresult <- buildKeyDB ctx grip0 operation 1104 bresult <- buildKeyDB ctx grip0 operation
1105 try' bresult $ \((db, grip, wk, hs, accs,transcode,unspilled), report_imports) -> do 1105 try' bresult $ \((db, grip, wk, hs, accs,transcode,unspilled), report_imports) -> do
@@ -1163,7 +1163,7 @@ parseOptionFile fname = do
1163-- , path to public ring 1163-- , path to public ring
1164-- , fingerprint of working key 1164-- , fingerprint of working key
1165-- ) 1165-- )
1166getHomeDir :: Maybe FilePath -> IO (KikiCondition (FilePath,FilePath,FilePath,Maybe String)) 1166getHomeDir :: Maybe FilePath -> IO (KikiCondition (FilePath,FilePath,FilePath,Maybe Fingerprint))
1167getHomeDir protohome = do 1167getHomeDir protohome = do
1168 homedir <- envhomedir protohome 1168 homedir <- envhomedir protohome
1169 flip (maybe (return CantFindHome)) 1169 flip (maybe (return CantFindHome))
@@ -1183,6 +1183,7 @@ getHomeDir protohome = do
1183 return $ val 1183 return $ val
1184 1184
1185 -- TODO: rename this to getGrip 1185 -- TODO: rename this to getGrip
1186 getWorkingKey :: String -> IO (Maybe Fingerprint)
1186 getWorkingKey homedir = do 1187 getWorkingKey homedir = do
1187 let o = Nothing 1188 let o = Nothing
1188 h = Just homedir 1189 h = Just homedir
@@ -1196,5 +1197,6 @@ getHomeDir protohome = do
1196 \(forgive,fname) -> parseOptionFile fname 1197 \(forgive,fname) -> parseOptionFile fname
1197 let config = map (topair . words) args 1198 let config = map (topair . words) args
1198 where topair (x:xs) = (x,xs) 1199 where topair (x:xs) = (x,xs)
1199 return $ lookup "default-key" config >>= listToMaybe 1200 -- return $ lookup "default-key" config >>= listToMaybe
1201 return Nothing
1200 1202
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index 461afa2..510c820 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -83,9 +83,9 @@ newtype IPsToWriteToHostsFile = IPsToWriteToHostsFile [SockAddr]
83-- 83--
84-- merge all keyrings, PEM files, and wallets into process memory. 84-- merge all keyrings, PEM files, and wallets into process memory.
85-- 85--
86buildKeyDB :: InputFileContext -> Maybe String -> KeyRingOperation 86buildKeyDB :: InputFileContext -> Maybe Fingerprint -> KeyRingOperation
87 -> IO (KikiCondition (({- db -} KeyDB 87 -> IO (KikiCondition (({- db -} KeyDB
88 ,{- grip -} Maybe String 88 ,{- grip -} Maybe Fingerprint
89 ,{- wk -} Maybe MappedPacket 89 ,{- wk -} Maybe MappedPacket
90 ,{- hs -} ({- hostdbs0 -}[Hosts.Hosts], 90 ,{- hs -} ({- hostdbs0 -}[Hosts.Hosts],
91 {- hostdbs -}[Hosts.Hosts], 91 {- hostdbs -}[Hosts.Hosts],
@@ -128,7 +128,8 @@ buildKeyDB ctx grip0 keyring = do
128 ringPackets <- Map.traverseWithKey readp ringMap 128 ringPackets <- Map.traverseWithKey readp ringMap
129 let _ = ringPackets :: Map.Map InputFile (StreamInfo, Message) 129 let _ = ringPackets :: Map.Map InputFile (StreamInfo, Message)
130 130
131 let grip = grip0 `mplus` (show . fingerprint <$> fstkey) 131 let grip :: Maybe Fingerprint
132 grip = grip0 `mplus` (fingerprint <$> fstkey)
132 where 133 where
133 fstkey = do 134 fstkey = do
134 (_,Message ps) <- Map.lookup HomeSec ringPackets 135 (_,Message ps) <- Map.lookup HomeSec ringPackets
@@ -223,7 +224,7 @@ buildKeyDB ctx grip0 keyring = do
223 guard $ all (==usage) $ drop 1 us 224 guard $ all (==usage) $ drop 1 us
224 -- TODO: KikiCondition reporting for spill/fill usage mismatch? 225 -- TODO: KikiCondition reporting for spill/fill usage mismatch?
225 -- TODO: parseSpec3 226 -- TODO: parseSpec3
226 let (topspec,subspec) = parseSpec grip usage 227 let (topspec,subspec) = parseSpec (Just grip) usage
227 ms = map fst $ filterMatches topspec (kkData db) 228 ms = map fst $ filterMatches topspec (kkData db)
228 cmd = initializer stream 229 cmd = initializer stream
229 return (n,subspec,ms,stream, cmd) 230 return (n,subspec,ms,stream, cmd)
@@ -408,16 +409,16 @@ usageFromFilter _ = mzero
408 409
409-- | Parse a key specification. 410-- | Parse a key specification.
410-- The first argument is a grip for the default working key. 411-- The first argument is a grip for the default working key.
411parseSpec :: Fingerprint -> String -> (KeySpec,Maybe String) 412parseSpec :: Maybe Fingerprint -> String -> (KeySpec,Maybe String)
412parseSpec wkgrip spec = 413parseSpec wkgrip spec =
413 if not slashed 414 if not slashed
414 then 415 then
415 case prespec of 416 case prespec of
416 AnyMatch -> (KeyGrip "", Nothing) 417 AnyMatch -> (KeyGrip "", Nothing)
417 EmptyMatch -> error "Bad key spec." 418 EmptyMatch -> error "Bad key spec."
418 WorkingKeyMatch -> (KeyGrip wkgrip, Nothing) 419 WorkingKeyMatch -> (KeyGrip $ show wkgrip, Nothing)
419 SubstringMatch (Just KeyTypeField) tag -> (KeyGrip wkgrip, Just tag) 420 SubstringMatch (Just KeyTypeField) tag -> (KeyGrip $ show wkgrip, Just tag)
420 SubstringMatch Nothing str -> (KeyGrip wkgrip, Just str) 421 SubstringMatch Nothing str -> (KeyGrip $ show wkgrip, Just str)
421 SubstringMatch (Just UserIDField) ustr -> (KeyUidMatch ustr, Nothing) 422 SubstringMatch (Just UserIDField) ustr -> (KeyUidMatch ustr, Nothing)
422 FingerprintMatch fp -> (KeyGrip fp, Nothing) 423 FingerprintMatch fp -> (KeyGrip fp, Nothing)
423 else 424 else
@@ -780,8 +781,8 @@ is40digitHex xs = ys == xs && length ys==40
780 781
781matchSpec :: KeySpec -> KeyData -> Bool 782matchSpec :: KeySpec -> KeyData -> Bool
782matchSpec (KeyGrip grip) (KeyData p _ _ _) 783matchSpec (KeyGrip grip) (KeyData p _ _ _)
783 | matchpr grip (packet p)==grip = True 784 | matchpr' grip (packet p) = True
784 | otherwise = False 785 | otherwise = False
785 786
786matchSpec (KeyTag key tag) (KeyData _ sigs _ _) = not . null $ filter match ps 787matchSpec (KeyTag key tag) (KeyData _ sigs _ _) = not . null $ filter match ps
787 where 788 where
@@ -791,7 +792,7 @@ matchSpec (KeyTag key tag) (KeyData _ sigs _ _) = not . null $ filter match ps
791 && has_issuer key p 792 && has_issuer key p
792 has_issuer key p = isJust $ do 793 has_issuer key p = isJust $ do
793 issuer <- signature_issuer p 794 issuer <- signature_issuer p
794 guard $ matchpr issuer key == issuer 795 guard $ matchpr' issuer key
795 has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) 796 has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p)
796 || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) 797 || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p))
797 798
diff --git a/lib/KeyRing/Types.hs b/lib/KeyRing/Types.hs
index 1177789..1a12a61 100644
--- a/lib/KeyRing/Types.hs
+++ b/lib/KeyRing/Types.hs
@@ -1,3 +1,4 @@
1{-# LANGUAGE StandaloneDeriving #-}
1{-# LANGUAGE DeriveFunctor #-} 2{-# LANGUAGE DeriveFunctor #-}
2{-# LANGUAGE DeriveTraversable #-} 3{-# LANGUAGE DeriveTraversable #-}
3{-# LANGUAGE PatternSynonyms #-} 4{-# LANGUAGE PatternSynonyms #-}
@@ -119,7 +120,7 @@ data PassphraseSpec = PassphraseSpec
119 { passSpecRingFile :: Maybe FilePath 120 { passSpecRingFile :: Maybe FilePath
120 -- ^ If not Nothing, the passphrase is to be used for packets 121 -- ^ If not Nothing, the passphrase is to be used for packets
121 -- from this file. 122 -- from this file.
122 , passSpecKeySpec :: Maybe String 123 , passSpecKeySpec :: Maybe Fingerprint
123 -- ^ Non-Nothing value reserved for future use. 124 -- ^ Non-Nothing value reserved for future use.
124 -- (TODO: Use this to implement per-key passphrase associations). 125 -- (TODO: Use this to implement per-key passphrase associations).
125 , passSpecPassFile :: InputFile 126 , passSpecPassFile :: InputFile
@@ -129,6 +130,9 @@ data PassphraseSpec = PassphraseSpec
129 | PassphraseMemoizer { passSpecTranscoder :: PacketTranscoder } 130 | PassphraseMemoizer { passSpecTranscoder :: PacketTranscoder }
130 | PassphraseAgent 131 | PassphraseAgent
131 132
133deriving instance Ord Fingerprint
134deriving instance Eq Fingerprint
135
132instance Show PassphraseSpec where 136instance Show PassphraseSpec where
133 show (PassphraseSpec a b c) = "PassphraseSpec "++show (a,b,c) 137 show (PassphraseSpec a b c) = "PassphraseSpec "++show (a,b,c)
134 show (PassphraseMemoizer _) = "PassphraseMemoizer" 138 show (PassphraseMemoizer _) = "PassphraseMemoizer"
@@ -350,14 +354,19 @@ isTrust _ = False
350-- matchpr fp = Data.List.Extra.takeEnd (length fp) 354-- matchpr fp = Data.List.Extra.takeEnd (length fp)
351-- 355--
352matchpr :: Fingerprint -> Packet -> Bool 356matchpr :: Fingerprint -> Packet -> Bool
353matchpr fp k = p == show fp 357matchpr fp k = matchpr' (show fp) k
354 where
355 p = reverse $ zipWith const (reverse (show $ fingerprint k)) (show fp)
356 358
359matchpr' :: String -> Packet -> Bool
360matchpr' fp k = p == fp
361 where
362 p = reverse $ zipWith const (reverse (show $ fingerprint k)) fp
357 363
364matchpr'' :: String -> Packet -> String
365matchpr'' fp k | matchpr' fp k = fp
366matchpr'' fp k | otherwise = ""
358 367
359data KeySpec = 368data KeySpec =
360 KeyGrip Fingerprint -- fp: 369 KeyGrip String -- fp:
361 | KeyTag Packet String -- fp:????/t: 370 | KeyTag Packet String -- fp:????/t:
362 | KeyUidMatch String -- u: 371 | KeyUidMatch String -- u:
363 deriving Show 372 deriving Show
@@ -428,8 +437,8 @@ seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet])
428seek_key (KeyGrip grip) sec = (pre, subs) 437seek_key (KeyGrip grip) sec = (pre, subs)
429 where 438 where
430 (pre,subs) = break pred sec 439 (pre,subs) = break pred sec
431 pred p@(SecretKeyPacket {}) = matchpr grip p 440 pred p@(SecretKeyPacket {}) = matchpr' grip p
432 pred p@(PublicKeyPacket {}) = matchpr grip p 441 pred p@(PublicKeyPacket {}) = matchpr' grip p
433 pred _ = False 442 pred _ = False
434 443
435seek_key (KeyTag key tag) ps 444seek_key (KeyTag key tag) ps
@@ -442,7 +451,7 @@ seek_key (KeyTag key tag) ps
442 (as,bs) = break (\p -> isSignaturePacket p 451 (as,bs) = break (\p -> isSignaturePacket p
443 && has_tag tag p 452 && has_tag tag p
444 && isJust (signature_issuer p) 453 && isJust (signature_issuer p)
445 && matchpr (fromJust $ signature_issuer p) key == fromJust (signature_issuer p) ) 454 && matchpr' (fromJust $ signature_issuer p) key)
446 ps 455 ps
447 (rs,qs) = break isKey (reverse as) 456 (rs,qs) = break isKey (reverse as)
448 457
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 9934aaa..523c8c4 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -554,9 +554,9 @@ writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> MyIdentity -> IO ()
554writePublicKeyFiles rt fw myId@(MyIdentity _ grip) = do 554writePublicKeyFiles rt fw myId@(MyIdentity _ grip) = do
555 555
556 -- Finally, export public keys if they do not exist. 556 -- Finally, export public keys if they do not exist.
557 either warn (write fw "root/.ssh/id_rsa.pub") $ show_ssh' "ssh-client" grip (rtKeyDB rt) 557 either warn (write fw "root/.ssh/id_rsa.pub") $ show_ssh' "ssh-client" (Just grip) (rtKeyDB rt)
558 either warn (write fw "ssh_host_rsa_key.pub") $ show_ssh' "ssh-server" grip (rtKeyDB rt) 558 either warn (write fw "ssh_host_rsa_key.pub") $ show_ssh' "ssh-server" (Just grip) (rtKeyDB rt)
559 either warn (write fw $ ipsecCertPath myId) $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket 559 either warn (write fw $ ipsecCertPath myId) $ show_pem' "ipsec" (Just grip) (rtKeyDB rt) pemFromPacket
560 560
561 let cs = listPeers rt 561 let cs = listPeers rt
562 known_hosts = L.concat $ map getSshKnownHosts $ cs 562 known_hosts = L.concat $ map getSshKnownHosts $ cs
@@ -615,10 +615,10 @@ pemFromPacket k = do
615 return $ 615 return $
616 writePEM PemPublicKey qq -- ("TODO "++show keyspec) 616 writePEM PemPublicKey qq -- ("TODO "++show keyspec)
617 617
618show_pem :: String -> String -> KeyDB -> IO () 618show_pem :: String -> Maybe Fingerprint -> KeyDB -> IO ()
619show_pem keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db pemFromPacket 619show_pem keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db pemFromPacket
620 620
621show_pem' :: String -> String -> KeyDB -> (Packet -> Either String b) -> Either String b 621show_pem' :: String -> Maybe Fingerprint -> KeyDB -> (Packet -> Either String b) -> Either String b
622show_pem' keyspec wkgrip db keyfmt = do 622show_pem' keyspec wkgrip db keyfmt = do
623 let s = parseSpec wkgrip keyspec 623 let s = parseSpec wkgrip keyspec
624 flip (maybe . Left $ keyspec ++ ": not found") 624 flip (maybe . Left $ keyspec ++ ": not found")
@@ -628,17 +628,17 @@ show_pem' keyspec wkgrip db keyfmt = do
628warn :: String -> IO () 628warn :: String -> IO ()
629warn str = hPutStrLn stderr str 629warn str = hPutStrLn stderr str
630 630
631show_sshfp :: String -> String -> KeyDB -> IO () 631show_sshfp :: String -> Maybe Fingerprint -> KeyDB -> IO ()
632show_sshfp keyspec wkgrip db = do 632show_sshfp keyspec wkgrip db = do
633 let s = parseSpec wkgrip keyspec 633 let s = parseSpec wkgrip keyspec
634 case selectPublicKey s db of 634 case selectPublicKey s db of
635 Nothing -> hPutStrLn stderr $ keyspec ++ ": not found" 635 Nothing -> hPutStrLn stderr $ keyspec ++ ": not found"
636 Just k -> Char8.putStrLn $ sshKeyToHostname k 636 Just k -> Char8.putStrLn $ sshKeyToHostname k
637 637
638show_ssh :: String -> String -> KeyDB -> IO () 638show_ssh :: String -> Maybe Fingerprint -> KeyDB -> IO ()
639show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db 639show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db
640 640
641show_ssh' :: String -> Fingerprint -> KeyDB -> Either String String 641show_ssh' :: String -> Maybe Fingerprint -> KeyDB -> Either String String
642show_ssh' keyspec wkgrip db = do 642show_ssh' keyspec wkgrip db = do
643 let s = parseSpec wkgrip keyspec 643 let s = parseSpec wkgrip keyspec
644 flip (maybe . Left $ keyspec ++ ": not found") 644 flip (maybe . Left $ keyspec ++ ": not found")
diff --git a/lib/PacketTranscoder.hs b/lib/PacketTranscoder.hs
index 759d83f..b24f3d2 100644
--- a/lib/PacketTranscoder.hs
+++ b/lib/PacketTranscoder.hs
@@ -113,7 +113,7 @@ interpretPassSpec ctx _ PassphraseSpec { passSpecPassFile = fd
113 cachedContents (Just "Enter possibly multi-line passphrase (Press CTRL-D when finished):\n") 113 cachedContents (Just "Enter possibly multi-line passphrase (Press CTRL-D when finished):\n")
114 ctx 114 ctx
115 fd 115 fd
116 let matchkey fp mp = matchpr fp (packet mp) == fp 116 let matchkey fp mp = matchpr fp (packet mp)
117 matchfile file mp = Map.member file (locations mp) 117 matchfile file mp = Map.member file (locations mp)
118 specializers = [ fmap matchkey keyspec, fmap matchfile inputfile] 118 specializers = [ fmap matchkey keyspec, fmap matchfile inputfile]
119 specialize alg mp = 119 specialize alg mp =
@@ -268,7 +268,7 @@ makeMemoizingDecrypter passwdspec ctx (workingkey,keys) = do
268 268
269 trans unkeysRef = transcodeWithCache unkeysRef (foldr (makeTranscoder unkeysRef) (\_ _ -> return BadPassphrase) srcs) 269 trans unkeysRef = transcodeWithCache unkeysRef (foldr (makeTranscoder unkeysRef) (\_ _ -> return BadPassphrase) srcs)
270 270
271keyQueries :: Maybe String -> Map InputFile (StreamInfo,Message) -> (Maybe MappedPacket, Map KeyKey (OriginMapped Query)) 271keyQueries :: Maybe Fingerprint -> Map InputFile (StreamInfo,Message) -> (Maybe MappedPacket, Map KeyKey (OriginMapped Query))
272keyQueries grip ringPackets = (mwk, fmap makeQuery keys) 272keyQueries grip ringPackets = (mwk, fmap makeQuery keys)
273 where 273 where
274 makeQuery (maink,mp,us) = mp { packet = q } 274 makeQuery (maink,mp,us) = mp { packet = q }
@@ -291,8 +291,8 @@ keyQueries grip ringPackets = (mwk, fmap makeQuery keys)
291 mwk = listToMaybe $ do 291 mwk = listToMaybe $ do
292 fp <- maybeToList grip 292 fp <- maybeToList grip
293 let matchfp mp 293 let matchfp mp
294 | not (is_subkey p) && matchpr fp p == fp = Just mp 294 | not (is_subkey p) && matchpr fp p = Just mp
295 | otherwise = Nothing 295 | otherwise = Nothing
296 where p = packet mp 296 where p = packet mp
297 Map.elems $ Map.mapMaybe matchfp $ fmap (\(_,p,_) -> p) $ keys 297 Map.elems $ Map.mapMaybe matchfp $ fmap (\(_,p,_) -> p) $ keys
298 298
diff --git a/lib/Transforms.hs b/lib/Transforms.hs
index 8a1da73..f55bcc5 100644
--- a/lib/Transforms.hs
+++ b/lib/Transforms.hs
@@ -44,7 +44,7 @@ import Data.Bits ((.|.), (.&.), Bits)
44data KeyRingRuntime = KeyRingRuntime 44data KeyRingRuntime = KeyRingRuntime
45 { rtPubring :: FilePath -- ^ Path to the file represented by 'HomePub' 45 { rtPubring :: FilePath -- ^ Path to the file represented by 'HomePub'
46 , rtSecring :: FilePath -- ^ Path to the file represented by 'HomeSec' 46 , rtSecring :: FilePath -- ^ Path to the file represented by 'HomeSec'
47 , rtGrip :: Maybe String 47 , rtGrip :: Maybe Fingerprint
48 -- ^ Fingerprint or portion of a fingerprint used 48 -- ^ Fingerprint or portion of a fingerprint used
49 -- to identify the working GnuPG identity used to 49 -- to identify the working GnuPG identity used to
50 -- make signatures. 50 -- make signatures.