From 832e580497558deccca59622e2c2fc395a854130 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 14 Apr 2014 19:54:21 -0400 Subject: work in progress: buildKeyDB --- Base58.hs | 37 ++++++++ KeyRing.hs | 313 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- kiki.hs | 272 ----------------------------------------------------- 3 files changed, 340 insertions(+), 282 deletions(-) create mode 100644 Base58.hs diff --git a/Base58.hs b/Base58.hs new file mode 100644 index 0000000..26f1cb2 --- /dev/null +++ b/Base58.hs @@ -0,0 +1,37 @@ +module Base58 where + +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString as S +import Data.Maybe +import Data.List +import Data.Word ( Word8 ) +import Control.Monad + +base58chars = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" + +base58digits :: [Char] -> Maybe [Int] +base58digits str = sequence mbs + where + mbs = map (flip elemIndex base58chars) str + +-- 5HueCGU8rMjxEXxiPuD5BDku4MkFqeZyd4dZ1jvhTVqvbTLvyTJ +base58_decode :: [Char] -> Maybe (Word8,[Word8]) +base58_decode str = do + ds <- base58digits str + let n = foldl' (\a b-> a*58 + b) 0 $ ( map fromIntegral ds :: [Integer] ) + rbytes = unfoldr getbyte n + getbyte d = do + guard (d/=0) + let (q,b) = d `divMod` 256 + return (fromIntegral b,q) + + let (rcksum,rpayload) = splitAt 4 $ rbytes + a_payload = reverse rpayload + hash_result = S.take 4 . SHA256.hash . SHA256.hash . S.pack $ a_payload + expected_hash = S.pack $ reverse rcksum + (network_id,payload) = splitAt 1 a_payload + + network_id <- listToMaybe network_id + guard (hash_result==expected_hash) + return (network_id,payload) + diff --git a/KeyRing.hs b/KeyRing.hs index cdfcd34..2a80930 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -2,6 +2,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE OverloadedStrings #-} module KeyRing where import System.Environment @@ -11,17 +12,32 @@ import Data.Char import Data.List import Data.OpenPGP import Data.Functor -import Control.Applicative ( (<$>) ) +import Data.Bits ( (.|.) ) +-- import Control.Applicative ( (<$>) ) import System.Directory ( getHomeDirectory, doesFileExist ) import Control.Arrow ( first, second ) import Data.OpenPGP.Util ( fingerprint ) import Data.ByteString.Lazy ( ByteString ) import Text.Show.Pretty as PP ( ppShow ) +import Data.Word ( Word8 ) +import Data.Binary ( decode ) +import ControlMaybe ( handleIO_ ) import qualified Data.Map as Map - +import qualified Data.ByteString.Lazy as L ( null, readFile, ByteString ) +import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break ) +import qualified Crypto.Types.PubKey.ECC as ECC +import System.Posix.Types (EpochTime) +import System.Posix.Files ( modificationTime, getFileStatus ) + +import qualified CryptoCoins as CryptoCoins +import Base58 import FunctorToMaybe import DotLock +-- DER-encoded elliptic curve ids +nistp256_id = 0x2a8648ce3d030107 +secp256k1_id = 0x2b8104000a + data HomeDir = HomeDir { homevar :: String , appdir :: String @@ -51,6 +67,7 @@ data KeyRingRuntime = KeyRingRuntime , rtRings :: [FilePath] , rtWallets :: [FilePath] , rtGrip :: Maybe String + , rtKeyDB :: KeyDB } data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a) @@ -61,17 +78,19 @@ data KeyRingData = KeyRingData , homeSpec :: Maybe String } -filesToLock k secring pubring = do - (f,(rtyp,ftyp)) <- Map.toList (kFiles k) - case rtyp of - ConstRef -> [] - MutableRef {} -> resolve f +resolveInputFile secring pubring = resolve where resolve HomeSec = return secring resolve HomePub = return pubring resolve (ArgFile f) = return f resolve _ = [] +filesToLock k secring pubring = do + (f,(rtyp,ftyp)) <- Map.toList (kFiles k) + case rtyp of + ConstRef -> [] + MutableRef {} -> resolveInputFile secring pubring f + -- kret :: a -> KeyRingData a -- kret x = KeyRingData Map.empty Nothing (KeyRingAction x) @@ -102,6 +121,188 @@ data KikiResult a = KikiResult , kikiReport :: [ (FilePath, KikiReportAction) ] } +keyPacket (KeyData k _ _ _) = packet k + +usage (NotationDataPacket + { human_readable = True + , notation_name = "usage@" + , notation_value = u + }) = Just u +usage _ = Nothing + +keyflags flgs@(KeyFlagsPacket {}) = + Just . toEnum $ + ( bit 0x1 certify_keys + .|. bit 0x2 sign_data + .|. bit 0x4 encrypt_communication + .|. bit 0x8 encrypt_storage ) :: Maybe PGPKeyFlags + -- other flags: + -- split_key + -- authentication (ssh-client) + -- group_key + where + bit v f = if f flgs then v else 0 +keyflags _ = Nothing + + +data PGPKeyFlags = + Special + | Vouch -- Signkey + | Sign + | VouchSign + | Communication + | VouchCommunication + | SignCommunication + | VouchSignCommunication + | Storage + | VouchStorage + | SignStorage + | VouchSignStorage + | Encrypt + | VouchEncrypt + | SignEncrypt + | VouchSignEncrypt + deriving (Eq,Show,Read,Enum) +usageString flgs = + case flgs of + Special -> "special" + Vouch -> "vouch" -- signkey + Sign -> "sign" + VouchSign -> "vouch-sign" + Communication -> "communication" + VouchCommunication -> "vouch-communication" + SignCommunication -> "sign-communication" + VouchSignCommunication -> "vouch-sign-communication" + Storage -> "storage" + VouchStorage -> "vouch-storage" + SignStorage -> "sign-storage" + VouchSignStorage -> "vouch-sign-storage" + Encrypt -> "encrypt" + VouchEncrypt -> "vouch-encrypt" + SignEncrypt -> "sign-encrypt" + VouchSignEncrypt -> "vouch-sign-encrypt" + + + + +-- matchpr computes the fingerprint of the given key truncated to +-- be the same lenght as the given fingerprint for comparison. +matchpr fp k = reverse $ zipWith const (reverse (fingerprint k)) fp + +keyFlags wkun uids = keyFlags0 wkun (filter isSignaturePacket uids) +keyFlags0 wkun uidsigs = concat + [ keyflags + , preferredsym + , preferredhash + , preferredcomp + , features ] + + where + subs = concatMap hashed_subpackets uidsigs + keyflags = filterOr isflags subs $ + KeyFlagsPacket { certify_keys = True + , sign_data = True + , encrypt_communication = False + , encrypt_storage = False + , split_key = False + , authentication = False + , group_key = False + } + preferredsym = filterOr ispreferedsym subs $ + PreferredSymmetricAlgorithmsPacket + [ AES256 + , AES192 + , AES128 + , CAST5 + , TripleDES + ] + preferredhash = filterOr ispreferedhash subs $ + PreferredHashAlgorithmsPacket + [ SHA256 + , SHA1 + , SHA384 + , SHA512 + , SHA224 + ] + preferredcomp = filterOr ispreferedcomp subs $ + PreferredCompressionAlgorithmsPacket + [ ZLIB + , BZip2 + , ZIP + ] + features = filterOr isfeatures subs $ + FeaturesPacket { supports_mdc = True + } + + filterOr pred xs def = if null rs then [def] else rs where rs=filter pred xs + + isflags (KeyFlagsPacket {}) = True + isflags _ = False + ispreferedsym (PreferredSymmetricAlgorithmsPacket {}) = True + ispreferedsym _ = False + ispreferedhash (PreferredHashAlgorithmsPacket {}) = True + ispreferedhash _ = False + ispreferedcomp (PreferredCompressionAlgorithmsPacket {}) = True + ispreferedcomp _ = False + isfeatures (FeaturesPacket {}) = True + isfeatures _ = False + + +matchSpec (KeyGrip grip) (_,KeyData p _ _ _) + | matchpr grip (packet p)==grip = True + | otherwise = False + +matchSpec (KeyTag key tag) (_,KeyData _ sigs _ _) = not . null $ filter match ps + where + ps = map (packet .fst) sigs + match p = isSignaturePacket p + && has_tag tag p + && has_issuer key p + has_issuer key p = isJust $ do + issuer <- signature_issuer p + guard $ matchpr issuer key == issuer + has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) + || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) + +matchSpec (KeyUidMatch pat) (_,KeyData _ _ uids _) = not $ null us + where + us = filter (isInfixOf pat) $ Map.keys uids + + +data KeySpec = + KeyGrip String + | KeyTag Packet String + | KeyUidMatch String + deriving Show + + +buildKeyDB :: FilePath -> FilePath -> Maybe String -> KeyRingData + -> IO ((KeyDB,String),[(FilePath,KikiReportAction)]) +buildKeyDB secring pubring grip0 keyring = do + let rings = do + (f,(rtyp,ftyp)) <- Map.toList (kFiles keyring) + let isring (KeyRingFile {}) = True + isring _ = False + guard (isring ftyp) + resolveInputFile secring pubring f + readp n = fmap (n,) (readPacketsFromFile n) + readw wk n = fmap (n,) (readPacketsFromWallet wk n) + ms <- mapM readp rings + let grip = grip0 `mplus` (fingerprint <$> fstkey) + where + fstkey = listToMaybe $ mapMaybe isSecringKey ms + where isSecringKey (fn,Message ps) + | fn==secring = listToMaybe ps + isSecringKey _ = Nothing + wk = listToMaybe $ do + fp <- maybeToList grip + elm <- Map.toList db0 + guard $ matchSpec (KeyGrip fp) elm + return $ keyPacket (snd elm) + db0 = foldl' (uncurry . merge) Map.empty ms + db <- return db0 -- todo + return ( (db, todo), todo ) + runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a) runKeyRing keyring op = do (homedir,secring,pubring,grip0) <- getHomeDir (homeSpec keyring) @@ -117,7 +318,7 @@ runKeyRing keyring op = do ret = if null failed then KikiSuccess () else FailedToLock failed ret <- case functorToEither ret of Right {} -> do - report <- todo -- build db + ((db,grip), report1) <- buildKeyDB secring pubring grip0 keyring -- build db a <- return $ op KeyRingRuntime { rtPubring = pubring @@ -125,10 +326,11 @@ runKeyRing keyring op = do , rtRings = [] -- todo secring:pubring:keyringFiles keyring , rtWallets = [] -- todo walletFiles keyring , rtGrip = grip0 + , rtKeyDB = db } - report <- todo report -- write files + report2 <- todo -- write files - return $ KikiResult (KikiSuccess a) report + return $ KikiResult (KikiSuccess a) (report1 ++ report2) Left err -> return $ KikiResult err [] forM_ lked $ \(Just lk, fname) -> do dotlock_release lk @@ -196,6 +398,97 @@ isUserID _ = False isTrust (TrustPacket {}) = True isTrust _ = False +slurpWIPKeys :: System.Posix.Types.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString]) +slurpWIPKeys stamp "" = ([],[]) +slurpWIPKeys stamp cs = + let (b58,xs) = Char8.span (\x -> elem x base58chars) cs + mb = decode_btc_key stamp (Char8.unpack b58) + in if L.null b58 + then let (ys,xs') = Char8.break (\x -> elem x base58chars) cs + (ks,js) = slurpWIPKeys stamp xs' + in (ks,ys:js) + else let (ks,js) = slurpWIPKeys stamp xs + in maybe (ks,b58:js) (\(net,Message [k])->((net,k):ks,js)) mb + + +decode_btc_key timestamp str = do + (network_id,us) <- base58_decode str + return . (network_id,) $ Message $ do + let d = foldl' (\a b->a*256+b) 0 (map fromIntegral us :: [Integer]) + {- + xy = secp256k1_G `pmul` d + x = getx xy + y = gety xy + -- y² = x³ + 7 (mod p) + y' = sqrtModP' (applyCurve secp256k1_curve x) (getp secp256k1_curve) + y'' = sqrtModPList (applyCurve secp256k1_curve x) (getp secp256k1_curve) + -} + secp256k1 = ECC.getCurveByName ECC.SEC_p256k1 + ECC.Point x y = ECC.ecc_g $ ECC.common_curve secp256k1 + -- pub = cannonical_eckey x y + -- hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub + -- address = base58_encode hash + -- pubstr = concatMap (printf "%02x") $ pub + -- _ = pubstr :: String + return $ {- trace (unlines ["pub="++show pubstr + ,"add="++show address + ,"y ="++show y + ,"y' ="++show y' + ,"y''="++show y'']) -} + SecretKeyPacket + { version = 4 + , timestamp = toEnum (fromEnum timestamp) + , key_algorithm = ECDSA + , key = [ -- public fields... + ('c',MPI secp256k1_id) -- secp256k1 (bitcoin curve) + ,('l',MPI 256) + ,('x',MPI x) + ,('y',MPI y) + -- secret fields + ,('d',MPI d) + ] + , s2k_useage = 0 + , s2k = S2K 100 "" + , symmetric_algorithm = Unencrypted + , encrypted_data = "" + , is_subkey = True + } + +readPacketsFromWallet :: + Maybe Packet + -> FilePath + -> IO [(Packet,Packet,(Packet,Map.Map FilePath Packet))] +readPacketsFromWallet wk fname = do + timestamp <- handleIO_ (error $ fname++": modificaiton time?") $ + modificationTime <$> getFileStatus fname + input <- L.readFile fname + let (ks,_) = slurpWIPKeys timestamp input + when (not (null ks)) $ do + -- decrypt wk + -- create sigs + -- return key/sig pairs + return () + return $ do + wk <- maybeToList wk + guard (not $ null ks) + let prep (tagbyte,k) = (wk,k,(k,Map.singleton tag wk)) + where tag = CryptoCoins.nameFromSecretByte tagbyte + (wk,MarkerPacket,(MarkerPacket,Map.empty)) + :map prep ks + +readPacketsFromFile :: FilePath -> IO Message +readPacketsFromFile fname = do + -- warn $ fname ++ ": reading..." + input <- L.readFile fname +#if MIN_VERSION_binary(0,6,4) + return $ + case decodeOrFail input of + Right (_,_,msg ) -> msg + Left (_,_,_) -> trace (fname++": read fail") $ Message [] +#else + return $ decode input +#endif + data OriginFlags = OriginFlags { originallyPublic :: Bool, diff --git a/kiki.hs b/kiki.hs index 365562b..d7ea9c7 100644 --- a/kiki.hs +++ b/kiki.hs @@ -347,13 +347,6 @@ isPublicMaster _ = False now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime -usage (NotationDataPacket - { human_readable = True - , notation_name = "usage@" - , notation_value = u - }) = Just u -usage _ = Nothing - verifyBindings keys nonkeys = (top ++ filter isSubkeySignature embedded,othersigs) where verified = do @@ -380,10 +373,6 @@ grip k = drop 32 $ fingerprint k smallpr k = drop 24 $ fingerprint k --- matchpr computes the fingerprint of the given key truncated to --- be the same lenght as the given fingerprint for comparison. -matchpr fp k = reverse $ zipWith const (reverse (fingerprint k)) fp - disjoint_fp ks = {- concatMap group2 $ -} transpose grouped where @@ -587,58 +576,6 @@ listKeysFiltered grips pkts = do "master-key " ++ fingerprint top ++ "\n" ++ uid ++" ...\n" ++ subkeys ++ "\n" -data PGPKeyFlags = - Special - | Vouch -- Signkey - | Sign - | VouchSign - | Communication - | VouchCommunication - | SignCommunication - | VouchSignCommunication - | Storage - | VouchStorage - | SignStorage - | VouchSignStorage - | Encrypt - | VouchEncrypt - | SignEncrypt - | VouchSignEncrypt - deriving (Eq,Show,Read,Enum) - -usageString flgs = - case flgs of - Special -> "special" - Vouch -> "vouch" -- signkey - Sign -> "sign" - VouchSign -> "vouch-sign" - Communication -> "communication" - VouchCommunication -> "vouch-communication" - SignCommunication -> "sign-communication" - VouchSignCommunication -> "vouch-sign-communication" - Storage -> "storage" - VouchStorage -> "vouch-storage" - SignStorage -> "sign-storage" - VouchSignStorage -> "vouch-sign-storage" - Encrypt -> "encrypt" - VouchEncrypt -> "vouch-encrypt" - SignEncrypt -> "sign-encrypt" - VouchSignEncrypt -> "vouch-sign-encrypt" - - -keyflags flgs@(KeyFlagsPacket {}) = - Just . toEnum $ - ( bit 0x1 certify_keys - .|. bit 0x2 sign_data - .|. bit 0x4 encrypt_communication - .|. bit 0x8 encrypt_storage ) :: Maybe PGPKeyFlags - -- other flags: - -- split_key - -- authentication (ssh-client) - -- group_key - where - bit v f = if f flgs then v else 0 -keyflags _ = Nothing modifyUID (UserIDPacket str) = UserIDPacket str' @@ -666,53 +603,6 @@ expandPath path [] = [] -- type TimeStamp = Word32 -slurpWIPKeys :: System.Posix.Types.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString]) -slurpWIPKeys stamp "" = ([],[]) -slurpWIPKeys stamp cs = - let (b58,xs) = Char8.span (\x -> elem x base58chars) cs - mb = decode_btc_key stamp (Char8.unpack b58) - in if L.null b58 - then let (ys,xs') = Char8.break (\x -> elem x base58chars) cs - (ks,js) = slurpWIPKeys stamp xs' - in (ks,ys:js) - else let (ks,js) = slurpWIPKeys stamp xs - in maybe (ks,b58:js) (\(net,Message [k])->((net,k):ks,js)) mb - -readPacketsFromWallet :: - Maybe Packet - -> FilePath - -> IO [(Packet,Packet,(Packet,Map.Map FilePath Packet))] -readPacketsFromWallet wk fname = do - timestamp <- handleIO_ (error $ fname++": modificaiton time?") $ - modificationTime <$> getFileStatus fname - input <- L.readFile fname - let (ks,_) = slurpWIPKeys timestamp input - when (not (null ks)) $ do - -- decrypt wk - -- create sigs - -- return key/sig pairs - return () - return $ do - wk <- maybeToList wk - guard (not $ null ks) - let prep (tagbyte,k) = (wk,k,(k,Map.singleton tag wk)) - where tag = CryptoCoins.nameFromSecretByte tagbyte - (wk,MarkerPacket,(MarkerPacket,Map.empty)) - :map prep ks - -readPacketsFromFile :: FilePath -> IO Message -readPacketsFromFile fname = do - -- warn $ fname ++ ": reading..." - input <- L.readFile fname -#if MIN_VERSION_binary(0,6,4) - return $ - case decodeOrFail input of - Right (_,_,msg ) -> msg - Left (_,_,_) -> trace (fname++": read fail") $ Message [] -#else - return $ decode input -#endif - -- | Attempts to lock each file in the list. -- Returns a list of locks and a list of filenames -- that could not be locked. @@ -984,12 +874,6 @@ getPassphrase cmd = #define HOMEOPTION (def &= explicit &= name "homedir" &= typDir ) -data KeySpec = - KeyGrip String - | KeyTag Packet String - | KeyUidMatch String - deriving Show - is40digitHex xs = ys == xs && length ys==40 where ys = filter ishex xs @@ -1062,7 +946,6 @@ sortByHint fname f = sortBy (comparing gethint) defnum = -1 keyMappedPacket (KeyData k _ _ _) = k -keyPacket (KeyData k _ _ _) = packet k writeOutKeyrings :: Map.Map FilePath t -> KeyDB -> IO () writeOutKeyrings lkmap db = do @@ -1417,34 +1300,6 @@ secp256k1_G = ECPa secp256k1_curve -} -} -base58chars = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" - -base58digits :: [Char] -> Maybe [Int] -base58digits str = sequence mbs - where - mbs = map (flip elemIndex base58chars) str - --- 5HueCGU8rMjxEXxiPuD5BDku4MkFqeZyd4dZ1jvhTVqvbTLvyTJ -base58_decode :: [Char] -> Maybe (Word8,[Word8]) -base58_decode str = do - ds <- base58digits str - let n = foldl' (\a b-> a*58 + b) 0 $ ( map fromIntegral ds :: [Integer] ) - rbytes = unfoldr getbyte n - getbyte d = do - guard (d/=0) - let (q,b) = d `divMod` 256 - return (fromIntegral b,q) - - let (rcksum,rpayload) = splitAt 4 $ rbytes - a_payload = reverse rpayload - hash_result = S.take 4 . SHA256.hash . SHA256.hash . S.pack $ a_payload - expected_hash = S.pack $ reverse rcksum - (network_id,payload) = splitAt 1 a_payload - - network_id <- listToMaybe network_id - guard (hash_result==expected_hash) - return (network_id,payload) - walletImportFormat idbyte k = secret_base58_foo where -- isSecret (SecretKeyPacket {}) = True @@ -1530,48 +1385,6 @@ bitcoinAddress network_id k = address -- 0x4e*128+0x3d 10045 -- 1.2.840.10045.3.1.7 --> NIST P-256 -- -decode_btc_key timestamp str = do - (network_id,us) <- base58_decode str - return . (network_id,) $ Message $ do - let d = foldl' (\a b->a*256+b) 0 (map fromIntegral us :: [Integer]) - {- - xy = secp256k1_G `pmul` d - x = getx xy - y = gety xy - -- y² = x³ + 7 (mod p) - y' = sqrtModP' (applyCurve secp256k1_curve x) (getp secp256k1_curve) - y'' = sqrtModPList (applyCurve secp256k1_curve x) (getp secp256k1_curve) - -} - secp256k1 = ECC.getCurveByName ECC.SEC_p256k1 - ECC.Point x y = ECC.ecc_g $ ECC.common_curve secp256k1 - -- pub = cannonical_eckey x y - -- hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub - -- address = base58_encode hash - -- pubstr = concatMap (printf "%02x") $ pub - -- _ = pubstr :: String - return $ {- trace (unlines ["pub="++show pubstr - ,"add="++show address - ,"y ="++show y - ,"y' ="++show y' - ,"y''="++show y'']) -} - SecretKeyPacket - { version = 4 - , timestamp = toEnum (fromEnum timestamp) - , key_algorithm = ECDSA - , key = [ -- public fields... - ('c',MPI secp256k1_id) -- secp256k1 (bitcoin curve) - ,('l',MPI 256) - ,('x',MPI x) - ,('y',MPI y) - -- secret fields - ,('d',MPI d) - ] - , s2k_useage = 0 - , s2k = S2K 100 "" - , symmetric_algorithm = Unencrypted - , encrypted_data = "" - , is_subkey = True - } doBTCImport doDecrypt db (ms,subspec,content) = do let fetchkey = do @@ -2494,26 +2307,6 @@ selectKey0 wantPublic (spec,mtag) db = do zs = snd $ seek_key subspec ys1 listToMaybe zs -matchSpec (KeyGrip grip) (_,KeyData p _ _ _) - | matchpr grip (packet p)==grip = True - | otherwise = False - -matchSpec (KeyTag key tag) (_,KeyData _ sigs _ _) = not . null $ filter match ps - where - ps = map (packet .fst) sigs - match p = isSignaturePacket p - && has_tag tag p - && has_issuer key p - has_issuer key p = isJust $ do - issuer <- signature_issuer p - guard $ matchpr issuer key == issuer - has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) - || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) - -matchSpec (KeyUidMatch pat) (_,KeyData _ _ uids _) = not $ null us - where - us = filter (isInfixOf pat) $ Map.keys uids - seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet]) seek_key (KeyGrip grip) sec = (pre, subs) where @@ -2614,68 +2407,3 @@ sigpackets typ hashed unhashed = return $ 0 -- Word16 -- Left 16 bits of the signed hash value [] -- [MPI] -keyFlags wkun uids = keyFlags0 wkun (filter isSignaturePacket uids) - {- - where - vs = map (verify (Message [wkun])) (signatures (Message (wkun:uids))) - ws = map signatures_over vs - xs = filter null ws - -} - -keyFlags0 wkun uidsigs = concat - [ keyflags - , preferredsym - , preferredhash - , preferredcomp - , features ] - - where - subs = concatMap hashed_subpackets uidsigs - keyflags = filterOr isflags subs $ - KeyFlagsPacket { certify_keys = True - , sign_data = True - , encrypt_communication = False - , encrypt_storage = False - , split_key = False - , authentication = False - , group_key = False - } - preferredsym = filterOr ispreferedsym subs $ - PreferredSymmetricAlgorithmsPacket - [ AES256 - , AES192 - , AES128 - , CAST5 - , TripleDES - ] - preferredhash = filterOr ispreferedhash subs $ - PreferredHashAlgorithmsPacket - [ SHA256 - , SHA1 - , SHA384 - , SHA512 - , SHA224 - ] - preferredcomp = filterOr ispreferedcomp subs $ - PreferredCompressionAlgorithmsPacket - [ ZLIB - , BZip2 - , ZIP - ] - features = filterOr isfeatures subs $ - FeaturesPacket { supports_mdc = True - } - - filterOr pred xs def = if null rs then [def] else rs where rs=filter pred xs - - isflags (KeyFlagsPacket {}) = True - isflags _ = False - ispreferedsym (PreferredSymmetricAlgorithmsPacket {}) = True - ispreferedsym _ = False - ispreferedhash (PreferredHashAlgorithmsPacket {}) = True - ispreferedhash _ = False - ispreferedcomp (PreferredCompressionAlgorithmsPacket {}) = True - ispreferedcomp _ = False - isfeatures (FeaturesPacket {}) = True - isfeatures _ = False - -- cgit v1.2.3