summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--kiki.hs76
1 files changed, 56 insertions, 20 deletions
diff --git a/kiki.hs b/kiki.hs
index 990e8e3..58806cb 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -59,9 +59,11 @@ unprefix c spec = if null (snd p) then swap p else (fst p, tail (snd p))
59 59
60 60
61data RSAPublicKey = RSAKey MPI MPI deriving Show 61data RSAPublicKey = RSAKey MPI MPI deriving Show
62data PKCS8_RSAPublicKey = RSAKey8 MPI MPI deriving Show
63
64pkcs8 (RSAKey n e) = RSAKey8 n e
62 65
63instance ASN1Object RSAPublicKey where 66instance ASN1Object RSAPublicKey where
64 {-
65 -- PKCS #1 RSA Public Key 67 -- PKCS #1 RSA Public Key
66 toASN1 (RSAKey (MPI n) (MPI e)) 68 toASN1 (RSAKey (MPI n) (MPI e))
67 = \xs -> Start Sequence 69 = \xs -> Start Sequence
@@ -69,10 +71,13 @@ instance ASN1Object RSAPublicKey where
69 : IntVal e 71 : IntVal e
70 : End Sequence 72 : End Sequence
71 : xs 73 : xs
72 -} 74 fromASN1 _ =
75 Left "fromASN1: RSAPublicKey: unexpected format"
76
77instance ASN1Object PKCS8_RSAPublicKey where
73 78
74 -- PKCS #8 Public key data 79 -- PKCS #8 Public key data
75 toASN1 (RSAKey (MPI n) (MPI e)) 80 toASN1 (RSAKey8 (MPI n) (MPI e))
76 = \xs -> Start Sequence 81 = \xs -> Start Sequence
77 : Start Sequence 82 : Start Sequence
78 : OID [1,2,840,113549,1,1,1] 83 : OID [1,2,840,113549,1,1,1]
@@ -85,7 +90,7 @@ instance ASN1Object RSAPublicKey where
85 bs = encodeASN1' DER pubkey 90 bs = encodeASN1' DER pubkey
86 91
87 fromASN1 (Start Sequence:IntVal modulus:IntVal pubexp:End Sequence:xs) = 92 fromASN1 (Start Sequence:IntVal modulus:IntVal pubexp:End Sequence:xs) =
88 Right (RSAKey (MPI modulus) (MPI pubexp) , xs) 93 Right (RSAKey8 (MPI modulus) (MPI pubexp) , xs)
89 fromASN1 (Start Sequence:Start Sequence:OID [1,2,840,113549,1,1,1]:End Sequence:BitString b:End Sequence:xs) = 94 fromASN1 (Start Sequence:Start Sequence:OID [1,2,840,113549,1,1,1]:End Sequence:BitString b:End Sequence:xs) =
90 case decodeASN1' DER bs of 95 case decodeASN1' DER bs of
91 Right as -> fromASN1 as 96 Right as -> fromASN1 as
@@ -414,7 +419,7 @@ listKeysFiltered grips pkts = do
414 2 -> " <-- " 419 2 -> " <-- "
415 3 -> " <-> " 420 3 -> " <-> "
416 formkind = take kindcol $ defaultkind kind hashed ++ repeat ' ' 421 formkind = take kindcol $ defaultkind kind hashed ++ repeat ' '
417 -- torhash = maybe "" id $ derToBase32 <$> derRSA sub 422 torhash = maybe "" id $ derToBase32 <$> derRSA sub
418 concat [ " " 423 concat [ " "
419 -- , grip top 424 -- , grip top
420 , (if not (null claimants) 425 , (if not (null claimants)
@@ -779,7 +784,8 @@ data Arguments =
779 , files :: [FilePath] 784 , files :: [FilePath]
780 } 785 }
781 | DumpPackets { homedir :: Maybe FilePath 786 | DumpPackets { homedir :: Maybe FilePath
782 , marshal_test :: String } 787 , marshal_test :: String
788 , files :: [FilePath] }
783 {- 789 {-
784 | Decrypt { homedir :: Maybe FilePath 790 | Decrypt { homedir :: Maybe FilePath
785 , passphrase_fd :: Maybe Int 791 , passphrase_fd :: Maybe Int
@@ -1005,6 +1011,7 @@ main = do
1005 &= help "Merge multiple keyrings to stdout." 1011 &= help "Merge multiple keyrings to stdout."
1006 , DumpPackets HOMEOPTION 1012 , DumpPackets HOMEOPTION
1007 (def &= opt ("n" ::String)) 1013 (def &= opt ("n" ::String))
1014 (def &= args &= typFile)
1008 &= help "Output secret ring packets in ascii format for debugging." 1015 &= help "Output secret ring packets in ascii format for debugging."
1009 , Add HOMEOPTION 1016 , Add HOMEOPTION
1010 (def &= opt ("passphrase"::String) 1017 (def &= opt ("passphrase"::String)
@@ -1151,14 +1158,8 @@ main = do
1151 ,"new_sig isSignaturePacket(over) = " ++ (show . map isSignaturePacket $ new_sig) 1158 ,"new_sig isSignaturePacket(over) = " ++ (show . map isSignaturePacket $ new_sig)
1152 ,"issuer = " ++ show (map signature_issuer new_sig) 1159 ,"issuer = " ++ show (map signature_issuer new_sig)
1153 ]) 1160 ])
1154 new_sig = fst $ sign (Message (maybeToList selfkey)) 1161 new_sig = fst $ torsig g mainpubkey (fromJust selfkey) uid timestamp
1155 (CertificationSignature mainpubkey 1162
1156 uid
1157 []) --fromJust selfkey, uid])
1158 SHA1
1159 (fromJust grip)
1160 timestamp
1161 g
1162 ys = uid:sigs'++xs'' 1163 ys = uid:sigs'++xs''
1163 1164
1164 doCmd cmd@(List {}) = do 1165 doCmd cmd@(List {}) = do
@@ -1256,9 +1257,15 @@ main = do
1256 , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg 1257 , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg
1257 , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321" 1258 , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321"
1258 ) <- getPGPEnviron cmd 1259 ) <- getPGPEnviron cmd
1260 p <- case files cmd of
1261 [] -> return sec
1262 fs -> do
1263 ms <- mapM readPacketsFromFile fs
1264 let unwrap (Message ps) = ps
1265 return (concatMap unwrap ms)
1259 if map toLower (marshal_test cmd) `elem` ["y","yes"] 1266 if map toLower (marshal_test cmd) `elem` ["y","yes"]
1260 then L.putStr $ encode (Message sec) 1267 then L.putStr $ encode (Message p)
1261 else putStrLn $ PP.ppShow sec 1268 else putStrLn $ PP.ppShow p
1262 1269
1263 doCmd cmd@(MergeSecrets {}) = do 1270 doCmd cmd@(MergeSecrets {}) = do
1264 ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome 1271 ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome
@@ -1316,7 +1323,7 @@ main = do
1316 when (not (null ys)) $ do 1323 when (not (null ys)) $ do
1317 let (_,ys') = seek_key (KeyTag wk sub) (tail ys) -- ambiguity check 1324 let (_,ys') = seek_key (KeyTag wk sub) (tail ys) -- ambiguity check
1318 k = head ys 1325 k = head ys
1319 rsa = fromJust $ rsaKeyFromPacket k 1326 rsa = pkcs8 . fromJust $ rsaKeyFromPacket k
1320 der = encodeASN1 DER (toASN1 rsa []) 1327 der = encodeASN1 DER (toASN1 rsa [])
1321 qq = Base64.encode (L.unpack der) 1328 qq = Base64.encode (L.unpack der)
1322 split64 [] = [] 1329 split64 [] = []
@@ -1372,9 +1379,18 @@ main = do
1372 let pkf = fingerprint (head parsedkey) 1379 let pkf = fingerprint (head parsedkey)
1373 (prepk,pks) = seek_key (KeyGrip pkf) subkeys' 1380 (prepk,pks) = seek_key (KeyGrip pkf) subkeys'
1374 1381
1382 g <- newGenIO
1383 timestamp <- now
1384 let uids' = do
1385 torkey <- parsedkey
1386 if key_usage cmd /= "tor"
1387 then uids
1388 else let ps = makeTorUID (g::SystemRandom) timestamp wkun wk torkey
1389 toruid = head ps
1390 in if toruid `elem` uids then uids else uids ++ ps
1375 if not (null pks) 1391 if not (null pks)
1376 then existingKey (prepk,pks) remainder wkun wk parsedkey (key_usage cmd) pre uids subkeys (output cmd) grip 1392 then existingKey (prepk,pks) remainder wkun wk parsedkey (key_usage cmd) pre uids' subkeys (output cmd) grip
1377 else newKey wkun wk parsedkey (key_usage cmd) pre uids subkeys (output cmd) grip 1393 else newKey wkun wk parsedkey (key_usage cmd) pre uids' subkeys (output cmd) grip
1378 1394
1379 doCmd cmd@(PemFP {}) = do 1395 doCmd cmd@(PemFP {}) = do
1380 let parseKeySpec hint spec = case break (==':') spec of 1396 let parseKeySpec hint spec = case break (==':') spec of
@@ -1383,7 +1399,9 @@ main = do
1383 (secfmt,secfile) = parseKeySpec 'S' $ seckey cmd 1399 (secfmt,secfile) = parseKeySpec 'S' $ seckey cmd
1384 Message seckey <- readKeyFromFile False secfmt secfile 1400 Message seckey <- readKeyFromFile False secfmt secfile
1385 -- Message pubkey <- readKeyFromFile True pubfmt pubfile 1401 -- Message pubkey <- readKeyFromFile True pubfmt pubfile
1386 putStrLn $ fingerprint (head seckey) 1402 -- Tor requires public key file... TODO
1403 -- let torhash sub = maybe "" id $ derToBase32 <$> derRSA sub
1404 putStrLn $ fingerprint (head seckey) -- ++ " " ++ torhash (head seckey)
1387 1405
1388 1406
1389isSameKey a b = sort (key apub) == sort (key bpub) 1407isSameKey a b = sort (key apub) == sort (key bpub)
@@ -1618,3 +1636,21 @@ seek_key (KeyUidMatch pat) ps = if null bs
1618 uidStr _ = "" 1636 uidStr _ = ""
1619 1637
1620groupTops ps = groupBy (\_ b -> not (isTopKey b)) ps 1638groupTops ps = groupBy (\_ b -> not (isTopKey b)) ps
1639
1640
1641makeTorUID g timestamp wkun topkey torkey = uid:signatures_over sig
1642 where
1643 torhash sub = maybe "" id $ derToBase32 <$> derRSA sub
1644 s = "Anonymous <root@" ++ take 16 (torhash torkey) ++ ".onion>"
1645 uid = UserIDPacket $ trace ("UID: "++s) s
1646 sig = fst $ torsig g topkey wkun uid timestamp
1647
1648torsig g topk wkun uid timestamp
1649 = sign (Message [wkun])
1650 (CertificationSignature (secretToPublic topk)
1651 uid
1652 []) --fromJust wkun, uid])
1653 SHA1
1654 (fingerprint wkun) {- (fromJust wkgrip) -}
1655 timestamp
1656 g