From e80d9038d89b2f298ae94fafe058e5f18cb03ff0 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 4 Nov 2013 01:22:24 -0500 Subject: Ability to output public keys in PEM format. --- kiki.hs | 94 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 89 insertions(+), 5 deletions(-) diff --git a/kiki.hs b/kiki.hs index 2194059..e8ef2ad 100644 --- a/kiki.hs +++ b/kiki.hs @@ -9,6 +9,7 @@ module Main where import Debug.Trace import GHC.Exts (Down(..)) +import Data.Tuple import Data.Binary import Data.OpenPGP import qualified Data.ByteString.Lazy as L @@ -34,6 +35,7 @@ import Crypto.Random (newGenIO,SystemRandom) import Data.ASN1.Types import Data.ASN1.Encoding import Data.ASN1.BinaryEncoding +import Data.ASN1.BitArray import Control.Applicative import System.Environment import System.Directory @@ -50,17 +52,45 @@ import System.Posix.Files import Data.Monoid ((<>)) -- import Data.X509 +unprefix c spec = if null (snd p) then swap p else (fst p, tail (snd p)) + where p = break (==c) spec + + data RSAPublicKey = RSAKey MPI MPI deriving Show instance ASN1Object RSAPublicKey where + {- + -- PKCS #1 RSA Public Key toASN1 (RSAKey (MPI n) (MPI e)) = \xs -> Start Sequence : IntVal n : IntVal e : End Sequence : xs + -} + + -- PKCS #8 Public key data + toASN1 (RSAKey (MPI n) (MPI e)) + = \xs -> Start Sequence + : Start Sequence + : OID [1,2,840,113549,1,1,1] + : End Sequence + : BitString (toBitArray bs 0) + : End Sequence + : xs + where + pubkey = Start Sequence : IntVal n : IntVal e : End Sequence : [] + bs = encodeASN1' DER pubkey + fromASN1 (Start Sequence:IntVal modulus:IntVal pubexp:End Sequence:xs) = Right (RSAKey (MPI modulus) (MPI pubexp) , xs) + fromASN1 (Start Sequence:Start Sequence:OID [1,2,840,113549,1,1,1]:End Sequence:BitString b:End Sequence:xs) = + case decodeASN1' DER bs of + Right as -> fromASN1 as + Left e -> Left ("fromASN1: RSAPublicKey: "++show e) + where + BitArray _ bs = b + fromASN1 _ = Left "fromASN1: RSAPublicKey: unexpected format" @@ -758,6 +788,10 @@ getPassphrase cmd = #define HOMEOPTION (def &= explicit &= name "homedir" &= typDir ) +data KeySpec = + KeyGrip String + | KeyTag Packet String + main = do args <- cmdArgs $ modes [ List HOMEOPTION @@ -1041,8 +1075,39 @@ main = do doCmd cmd@(CatPub {}) = do let spec:files = catpub_args cmd - putStrLn $ "spec = " ++show spec + let (topspec,subspec) = unprefix '/' spec + (toptyp,top) = unprefix ':' topspec + (subtyp,sub) = unprefix ':' subspec + + {- putStrLn $ "files = " ++ show files + putStrLn $ "topspec = " ++show (toptyp,top) + putStrLn $ "subspec = " ++show (subtyp,sub) + -} + ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome + , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg + , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321" + ) <- getPGPEnviron cmd + + flip (maybe (error "No working key?")) grip $ \grip -> do + + let (pre, wk:subs) = seek_key (KeyGrip grip) sec + (xs,ys) = seek_key (KeyTag wk sub) subs + when (not (null ys)) $ do + let k = head ys + rsa = fromJust $ rsaKeyFromPacket k + der = encodeASN1 DER (toASN1 rsa []) + qq = Base64.encode (L.unpack der) + split64 [] = [] + split64 qq = as : split64 bs where (as,bs) = splitAt 64 qq + {- + putStrLn $ fingerprint k + putStrLn $ show rsa + putStrLn $ show der + -} + putStr $ unlines (["-----BEGIN PUBLIC KEY-----"] + ++split64 qq + ++["-----END PUBLIC KEY-----"]) return () doCmd cmd@(Add {}) = do @@ -1054,7 +1119,7 @@ main = do flip (maybe (error "No working key?")) grip $ \grip -> do - let (pre, wk:subs) = seek_key grip sec + let (pre, wk:subs) = seek_key (KeyGrip grip) sec wkun = if symmetric_algorithm wk == Unencrypted then Just wk else do @@ -1079,7 +1144,7 @@ main = do Message parsedkey <- readKeyFromFile False secfmt secfile let pkf = fingerprint (head parsedkey) - (prepk,pks) = seek_key pkf subkeys' + (prepk,pks) = seek_key (KeyGrip pkf) subkeys' if not (null pks) then existingKey (prepk,pks) remainder wkun wk parsedkey (key_usage cmd) pre uids subkeys (output cmd) grip @@ -1283,10 +1348,29 @@ groupBindings pub = gs = {- filter matchgrip $ -} groupBy sameMaster (sortBy (comparing code) bindings') in gs +isTopKey p@(SecretKeyPacket {}) | not (is_subkey p) = True +isTopKey p@(PublicKeyPacket {}) | not (is_subkey p) = True +isTopKey _ = False -seek_key :: String -> [Packet] -> ([Packet],[Packet]) -seek_key grip sec = (pre, subs) +seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet]) +seek_key (KeyGrip grip) sec = (pre, subs) where (pre,subs) = break pred sec pred p@(SecretKeyPacket {}) = matchpr grip p == grip pred _ = False + +seek_key (KeyTag key tag) ps = if null bs || null qs + then (ps,[]) + else (reverse (tail qs), head qs : reverse rs ++ bs) + where + (as,bs) = break (\p -> isSignaturePacket p + && has_tag tag p + && isJust (signature_issuer p) + && matchpr (fromJust $ signature_issuer p) key == fromJust (signature_issuer p) ) + ps + (rs,qs) = break isKey (reverse as) + + has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) + || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) + +groupTops ps = groupBy (\_ b -> not (isTopKey b)) ps -- cgit v1.2.3