summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2013-08-11 20:07:50 -0400
committerjoe <joe@jerkface.net>2013-08-11 20:07:50 -0400
commit4c55c7c8db59cd21aa648789d1abfc0b9d2f3c03 (patch)
tree888478186c1cb89f0bf4b43aec49df86366bd3f3
parent15f7f3c50e0b21db5d14e088810c5de70512d0d8 (diff)
interpret gpg key flags in keys utility
-rw-r--r--keys.hs95
1 files changed, 82 insertions, 13 deletions
diff --git a/keys.hs b/keys.hs
index cdd3592..e5966ca 100644
--- a/keys.hs
+++ b/keys.hs
@@ -1,3 +1,4 @@
1{-# LANGUAGE ViewPatterns #-}
1module Main where 2module Main where
2 3
3import Data.Binary 4import Data.Binary
@@ -44,15 +45,14 @@ usage (NotationDataPacket
44 }) = Just u 45 }) = Just u
45usage _ = Nothing 46usage _ = Nothing
46 47
47verifyBindings keys [] = [] 48verifyBindings keys nonkeys = (top ++ filter isSubkeySignature embedded,othersigs)
48verifyBindings keys nonkeys = top ++ filter isSubkeySignature embedded
49 where 49 where
50 verified = do 50 verified = do
51 sig <- signatures (Message nonkeys) 51 sig <- signatures (Message nonkeys)
52 let v = verify (Message keys) sig 52 let v = verify (Message keys) sig
53 guard (not . null $ signatures_over v) 53 guard (not . null $ signatures_over v)
54 return v 54 return v
55 (top,_) = partition isSubkeySignature verified 55 (top,othersigs) = partition isSubkeySignature verified
56 embedded = do 56 embedded = do
57 sub <- top 57 sub <- top
58 let sigover = signatures_over sub 58 let sigover = signatures_over sub
@@ -63,6 +63,8 @@ verifyBindings keys nonkeys = top ++ filter isSubkeySignature embedded
63 guard (not . null $ signatures_over v) 63 guard (not . null $ signatures_over v)
64 return v 64 return v
65 65
66grip k = drop (24+8) $ fingerprint k
67
66smallpr k = drop 24 $ fingerprint k 68smallpr k = drop 24 $ fingerprint k
67 69
68disjoint_fp ks = transpose grouped 70disjoint_fp ks = transpose grouped
@@ -79,8 +81,8 @@ getBindings ::
79 [Packet])] 81 [Packet])]
80getBindings pkts = do 82getBindings pkts = do
81 let (keys,nonkeys) = partition isKey pkts 83 let (keys,nonkeys) = partition isKey pkts
82 keys <- disjoint_fp (keys) 84 keys <- disjoint_fp keys
83 b <- verifyBindings keys pkts -- nonkeys 85 b <- fst $ verifyBindings keys pkts
84 i <- map signature_issuer (signatures_over b) 86 i <- map signature_issuer (signatures_over b)
85 i <- maybeToList i 87 i <- maybeToList i
86 who <- maybeToList $ find_key fingerprint (Message keys) i 88 who <- maybeToList $ find_key fingerprint (Message keys) i
@@ -113,13 +115,19 @@ accBindings bs = as
113listKeys pkts = do 115listKeys pkts = do
114 let bs = getBindings pkts 116 let bs = getBindings pkts
115 as = accBindings bs 117 as = accBindings bs
116 defaultkind [] = "subkey" 118 defaultkind (k:_) hs = k
117 defaultkind (k:_) = k 119 defaultkind [] hs = maybe "subkey"
118 kinds = map (\(_,_,k,_,_)->defaultkind k) as 120 id
121 ( listToMaybe
122 . mapMaybe (fmap usageString . keyflags)
123 $ hs)
124 kinds = map (\(_,_,k,h,_)->defaultkind k h) as
119 kindwidth = maximum $ map length kinds 125 kindwidth = maximum $ map length kinds
120 kindcol = min 20 kindwidth 126 kindcol = min 20 kindwidth
121 sameMaster (_,(a,_),_,_,_) (_,(b,_),_,_,_) = fingerprint_material a==fingerprint_material b 127 code (c,_,_,_,_) = -c
122 gs = groupBy sameMaster as 128 ownerkey (_,(a,_),_,_,_) = a
129 sameMaster (ownerkey->a) (ownerkey->b) = fingerprint_material a==fingerprint_material b
130 gs = groupBy sameMaster (sortBy (comparing code) as)
123 subs <- gs 131 subs <- gs
124 let (code,(top,sub), kind, hashed,claimants):_ = subs 132 let (code,(top,sub), kind, hashed,claimants):_ = subs
125 subkeys = do 133 subkeys = do
@@ -129,11 +137,72 @@ listKeys pkts = do
129 1 -> " --> " 137 1 -> " --> "
130 2 -> " <-- " 138 2 -> " <-- "
131 3 -> " <-> " 139 3 -> " <-> "
132 formkind = take kindcol $ defaultkind kind ++ repeat ' ' 140 formkind = take kindcol $ defaultkind kind hashed ++ repeat ' '
133 " "++smallpr top ++ ar ++ formkind++" "++ fingerprint sub ++"\n" 141 " "++grip top ++ ar ++ formkind++" "++ fingerprint sub ++ "\n"
134 "gpg " ++ fingerprint top ++ "\n" ++ subkeys ++ "\n" 142 -- ++ ppShow hashed
143 "master-key " ++ fingerprint top ++ "\n" ++ subkeys ++ "\n"
135 144
136 145
146{-
147, KeyFlagsPacket
148 { certify_keys = False
149 , sign_data = True
150 , encrypt_communication = True
151 , encrypt_storage = True
152 , split_key = False
153 , authentication = True
154 , group_key = False
155 }
156-}
157data PGPKeyFlags =
158 Special
159 | Vouch
160 | Sign
161 | VouchSign
162 | Communication
163 | VouchCommunication
164 | SignCommunication
165 | VouchSignCommunication
166 | Storage
167 | VouchStorage
168 | SignStorage
169 | VouchSignStorage
170 | Encrypt
171 | VouchEncrypt
172 | SignEncrypt
173 | VouchSignEncrypt
174 deriving (Eq,Show,Read,Enum)
175
176usageString flgs =
177 case flgs of
178 Special -> "special"
179 Vouch -> "vouch"
180 Sign -> "sign"
181 VouchSign -> "vouch-sign"
182 Communication -> "communication"
183 VouchCommunication -> "vouch-communication"
184 SignCommunication -> "sign-communication"
185 VouchSignCommunication -> "vouch-sign-communication"
186 Storage -> "storage"
187 VouchStorage -> "vouch-storage"
188 SignStorage -> "sign-storage"
189 VouchSignStorage -> "vouch-sign-storage"
190 Encrypt -> "encrypt"
191 VouchEncrypt -> "vouch-encrypt"
192 SignEncrypt -> "sign-encrypt"
193 VouchSignEncrypt -> "vouch-sign-encrypt"
194
195
196keyflags flgs@(KeyFlagsPacket {}) =
197 Just . toEnum $
198 ( bit 0x1 certify_keys
199 .|. bit 0x2 sign_data
200 .|. bit 0x4 encrypt_communication
201 .|. bit 0x8 encrypt_storage ) :: Maybe PGPKeyFlags
202 where
203 bit v f = if f flgs then v else 0
204keyflags _ = Nothing
205
137 206
138main = do 207main = do
139 pkts <- getPackets 208 pkts <- getPackets