diff options
-rw-r--r-- | kiki.hs | 40 |
1 files changed, 22 insertions, 18 deletions
@@ -556,6 +556,7 @@ readPacketsFromFile fname = do | |||
556 | Right (_,_,msg ) -> msg | 556 | Right (_,_,msg ) -> msg |
557 | Left (_,_,_) -> Message [] | 557 | Left (_,_,_) -> Message [] |
558 | 558 | ||
559 | readPacketsFromFile' n = fmap (n,) (readPacketsFromFile n) | ||
559 | 560 | ||
560 | parseOptionFile fname = do | 561 | parseOptionFile fname = do |
561 | xs <- fmap lines (readFile fname) | 562 | xs <- fmap lines (readFile fname) |
@@ -822,8 +823,8 @@ is40digitHex xs = ys == xs && length ys==40 | |||
822 | | 'a' <= c && c <= 'f' = True | 823 | | 'a' <= c && c <= 'f' = True |
823 | ishex c = False | 824 | ishex c = False |
824 | 825 | ||
825 | scanPackets [] = [] | 826 | scanPackets filename [] = [] |
826 | scanPackets (p:ps) = scanl doit (doit (MarkerPacket,MarkerPacket,ret MarkerPacket) p) ps | 827 | scanPackets filename (p:ps) = scanl doit (doit (MarkerPacket,MarkerPacket,ret MarkerPacket) p) ps |
827 | where | 828 | where |
828 | ret p = (p,Map.empty) | 829 | ret p = (p,Map.empty) |
829 | doit (top,sub,prev) p = | 830 | doit (top,sub,prev) p = |
@@ -834,9 +835,9 @@ scanPackets (p:ps) = scanl doit (doit (MarkerPacket,MarkerPacket,ret MarkerPacke | |||
834 | _ | isTrust p -> (top,sub,updateTrust top sub prev p) | 835 | _ | isTrust p -> (top,sub,updateTrust top sub prev p) |
835 | _ | otherwise -> (top,sub,ret p) | 836 | _ | otherwise -> (top,sub,ret p) |
836 | 837 | ||
837 | updateTrust top (PublicKeyPacket {}) (pre,t) p = (pre,Map.insert "public" p t) | 838 | updateTrust top (PublicKeyPacket {}) (pre,t) p = (pre,Map.insert filename p t) -- public |
838 | updateTrust (PublicKeyPacket {}) _ (pre,t) p = (pre,Map.insert "public" p t) | 839 | updateTrust (PublicKeyPacket {}) _ (pre,t) p = (pre,Map.insert filename p t) -- public |
839 | updateTrust _ _ (pre,t) p = (pre,Map.insert "secret" p t) | 840 | updateTrust _ _ (pre,t) p = (pre,Map.insert filename p t) -- secret |
840 | 841 | ||
841 | 842 | ||
842 | type SigAndTrust = ( Packet | 843 | type SigAndTrust = ( Packet |
@@ -876,10 +877,10 @@ subcomp a b = error $ unlines ["Unable to merge subs:" | |||
876 | , PP.ppShow b | 877 | , PP.ppShow b |
877 | ] | 878 | ] |
878 | 879 | ||
879 | merge :: Map.Map KeyKey KeyData -> Message -> Map.Map KeyKey KeyData | 880 | merge :: Map.Map KeyKey KeyData -> FilePath -> Message -> Map.Map KeyKey KeyData |
880 | merge db (Message ps) = foldl mergeit db qs | 881 | merge db filename (Message ps) = foldl mergeit db qs |
881 | where | 882 | where |
882 | qs = scanPackets ps | 883 | qs = scanPackets filename ps |
883 | -- mergeit db (_,_,TrustPacket {}) = db -- Filter TrustPackets | 884 | -- mergeit db (_,_,TrustPacket {}) = db -- Filter TrustPackets |
884 | mergeit db (top,sub,ptt@(p,trustmap)) | isKey top = Map.alter update (keykey top) db | 885 | mergeit db (top,sub,ptt@(p,trustmap)) | isKey top = Map.alter update (keykey top) db |
885 | where | 886 | where |
@@ -962,7 +963,10 @@ flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs | |||
962 | flattenSub (_,SubKey key sigs) = unk key: concatMap unsig sigs | 963 | flattenSub (_,SubKey key sigs) = unk key: concatMap unsig sigs |
963 | 964 | ||
964 | unk k = if isPublic then secretToPublic k else k | 965 | unk k = if isPublic then secretToPublic k else k |
965 | unsig (sig,trustmap) = [sig]++maybeToList (Map.lookup (if isPublic then "public" else "secret") trustmap) | 966 | unsig (sig,trustmap) = [sig]++ take 1 (Map.elems $ Map.filterWithKey f trustmap) |
967 | where | ||
968 | f "%secring" _ = not isPublic | ||
969 | f _ _ = isPublic | ||
966 | 970 | ||
967 | prefilter = if isPublic then id else filter isSecret | 971 | prefilter = if isPublic then id else filter isSecret |
968 | where isSecret (_,(KeyData (SecretKeyPacket {}) _ _ _)) = True | 972 | where isSecret (_,(KeyData (SecretKeyPacket {}) _ _ _)) = True |
@@ -1306,9 +1310,9 @@ main = do | |||
1306 | , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg | 1310 | , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg |
1307 | , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321" | 1311 | , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321" |
1308 | ) <- getPGPEnviron cmd | 1312 | ) <- getPGPEnviron cmd |
1309 | let db = merge Map.empty (Message sec) | 1313 | let db = merge Map.empty "%secring" (Message sec) |
1310 | ms <- mapM readPacketsFromFile (files cmd) | 1314 | ms <- mapM readPacketsFromFile' (files cmd) |
1311 | let db' = foldl' merge db ms | 1315 | let db' = foldl' (uncurry . merge) db ms |
1312 | m = flattenKeys False db' | 1316 | m = flattenKeys False db' |
1313 | L.putStr (encode m) | 1317 | L.putStr (encode m) |
1314 | return () | 1318 | return () |
@@ -1318,9 +1322,9 @@ main = do | |||
1318 | , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg | 1322 | , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg |
1319 | , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321" | 1323 | , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321" |
1320 | ) <- getPGPEnviron cmd | 1324 | ) <- getPGPEnviron cmd |
1321 | let db = merge Map.empty (Message sec) | 1325 | let db = merge Map.empty "%secring" (Message sec) |
1322 | ms <- mapM readPacketsFromFile (files cmd) | 1326 | ms <- mapM readPacketsFromFile' (files cmd) |
1323 | let db' = foldl' merge db ms | 1327 | let db' = foldl' (uncurry . merge) db ms |
1324 | m = flattenKeys True db' | 1328 | m = flattenKeys True db' |
1325 | L.putStr (encode m) | 1329 | L.putStr (encode m) |
1326 | return () | 1330 | return () |
@@ -1343,9 +1347,9 @@ main = do | |||
1343 | 1347 | ||
1344 | flip (maybe (error "No working key?")) grip $ \grip -> do | 1348 | flip (maybe (error "No working key?")) grip $ \grip -> do |
1345 | 1349 | ||
1346 | ms <- mapM readPacketsFromFile files | 1350 | ms <- mapM readPacketsFromFile' files |
1347 | let db = merge Map.empty (Message sec) | 1351 | let db = merge Map.empty "%secring" (Message sec) |
1348 | db' = foldl' merge db ms | 1352 | db' = foldl' (uncurry . merge) db ms |
1349 | m = flattenKeys True db' | 1353 | m = flattenKeys True db' |
1350 | Message allpkts = m | 1354 | Message allpkts = m |
1351 | 1355 | ||