diff options
Diffstat (limited to 'lib/KeyRing')
-rw-r--r-- | lib/KeyRing/BuildKeyDB.hs | 109 | ||||
-rw-r--r-- | lib/KeyRing/Types.hs | 125 |
2 files changed, 145 insertions, 89 deletions
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs index 8af8198..cd1bae9 100644 --- a/lib/KeyRing/BuildKeyDB.hs +++ b/lib/KeyRing/BuildKeyDB.hs | |||
@@ -185,8 +185,7 @@ buildKeyDB ctx grip0 keyring = do | |||
185 | db_rings = Map.foldlWithKey' mergeIt emptyKeyDB transformed | 185 | db_rings = Map.foldlWithKey' mergeIt emptyKeyDB transformed |
186 | where | 186 | where |
187 | mergeIt db f (_,dbtrans) | 187 | mergeIt db f (_,dbtrans) |
188 | = KeyDB { byKeyKey = Map.unionWith mergeKeyData (byKeyKey db) (byKeyKey dbtrans) | 188 | = mergeKeyDB mergeKeyData db dbtrans |
189 | } | ||
190 | -- | reportTrans | 189 | -- | reportTrans |
191 | -- events, indexed by file | 190 | -- events, indexed by file |
192 | reportTrans :: [(FilePath, KikiReportAction)] | 191 | reportTrans :: [(FilePath, KikiReportAction)] |
@@ -226,7 +225,7 @@ buildKeyDB ctx grip0 keyring = do | |||
226 | -- TODO: KikiCondition reporting for spill/fill usage mismatch? | 225 | -- TODO: KikiCondition reporting for spill/fill usage mismatch? |
227 | -- TODO: parseSpec3 | 226 | -- TODO: parseSpec3 |
228 | let (topspec,subspec) = parseSpec grip usage | 227 | let (topspec,subspec) = parseSpec grip usage |
229 | ms = map fst $ filterMatches topspec (Map.toList $ byKeyKey db) | 228 | ms = map fst $ filterMatches topspec (kkData db) |
230 | cmd = initializer stream | 229 | cmd = initializer stream |
231 | return (n,subspec,ms,stream, cmd) | 230 | return (n,subspec,ms,stream, cmd) |
232 | 231 | ||
@@ -338,7 +337,7 @@ scanPackets filename (p:ps) = scanl doit (doit (MarkerPacket,MarkerPacket,ret Ma | |||
338 | case p of | 337 | case p of |
339 | _ | isKey p && not (is_subkey p) -> (p,MarkerPacket,ret p) | 338 | _ | isKey p && not (is_subkey p) -> (p,MarkerPacket,ret p) |
340 | _ | isKey p && is_subkey p -> (top,p,ret p) | 339 | _ | isKey p && is_subkey p -> (top,p,ret p) |
341 | _ | isUserID p -> (top,p,ret p) | 340 | _ | isJust (isUserID p) -> (top,p,ret p) |
342 | _ | isTrust p -> (top,sub,updateTrust top sub prev p) | 341 | _ | isTrust p -> (top,sub,updateTrust top sub prev p) |
343 | _ -> (top,sub,ret p) | 342 | _ -> (top,sub,ret p) |
344 | 343 | ||
@@ -385,10 +384,14 @@ doImportG | |||
385 | -> IO (KikiCondition (KeyDB, [(FilePath,KikiReportAction)])) | 384 | -> IO (KikiCondition (KeyDB, [(FilePath,KikiReportAction)])) |
386 | doImportG transcode db m0 tags fname key = do | 385 | doImportG transcode db m0 tags fname key = do |
387 | let kk = head m0 | 386 | let kk = head m0 |
388 | Just kd@(KeyData top topsigs uids subs) = Map.lookup kk (byKeyKey db) | 387 | {- |
388 | let Just kd@(KeyData top topsigs uids subs) = Map.lookup kk (byKeyKey db) | ||
389 | kdr <- insertSubkey transcode kk kd tags fname key | 389 | kdr <- insertSubkey transcode kk kd tags fname key |
390 | try kdr $ \(kd',rrs) -> return $ KikiSuccess ( db { byKeyKey = Map.insert kk kd' (byKeyKey db) } | 390 | try kdr $ \(kd',rrs) -> return $ KikiSuccess ( alterKeyDB (const $ Just kd') kk db |
391 | , rrs) | 391 | , rrs ) |
392 | -} | ||
393 | let go (Just kd@(KeyData top topsigs uids subs)) = insertSubkey transcode kk kd tags fname key | ||
394 | transmuteAt go kk db | ||
392 | 395 | ||
393 | 396 | ||
394 | iswallet :: FileType -> Bool | 397 | iswallet :: FileType -> Bool |
@@ -487,7 +490,7 @@ outgoing_names db hostdbs0 = IPsToWriteToHostsFile $ do | |||
487 | guard $ all (null . Hosts.namesForAddress addr) hostdbs0 | 490 | guard $ all (null . Hosts.namesForAddress addr) hostdbs0 |
488 | return addr | 491 | return addr |
489 | where | 492 | where |
490 | gpgnames = map getHostnames $ Map.elems $ byKeyKey db | 493 | gpgnames = map getHostnames $ keyData db |
491 | 494 | ||
492 | filterMatches :: KeySpec -> [(KeyKey,KeyData)] -> [(KeyKey,KeyData)] | 495 | filterMatches :: KeySpec -> [(KeyKey,KeyData)] -> [(KeyKey,KeyData)] |
493 | filterMatches spec ks = filter (matchSpec spec . snd) ks | 496 | filterMatches spec ks = filter (matchSpec spec . snd) ks |
@@ -513,14 +516,13 @@ generateInternals :: | |||
513 | -> [(GenerateKeyParams,StreamInfo)] | 516 | -> [(GenerateKeyParams,StreamInfo)] |
514 | -> IO (KikiCondition (KeyDB, [(FilePath, KikiReportAction)])) | 517 | -> IO (KikiCondition (KeyDB, [(FilePath, KikiReportAction)])) |
515 | generateInternals transcode mwk db gens = do | 518 | generateInternals transcode mwk db gens = do |
516 | case fmap packet mwk >>= \wk -> Map.lookup (keykey wk) (byKeyKey db) of | 519 | case mwk of |
517 | Just kd0 -> do | ||
518 | kd <- foldM (generateSubkey transcode) (KikiSuccess (kd0,[])) gens | ||
519 | try kd $ \(kd,reportGens) -> do | ||
520 | let kk = keykey $ packet $ fromJust mwk | ||
521 | return $ KikiSuccess ( KeyDB { byKeyKey = Map.insert kk kd (byKeyKey db) } | ||
522 | , reportGens ) | ||
523 | Nothing -> return $ KikiSuccess (db,[]) | 520 | Nothing -> return $ KikiSuccess (db,[]) |
521 | Just mpkt -> do | ||
522 | let kk = keykey (packet mpkt) | ||
523 | transmuteAt (go kk) kk db | ||
524 | where | ||
525 | go kk (Just kd0) = foldM (generateSubkey transcode) (KikiSuccess (kd0,[])) gens | ||
524 | 526 | ||
525 | mergeHostFiles :: KeyRingOperation -> KeyDB -> InputFileContext | 527 | mergeHostFiles :: KeyRingOperation -> KeyDB -> InputFileContext |
526 | -> IO | 528 | -> IO |
@@ -549,7 +551,7 @@ mergeHostFiles krd db ctx = do | |||
549 | 551 | ||
550 | hostdbs0 <- mapM (fmap Hosts.decode . readInputFileL' ctx) hns | 552 | hostdbs0 <- mapM (fmap Hosts.decode . readInputFileL' ctx) hns |
551 | 553 | ||
552 | let gpgnames = map getHostnames $ Map.elems (byKeyKey db) | 554 | let gpgnames = map getHostnames $ keyData db |
553 | os = do | 555 | os = do |
554 | Hostnames addr ns _ _ <- gpgnames | 556 | Hostnames addr ns _ _ <- gpgnames |
555 | n <- ns | 557 | n <- ns |
@@ -578,8 +580,7 @@ mergeHostFiles krd db ctx = do | |||
578 | 580 | ||
579 | -- 2. replace gpg annotations with those in U | 581 | -- 2. replace gpg annotations with those in U |
580 | -- forM use_db | 582 | -- forM use_db |
581 | db' <- Traversable.mapM (setHostnames addrs u1) (byKeyKey db) | 583 | db' <- mapKeyDB (setHostnames addrs u1) db |
582 | <&> \m -> db { byKeyKey = m } | ||
583 | 584 | ||
584 | return $ KikiSuccess ((db',(hostdbs0,hostdbs,u1,gpgnames,addrs)),[]) | 585 | return $ KikiSuccess ((db',(hostdbs0,hostdbs,u1,gpgnames,addrs)),[]) |
585 | 586 | ||
@@ -625,7 +626,7 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs) | |||
625 | -- mergeit db (_,_,TrustPacket {}) = db -- Filter TrustPackets | 626 | -- mergeit db (_,_,TrustPacket {}) = db -- Filter TrustPackets |
626 | mergeit :: KeyDB -> (Int,(Packet,Packet,(Packet,Map.Map FilePath Packet))) -> KeyDB | 627 | mergeit :: KeyDB -> (Int,(Packet,Packet,(Packet,Map.Map FilePath Packet))) -> KeyDB |
627 | mergeit db adding@(n,(top,sub,ptt@(p,trustmap))) | 628 | mergeit db adding@(n,(top,sub,ptt@(p,trustmap))) |
628 | | isKey top = db { byKeyKey = Map.alter update (keykey top) (byKeyKey db) } | 629 | | isKey top = alterKeyDB update (keykey top) db |
629 | where | 630 | where |
630 | update Nothing = Just $ KeyData (mappedPacketWithHint filename p n) [] Map.empty Map.empty | 631 | update Nothing = Just $ KeyData (mappedPacketWithHint filename p n) [] Map.empty Map.empty |
631 | update (Just kd) = dbInsertPacket kd filename adding | 632 | update (Just kd) = dbInsertPacket kd filename adding |
@@ -947,8 +948,7 @@ setHostnames (IPsToWriteToHostsFile outgoing_names) hosts kd@(KeyData topmp tops | |||
947 | uids0 = fmap zapIfHasName uids | 948 | uids0 = fmap zapIfHasName uids |
948 | fstuid = head $ do | 949 | fstuid = head $ do |
949 | p <- map packet $ flattenAllUids "" True uids | 950 | p <- map packet $ flattenAllUids "" True uids |
950 | guard $ isUserID p | 951 | maybeToList $ isUserID p |
951 | return $ uidkey p | ||
952 | uids1 = Map.adjust addnames fstuid uids0 | 952 | uids1 = Map.adjust addnames fstuid uids0 |
953 | addnames (sigs,om) = (fmap f ss ++ ts, om ) -- XXX: removed om=Map.empty, preserve UserId origin | 953 | addnames (sigs,om) = (fmap f ss ++ ts, om ) -- XXX: removed om=Map.empty, preserve UserId origin |
954 | where | 954 | where |
@@ -1068,15 +1068,15 @@ dbInsertPacket kd filename (n,(top,sub,ptt@(p,trustmap))) = update (Just kd) | |||
1068 | ,show (fingerprint top, fingerprint p)] | 1068 | ,show (fingerprint top, fingerprint p)] |
1069 | update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p | 1069 | update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p |
1070 | = Just $ KeyData key sigs uids (Map.alter (mergeSubkey n p) (keykey p) subkeys) | 1070 | = Just $ KeyData key sigs uids (Map.alter (mergeSubkey n p) (keykey p) subkeys) |
1071 | update (Just (KeyData key sigs uids subkeys)) | isUserID p | 1071 | update (Just (KeyData key sigs uids subkeys)) | Just uid <- isUserID p |
1072 | = Just $ KeyData key sigs (Map.alter (mergeUid n ptt) (uidkey p) uids) | 1072 | = Just $ KeyData key sigs (Map.alter (mergeUid n ptt) uid uids) |
1073 | subkeys | 1073 | subkeys |
1074 | update (Just (KeyData key sigs uids subkeys)) | 1074 | update (Just (KeyData key sigs uids subkeys)) |
1075 | = case sub of | 1075 | = case sub of |
1076 | MarkerPacket -> Just $ KeyData key (mergeSig (first (flip (mappedPacketWithHint filename) n) ptt) sigs) uids subkeys | 1076 | MarkerPacket -> Just $ KeyData key (mergeSig (first (flip (mappedPacketWithHint filename) n) ptt) sigs) uids subkeys |
1077 | UserIDPacket {} -> Just $ KeyData key | 1077 | UserIDPacket uid-> Just $ KeyData key |
1078 | sigs | 1078 | sigs |
1079 | (Map.alter (mergeUidSig n ptt) (uidkey sub) uids) | 1079 | (Map.alter (mergeUidSig n ptt) uid uids) |
1080 | subkeys | 1080 | subkeys |
1081 | _ | isKey sub -> Just $ KeyData key | 1081 | _ | isKey sub -> Just $ KeyData key |
1082 | sigs | 1082 | sigs |
@@ -1351,15 +1351,6 @@ extractRSAKeyFields kvs = do | |||
1351 | nlen = S.length bs | 1351 | nlen = S.length bs |
1352 | 1352 | ||
1353 | 1353 | ||
1354 | selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet | ||
1355 | selectKey0 wantPublic (spec,mtag) db = do | ||
1356 | let Message ps = flattenKeys wantPublic $ byKeyKey db | ||
1357 | ys = snd $ seek_key spec ps | ||
1358 | flip (maybe (listToMaybe ys)) mtag $ \tag -> do | ||
1359 | case ys of | ||
1360 | y:ys1 -> listToMaybe $ snd $ seek_key (KeyTag y tag) ys1 | ||
1361 | [] -> Nothing | ||
1362 | |||
1363 | -- TODO: Data.ByteString.Lazy now exports this. | 1354 | -- TODO: Data.ByteString.Lazy now exports this. |
1364 | toStrict :: L.ByteString -> S.ByteString | 1355 | toStrict :: L.ByteString -> S.ByteString |
1365 | toStrict = foldr1 (<>) . L.toChunks | 1356 | toStrict = foldr1 (<>) . L.toChunks |
@@ -1374,53 +1365,3 @@ packetFromPublicRSAKey notBefore n e = | |||
1374 | , v3_days_of_validity = Nothing | 1365 | , v3_days_of_validity = Nothing |
1375 | } | 1366 | } |
1376 | 1367 | ||
1377 | flattenKeys :: Bool -> Map.Map KeyKey KeyData -> Message | ||
1378 | flattenKeys isPublic db = Message $ concatMap (map packet . flattenTop "" isPublic . snd) | ||
1379 | (prefilter . Map.assocs $ db) | ||
1380 | where | ||
1381 | prefilter = if isPublic then id else filter isSecret | ||
1382 | where | ||
1383 | isSecret (_,(KeyData | ||
1384 | (MappedPacket { packet=(SecretKeyPacket {})}) | ||
1385 | _ | ||
1386 | _ | ||
1387 | _)) = True | ||
1388 | isSecret _ = False | ||
1389 | |||
1390 | seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet]) | ||
1391 | seek_key (KeyGrip grip) sec = (pre, subs) | ||
1392 | where | ||
1393 | (pre,subs) = break pred sec | ||
1394 | pred p@(SecretKeyPacket {}) = matchpr grip p == grip | ||
1395 | pred p@(PublicKeyPacket {}) = matchpr grip p == grip | ||
1396 | pred _ = False | ||
1397 | |||
1398 | seek_key (KeyTag key tag) ps | ||
1399 | | null bs = (ps, []) | ||
1400 | | null qs = | ||
1401 | let (as', bs') = seek_key (KeyTag key tag) (tail bs) in | ||
1402 | (as ++ (head bs : as'), bs') | ||
1403 | | otherwise = (reverse (tail qs), head qs : reverse rs ++ bs) | ||
1404 | where | ||
1405 | (as,bs) = break (\p -> isSignaturePacket p | ||
1406 | && has_tag tag p | ||
1407 | && isJust (signature_issuer p) | ||
1408 | && matchpr (fromJust $ signature_issuer p) key == fromJust (signature_issuer p) ) | ||
1409 | ps | ||
1410 | (rs,qs) = break isKey (reverse as) | ||
1411 | |||
1412 | has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) | ||
1413 | || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) | ||
1414 | |||
1415 | seek_key (KeyUidMatch pat) ps | ||
1416 | | null bs = (ps, []) | ||
1417 | | null qs = let (as', bs') = seek_key (KeyUidMatch pat) (tail bs) in | ||
1418 | (as ++ (head bs : as'), bs') | ||
1419 | | otherwise = (reverse (tail qs), head qs : reverse rs ++ bs) | ||
1420 | where | ||
1421 | (as,bs) = break (isInfixOf pat . uidStr) ps | ||
1422 | (rs,qs) = break isKey (reverse as) | ||
1423 | |||
1424 | uidStr (UserIDPacket s) = s | ||
1425 | uidStr _ = "" | ||
1426 | |||
diff --git a/lib/KeyRing/Types.hs b/lib/KeyRing/Types.hs index 3c1f0a5..4a0b34e 100644 --- a/lib/KeyRing/Types.hs +++ b/lib/KeyRing/Types.hs | |||
@@ -3,12 +3,13 @@ | |||
3 | {-# LANGUAGE PatternSynonyms #-} | 3 | {-# LANGUAGE PatternSynonyms #-} |
4 | module KeyRing.Types where | 4 | module KeyRing.Types where |
5 | 5 | ||
6 | import Data.Bits | ||
6 | import Data.Char (isLower,toLower) | 7 | import Data.Char (isLower,toLower) |
7 | import Data.Functor | 8 | import Data.Functor |
8 | import Data.List (groupBy,find) | 9 | import Data.List (groupBy,find,isInfixOf) |
9 | import Data.Map as Map (Map) | 10 | import Data.Map as Map (Map) |
10 | import qualified Data.Map as Map | 11 | import qualified Data.Map as Map |
11 | import Data.Maybe (maybeToList) | 12 | import Data.Maybe (maybeToList,isJust,fromJust,mapMaybe) |
12 | import Data.OpenPGP | 13 | import Data.OpenPGP |
13 | import Data.OpenPGP.Util | 14 | import Data.OpenPGP.Util |
14 | import Data.Time.Clock | 15 | import Data.Time.Clock |
@@ -335,9 +336,9 @@ isSecretKey (SecretKeyPacket {}) = True | |||
335 | isSecretKey _ = False | 336 | isSecretKey _ = False |
336 | 337 | ||
337 | 338 | ||
338 | isUserID :: Packet -> Bool | 339 | isUserID :: Packet -> Maybe String |
339 | isUserID (UserIDPacket {}) = True | 340 | isUserID (UserIDPacket str) = Just str |
340 | isUserID _ = False | 341 | isUserID _ = Nothing |
341 | 342 | ||
342 | isTrust :: Packet -> Bool | 343 | isTrust :: Packet -> Bool |
343 | isTrust (TrustPacket {}) = True | 344 | isTrust (TrustPacket {}) = True |
@@ -408,3 +409,117 @@ data SingleKeySpec = FingerprintMatch String | |||
408 | | WorkingKeyMatch | 409 | | WorkingKeyMatch |
409 | deriving (Show,Eq,Ord) | 410 | deriving (Show,Eq,Ord) |
410 | 411 | ||
412 | secretToPublic :: Packet -> Packet | ||
413 | secretToPublic pkt@(SecretKeyPacket {}) = | ||
414 | PublicKeyPacket { version = version pkt | ||
415 | , timestamp = timestamp pkt | ||
416 | , key_algorithm = key_algorithm pkt | ||
417 | -- , ecc_curve = ecc_curve pkt | ||
418 | , key = let seckey = key pkt | ||
419 | pubs = public_key_fields (key_algorithm pkt) | ||
420 | in filter (\(k,v) -> k `elem` pubs) seckey | ||
421 | , is_subkey = is_subkey pkt | ||
422 | , v3_days_of_validity = Nothing | ||
423 | } | ||
424 | secretToPublic pkt = pkt | ||
425 | |||
426 | seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet]) | ||
427 | seek_key (KeyGrip grip) sec = (pre, subs) | ||
428 | where | ||
429 | (pre,subs) = break pred sec | ||
430 | pred p@(SecretKeyPacket {}) = matchpr grip p == grip | ||
431 | pred p@(PublicKeyPacket {}) = matchpr grip p == grip | ||
432 | pred _ = False | ||
433 | |||
434 | seek_key (KeyTag key tag) ps | ||
435 | | null bs = (ps, []) | ||
436 | | null qs = | ||
437 | let (as', bs') = seek_key (KeyTag key tag) (tail bs) in | ||
438 | (as ++ (head bs : as'), bs') | ||
439 | | otherwise = (reverse (tail qs), head qs : reverse rs ++ bs) | ||
440 | where | ||
441 | (as,bs) = break (\p -> isSignaturePacket p | ||
442 | && has_tag tag p | ||
443 | && isJust (signature_issuer p) | ||
444 | && matchpr (fromJust $ signature_issuer p) key == fromJust (signature_issuer p) ) | ||
445 | ps | ||
446 | (rs,qs) = break isKey (reverse as) | ||
447 | |||
448 | has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) | ||
449 | || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) | ||
450 | |||
451 | seek_key (KeyUidMatch pat) ps | ||
452 | | null bs = (ps, []) | ||
453 | | null qs = let (as', bs') = seek_key (KeyUidMatch pat) (tail bs) in | ||
454 | (as ++ (head bs : as'), bs') | ||
455 | | otherwise = (reverse (tail qs), head qs : reverse rs ++ bs) | ||
456 | where | ||
457 | (as,bs) = break (isInfixOf pat . uidStr) ps | ||
458 | (rs,qs) = break isKey (reverse as) | ||
459 | |||
460 | uidStr (UserIDPacket s) = s | ||
461 | uidStr _ = "" | ||
462 | |||
463 | usageString :: PGPKeyFlags -> String | ||
464 | usageString flgs = | ||
465 | case flgs of | ||
466 | Special -> "special" | ||
467 | Vouch -> "vouch" -- signkey | ||
468 | Sign -> "sign" | ||
469 | VouchSign -> "vouch-sign" | ||
470 | Communication -> "communication" | ||
471 | VouchCommunication -> "vouch-communication" | ||
472 | SignCommunication -> "sign-communication" | ||
473 | VouchSignCommunication -> "vouch-sign-communication" | ||
474 | Storage -> "storage" | ||
475 | VouchStorage -> "vouch-storage" | ||
476 | SignStorage -> "sign-storage" | ||
477 | VouchSignStorage -> "vouch-sign-storage" | ||
478 | Encrypt -> "encrypt" | ||
479 | VouchEncrypt -> "vouch-encrypt" | ||
480 | SignEncrypt -> "sign-encrypt" | ||
481 | VouchSignEncrypt -> "vouch-sign-encrypt" | ||
482 | |||
483 | usage :: SignatureSubpacket -> Maybe String | ||
484 | usage (NotationDataPacket | ||
485 | { human_readable = True | ||
486 | , notation_name = "usage@" | ||
487 | , notation_value = u | ||
488 | }) = Just u | ||
489 | usage _ = Nothing | ||
490 | |||
491 | data PGPKeyFlags = | ||
492 | Special | ||
493 | | Vouch -- 0001 C -- Signkey | ||
494 | | Sign -- 0010 S | ||
495 | | VouchSign -- 0011 | ||
496 | | Communication -- 0100 E | ||
497 | | VouchCommunication -- 0101 | ||
498 | | SignCommunication -- 0110 | ||
499 | | VouchSignCommunication -- 0111 | ||
500 | | Storage -- 1000 E | ||
501 | | VouchStorage -- 1001 | ||
502 | | SignStorage -- 1010 | ||
503 | | VouchSignStorage -- 1011 | ||
504 | | Encrypt -- 1100 E | ||
505 | | VouchEncrypt -- 1101 | ||
506 | | SignEncrypt -- 1110 | ||
507 | | VouchSignEncrypt -- 1111 | ||
508 | deriving (Eq,Show,Read,Enum) | ||
509 | |||
510 | -- XXX keyFlags and keyflags are different functions. | ||
511 | keyflags :: SignatureSubpacket -> Maybe PGPKeyFlags | ||
512 | keyflags flgs@(KeyFlagsPacket {}) = | ||
513 | Just . toEnum $ | ||
514 | ( bit 0x1 certify_keys | ||
515 | .|. bit 0x2 sign_data | ||
516 | .|. bit 0x4 encrypt_communication | ||
517 | .|. bit 0x8 encrypt_storage ) :: Maybe PGPKeyFlags | ||
518 | -- other flags: | ||
519 | -- split_key | ||
520 | -- authentication (ssh-client) | ||
521 | -- group_key | ||
522 | where | ||
523 | bit v f = if f flgs then v else 0 | ||
524 | keyflags _ = Nothing | ||
525 | |||