From 8af08303e56fc109135e2ade91299338d03b57b0 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Tue, 16 Jul 2019 20:33:23 -0400 Subject: this compiles --- kiki.hs | 40 ++++++++++++++++------------------------ 1 file changed, 16 insertions(+), 24 deletions(-) (limited to 'kiki.hs') diff --git a/kiki.hs b/kiki.hs index 9b78e8f..d7099b6 100644 --- a/kiki.hs +++ b/kiki.hs @@ -41,7 +41,7 @@ import Data.Binary.Put import System.Posix.User import CommandLine -import Data.OpenPGP.Util (verify, fingerprint, GenerateKeyParams(..)) +import Data.OpenPGP.Util (Fingerprint, verify, fingerprint, GenerateKeyParams(..)) import ScanningParser import PEM import DotLock @@ -63,13 +63,6 @@ isCertificationSig :: SignatureOver -> Bool isCertificationSig (CertificationSignature {}) = True isCertificationSig _ = True -fpmatch :: Maybe [Char] -> Packet -> Bool -fpmatch grip key = - (==) Nothing - (fmap (backend (show $ fingerprint key)) grip >>= guard . not) - where - backend xs ys = and $ zipWith (==) (reverse xs) (reverse ys) - listKeys :: [Packet] -> [Char] listKeys pkts = listKeysFiltered [] pkts @@ -79,7 +72,7 @@ listKeys pkts = listKeysFiltered [] pkts -- Build the display output -- Operates in List Monad... -- returns all output as a single string -listKeysFiltered :: Foldable t => t [Char] -> [Packet] -> [Char] +listKeysFiltered :: Foldable t => t Fingerprint -> [Packet] -> [Char] listKeysFiltered grips pkts = do let masterkeys = filter (\k -> isKey k && not (is_subkey k)) pkts (certs,bs) = getBindings pkts @@ -96,7 +89,7 @@ listKeysFiltered grips pkts = do ownerkey (_,(a,_),_,_,_) = a sameMaster (ownerkey->a) (ownerkey->b) = fingerprint_material a==fingerprint_material b matchgrip _ | null grips = True - matchgrip ((code,(top,sub), kind, hashed,claimants):_) | any (flip fpmatch top . Just) grips = True + matchgrip ((code,(top,sub), kind, hashed,claimants):_) | any (flip matchpr top) grips = True matchgrip _ = False gs = filter matchgrip $ groupBy sameMaster (sortBy (comparing code) as) singles = filter (\k -> show (fingerprint k) `notElem` map (show . fingerprint) parents) masterkeys -- \\ parents @@ -152,7 +145,7 @@ listKeysFiltered grips pkts = do let issuers = do sig_over <- signatures_over sig i <- maybeToList $ signature_issuer sig_over - maybeToList $ find_key (matchpr i) (Message keys) (reverse (take 16 (reverse i))) + maybeToList $ find_key (matchpr'' i) (Message keys) (reverse (take 16 (reverse i))) (primary,secondary) = partition (==top) issuers -- trace ("PRIMARY: "++show (map fingerprint primary)) $ return () @@ -215,8 +208,7 @@ partitionStaticArguments specs args = psa args Nothing -> second (a:) $ psa as Just n -> first ((a:take n as):) $ psa (drop n as) -show_wk :: FilePath - -> Maybe [Char] -> KeyDB -> IO () +show_wk :: FilePath -> Maybe Fingerprint -> KeyDB -> IO () show_wk secring_file grip db = do -- printf "show_wk(%s,%s,%s)\n" (show secring_file) (show grip) (show db) let gripmatch (KeyData p _ _ _) = @@ -257,7 +249,7 @@ show_whose_key input_key db = (_:_) -> error "ambiguous" [] -> return () -show_dns :: [Char] -> String -> KeyDB -> IO () +show_dns :: [Char] -> Maybe Fingerprint -> KeyDB -> IO () show_dns keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db dnsPresentationFromPacket dnsPresentationFromPacket :: Monad m => Packet -> m String @@ -282,7 +274,7 @@ dnsPresentationFromPacket k = do show_id :: String -> p -> KeyDB -> IO () show_id keyspec wkgrip db = do - let s = parseSpec "" keyspec + let s = parseSpec Nothing keyspec let ps = do (_,k) <- filterMatches (fst s) (kkData db) mp <- flattenTop "" True k @@ -290,7 +282,7 @@ show_id keyspec wkgrip db = do -- putStrLn $ "show key " ++ show s putStrLn $ listKeys ps -show_wip :: [Char] -> String -> KeyDB -> IO () +show_wip :: [Char] -> Maybe Fingerprint -> KeyDB -> IO () show_wip keyspec wkgrip db = do let s = parseSpec wkgrip keyspec flip (maybe $ void (warn (keyspec ++ ": not found"))) @@ -320,7 +312,7 @@ show_torhash pubkey _ = do keys = catMaybes $ scanAndParse (pkcs1 <> pkcs8 <> cert) $ Char8.lines bs mapM_ (putStrLn . addy . torhash) keys -show_cert :: [Char] -> String -> KeyDB -> IO () +show_cert :: [Char] -> Maybe Fingerprint -> KeyDB -> IO () show_cert keyspec wkgrip db = do let s = parseSpec wkgrip keyspec case selectPublicKeyAndSigs s db of @@ -1235,13 +1227,13 @@ kiki "show" args = do ,("--all",const show_all) ,("--whose-key", const $ show_whose_key input_key) ,("--packets", show_packets) - ,("--key",\[x] -> show_id x $ fromMaybe "" grip) - ,("--pem",\[x] -> show_pem x $ fromMaybe "" grip) - ,("--dns",\[x] -> show_dns x $ fromMaybe "" grip) - ,("--ssh",\[x] -> show_ssh x $ fromMaybe "" grip) - ,("--sshfp",\[x] -> show_sshfp x $ fromMaybe "" grip) - ,("--wip",\[x] -> show_wip x $ fromMaybe "" grip) - ,("--cert",\[x] -> show_cert x $ fromMaybe "" grip) + ,("--key",\[x] -> show_id x grip) + ,("--pem",\[x] -> show_pem x grip) + ,("--dns",\[x] -> show_dns x grip) + ,("--ssh",\[x] -> show_ssh x grip) + ,("--sshfp",\[x] -> show_sshfp x grip) + ,("--wip",\[x] -> show_wip x grip) + ,("--cert",\[x] -> show_cert x grip) ,("--torhash",\[x] -> show_torhash x) ,("--dump", const $ debug_dump (rtSecring rt) grip) ] -- cgit v1.2.3