summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2013-08-12 23:50:50 -0400
committerjoe <joe@jerkface.net>2013-08-12 23:50:50 -0400
commitbb4a15315ee9e0320b4fe3330f1840aed8f5a61c (patch)
treeea141988b0f038edfe06dae34fd46647279f6e97
parentb892babd44bb8cd483019c702aa4a4d2bfbad7c5 (diff)
Compute base32/sha1/der (tor-style) hashes.
-rw-r--r--keys.hs47
1 files changed, 45 insertions, 2 deletions
diff --git a/keys.hs b/keys.hs
index 104e6ef..14af106 100644
--- a/keys.hs
+++ b/keys.hs
@@ -6,6 +6,7 @@ module Main where
6import Data.Binary 6import Data.Binary
7import Data.OpenPGP 7import Data.OpenPGP
8import qualified Data.ByteString.Lazy as L 8import qualified Data.ByteString.Lazy as L
9import qualified Data.ByteString as S
9import Control.Monad 10import Control.Monad
10import Text.Show.Pretty 11import Text.Show.Pretty
11import Data.List 12import Data.List
@@ -14,6 +15,37 @@ import Data.Ord
14import Data.Maybe 15import Data.Maybe
15import Data.Bits 16import Data.Bits
16import qualified Data.Text as T 17import qualified Data.Text as T
18import qualified Codec.Binary.Base32 as Base32
19import qualified Crypto.Hash.SHA1 as SHA1
20import Data.Char (toLower)
21import qualified Crypto.PubKey.RSA as RSA
22import Data.ASN1.Types
23import Data.ASN1.Encoding
24import Data.ASN1.BinaryEncoding
25
26data RSAPublicKey = RSAKey MPI MPI
27
28instance ASN1Object RSAPublicKey where
29 toASN1 (RSAKey (MPI n) (MPI e))
30 = \xs -> Start Sequence
31 : IntVal n
32 : IntVal e
33 : End Sequence
34 : xs
35 fromASN1 (Start Sequence:IntVal modulus:IntVal pubexp:End Sequence:xs) =
36 Right (RSAKey (MPI modulus) (MPI pubexp) , xs)
37 fromASN1 _ =
38 Left "fromASN1: RSAPublicKey: unexpected format"
39
40rsaKeyFromPacket p@(PublicKeyPacket {}) = do
41 n <- lookup 'n' $ key p
42 e <- lookup 'e' $ key p
43 return $ RSAKey n e
44rsaKeyFromPacket _ = Nothing
45
46derRSA rsa = do
47 k <- rsaKeyFromPacket rsa
48 return $ encodeASN1 DER (toASN1 k [])
17 49
18getPackets :: IO [Packet] 50getPackets :: IO [Packet]
19getPackets = do 51getPackets = do
@@ -137,6 +169,7 @@ accBindings bs = as
137 169
138data UserIDRecord = UserIDRecord { 170data UserIDRecord = UserIDRecord {
139 uid_full :: String, 171 uid_full :: String,
172 uid_realname :: T.Text,
140 uid_user :: T.Text, 173 uid_user :: T.Text,
141 uid_subdomain :: T.Text, 174 uid_subdomain :: T.Text,
142 uid_topdomain :: T.Text 175 uid_topdomain :: T.Text
@@ -148,6 +181,7 @@ isBracket _ = False
148 181
149parseUID str = UserIDRecord { 182parseUID str = UserIDRecord {
150 uid_full = str, 183 uid_full = str,
184 uid_realname = realname,
151 uid_user = user, 185 uid_user = user,
152 uid_subdomain = subdomain, 186 uid_subdomain = subdomain,
153 uid_topdomain = topdomain 187 uid_topdomain = topdomain
@@ -189,7 +223,11 @@ listKeys pkts = do
189 2 -> " <-- " 223 2 -> " <-- "
190 3 -> " <-> " 224 3 -> " <-> "
191 formkind = take kindcol $ defaultkind kind hashed ++ repeat ' ' 225 formkind = take kindcol $ defaultkind kind hashed ++ repeat ' '
192 " " {- ++grip top -} ++ ar ++ formkind++" "++ fingerprint sub ++ "\n" 226 extra =
227 maybe ""
228 (map toLower . Base32.encode . S.unpack . SHA1.hashlazy)
229 (derRSA sub)
230 " " {- ++grip top -} ++ ar ++ formkind++" "++ fingerprint sub ++ " "++ extra ++"\n"
193 -- ++ ppShow hashed 231 -- ++ ppShow hashed
194 uid = {- maybe "" id . listToMaybe $ -} do 232 uid = {- maybe "" id . listToMaybe $ -} do
195 (keys,sigs) <- certs 233 (keys,sigs) <- certs
@@ -200,7 +238,12 @@ listKeys pkts = do
200 guard (join (fmap (find_key smallpr (Message keys)) $ signature_issuer sig_over) == Just top) 238 guard (join (fmap (find_key smallpr (Message keys)) $ signature_issuer sig_over) == Just top)
201 let UserIDPacket uid = user_id sig 239 let UserIDPacket uid = user_id sig
202 parsed = parseUID uid 240 parsed = parseUID uid
203 " " ++ " --> " ++ "@" ++ " " ++ uid_full parsed ++ "\n" 241 ar = maybe " --> " (const " <-> ") $ do
242 guard (uid_topdomain parsed == "onion" )
243 guard ( uid_realname parsed `elem` ["","Anonymous"])
244 guard ( uid_user parsed == "root" )
245 -- guard (uid_subdomain parsed == tor_address )
246 " " ++ ar ++ "@" ++ " " ++ uid_full parsed ++ "\n"
204 (_,sigs) = unzip certs 247 (_,sigs) = unzip certs
205 "master-key " ++ fingerprint top ++ "\n" ++ uid ++ subkeys ++ "\n" 248 "master-key " ++ fingerprint top ++ "\n" ++ uid ++ subkeys ++ "\n"
206 249