diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Transforms.hs | 60 |
1 files changed, 32 insertions, 28 deletions
diff --git a/lib/Transforms.hs b/lib/Transforms.hs index 7750ec5..9571e7e 100644 --- a/lib/Transforms.hs +++ b/lib/Transforms.hs | |||
@@ -751,39 +751,43 @@ parseUID str = UserIDRecord { | |||
751 | T.reverse . T.drop 1 -> subdomain) | 751 | T.reverse . T.drop 1 -> subdomain) |
752 | = T.break (=='.') . T.reverse $ hostname | 752 | = T.break (=='.') . T.reverse $ hostname |
753 | 753 | ||
754 | selfAuthenticated :: OriginMapped Packet -> KeyData -> UidString -> Bool | ||
755 | selfAuthenticated k kd (UidString str) = | ||
756 | and [ uid_topdomain parsed == "onion" | ||
757 | , uid_realname parsed `elem` ["","Anonymous"] | ||
758 | , uid_user parsed == "root" | ||
759 | , fmap (match . fst) (lookup (packet k) torbindings) == Just True | ||
760 | ] | ||
761 | where | ||
762 | parsed = parseUID str | ||
763 | match = (==subdom) . take (fromIntegral len) | ||
764 | len = T.length (uid_subdomain parsed) | ||
765 | subdom0 = L.fromChunks [encodeUtf8 (uid_subdomain parsed)] | ||
766 | subdom = Char8.unpack subdom0 | ||
767 | torbindings = getTorKeys (map packet $ flattenTop "" True kd) | ||
768 | |||
769 | getTorKeys :: [Packet] -> [(Packet, (String, Packet))] | ||
770 | getTorKeys pub = do | ||
771 | xs <- groupBindings pub | ||
772 | (_,(top,sub),us,_,_) <- xs | ||
773 | guard ("tor" `elem` us) | ||
774 | let torhash = fromMaybe "" $ derToBase32 <$> derRSA sub | ||
775 | return (top,(torhash,sub)) | ||
776 | |||
777 | groupBindings :: [Packet] -> [[(Word8, (Packet, Packet), [String], [SignatureSubpacket], [Packet])]] | ||
778 | groupBindings (accBindings . snd . getBindings -> bindings) = gs | ||
779 | where | ||
780 | code (c,(m,s),_,_,_) = (fingerprint_material m,-c) | ||
781 | ownerkey (_,(a,_),_,_,_) = a | ||
782 | sameMaster (ownerkey->a) (ownerkey->b) = fingerprint_material a==fingerprint_material b | ||
783 | gs = groupBy sameMaster (sortBy (comparing code) bindings) | ||
784 | |||
754 | -- | resolveTransform | 785 | -- | resolveTransform |
755 | resolveTransform :: Transform -> KeyRingRuntime -> KeyData -> [PacketUpdate] | 786 | resolveTransform :: Transform -> KeyRingRuntime -> KeyData -> [PacketUpdate] |
756 | resolveTransform Autosign rt kd@(KeyData k ksigs umap submap) = ops | 787 | resolveTransform Autosign rt kd@(KeyData k ksigs umap submap) = ops |
757 | where | 788 | where |
758 | ops = map (\(UidString u) -> InducerSignature u []) us | 789 | ops = map (\(UidString u) -> InducerSignature u []) us |
759 | us = filter torStyle $ Map.keys umap | 790 | us = filter (selfAuthenticated k kd) $ Map.keys umap |
760 | torStyle (UidString str) = and [ uid_topdomain parsed == "onion" | ||
761 | , uid_realname parsed `elem` ["","Anonymous"] | ||
762 | , uid_user parsed == "root" | ||
763 | , fmap (match . fst) (lookup (packet k) torbindings) | ||
764 | == Just True ] | ||
765 | where parsed = parseUID str | ||
766 | match = (==subdom) . take (fromIntegral len) | ||
767 | subdom0 = L.fromChunks [encodeUtf8 (uid_subdomain parsed)] | ||
768 | subdom = Char8.unpack subdom0 | ||
769 | len = T.length (uid_subdomain parsed) | ||
770 | torbindings = getTorKeys (map packet $ flattenTop "" True kd) | ||
771 | getTorKeys pub = do | ||
772 | xs <- groupBindings pub | ||
773 | (_,(top,sub),us,_,_) <- xs | ||
774 | guard ("tor" `elem` us) | ||
775 | let torhash = fromMaybe "" $ derToBase32 <$> derRSA sub | ||
776 | return (top,(torhash,sub)) | ||
777 | |||
778 | groupBindings pub = gs | ||
779 | where (_,bindings) = getBindings pub | ||
780 | bindings' = accBindings bindings | ||
781 | code (c,(m,s),_,_,_) = (fingerprint_material m,-c) | ||
782 | ownerkey (_,(a,_),_,_,_) = a | ||
783 | sameMaster (ownerkey->a) (ownerkey->b) | ||
784 | = fingerprint_material a==fingerprint_material b | ||
785 | gs = groupBy sameMaster (sortBy (comparing code) bindings') | ||
786 | |||
787 | 791 | ||
788 | -- (2 of 4) resolveTransform :: Transform -> KeyRingRuntime -> KeyData -> [PacketUpdate] | 792 | -- (2 of 4) resolveTransform :: Transform -> KeyRingRuntime -> KeyData -> [PacketUpdate] |
789 | resolveTransform (DeleteSubkeyByFingerprint fp) rt kd@(KeyData k ksigs umap submap) = fmap (SubKeyDeletion topk) subk | 793 | resolveTransform (DeleteSubkeyByFingerprint fp) rt kd@(KeyData k ksigs umap submap) = fmap (SubKeyDeletion topk) subk |