Ability to output public keys in PEM format.

1 files 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