diff options
Diffstat (limited to 'lib/KeyRing/Types.hs')
-rw-r--r-- | lib/KeyRing/Types.hs | 58 |
1 files changed, 43 insertions, 15 deletions
diff --git a/lib/KeyRing/Types.hs b/lib/KeyRing/Types.hs index af213ce..dbcc22c 100644 --- a/lib/KeyRing/Types.hs +++ b/lib/KeyRing/Types.hs | |||
@@ -13,6 +13,7 @@ import Data.Maybe (maybeToList,isJust,fromJust,mapMaybe) | |||
13 | import Data.OpenPGP | 13 | import Data.OpenPGP |
14 | import Data.OpenPGP.Util | 14 | import Data.OpenPGP.Util |
15 | import Data.Time.Clock | 15 | import Data.Time.Clock |
16 | import Data.Word | ||
16 | import FunctorToMaybe | 17 | import FunctorToMaybe |
17 | import qualified Data.ByteString.Lazy as L | 18 | import qualified Data.ByteString.Lazy as L |
18 | import qualified System.Posix.Types as Posix | 19 | import qualified System.Posix.Types as Posix |
@@ -119,7 +120,7 @@ data PassphraseSpec = PassphraseSpec | |||
119 | { passSpecRingFile :: Maybe FilePath | 120 | { passSpecRingFile :: Maybe FilePath |
120 | -- ^ If not Nothing, the passphrase is to be used for packets | 121 | -- ^ If not Nothing, the passphrase is to be used for packets |
121 | -- from this file. | 122 | -- from this file. |
122 | , passSpecKeySpec :: Maybe String | 123 | , passSpecKeySpec :: Maybe KeySpec |
123 | -- ^ Non-Nothing value reserved for future use. | 124 | -- ^ Non-Nothing value reserved for future use. |
124 | -- (TODO: Use this to implement per-key passphrase associations). | 125 | -- (TODO: Use this to implement per-key passphrase associations). |
125 | , passSpecPassFile :: InputFile | 126 | , passSpecPassFile :: InputFile |
@@ -132,9 +133,12 @@ data PassphraseSpec = PassphraseSpec | |||
132 | instance Show PassphraseSpec where | 133 | instance Show PassphraseSpec where |
133 | show (PassphraseSpec a b c) = "PassphraseSpec "++show (a,b,c) | 134 | show (PassphraseSpec a b c) = "PassphraseSpec "++show (a,b,c) |
134 | show (PassphraseMemoizer _) = "PassphraseMemoizer" | 135 | show (PassphraseMemoizer _) = "PassphraseMemoizer" |
136 | show PassphraseAgent = "PassphraseAgent" | ||
135 | instance Eq PassphraseSpec where | 137 | instance Eq PassphraseSpec where |
136 | PassphraseSpec a b c == PassphraseSpec d e f | 138 | PassphraseSpec a b c == PassphraseSpec d e f |
137 | = and [a==d,b==e,c==f] | 139 | = and [a==d,b==e,c==f] |
140 | PassphraseAgent == PassphraseAgent | ||
141 | = True | ||
138 | _ == _ | 142 | _ == _ |
139 | = False | 143 | = False |
140 | 144 | ||
@@ -152,10 +156,13 @@ instance Ord PassphraseSpec where | |||
152 | compare (PassphraseSpec a b c) (PassphraseSpec d e f) | 156 | compare (PassphraseSpec a b c) (PassphraseSpec d e f) |
153 | | fmap (const ()) a == fmap (const ()) d | 157 | | fmap (const ()) a == fmap (const ()) d |
154 | && fmap (const ()) b == fmap (const ()) e = compare (a,b,c) (d,e,f) | 158 | && fmap (const ()) b == fmap (const ()) e = compare (a,b,c) (d,e,f) |
155 | compare (PassphraseSpec (Just _) (Just _) _) _ = LT | 159 | compare (PassphraseSpec (Just _) (Just _) _) _ = LT |
156 | compare (PassphraseSpec Nothing (Just _) _) _ = LT | 160 | compare (PassphraseSpec Nothing (Just _) _) _ = LT |
157 | compare (PassphraseSpec (Just _) _ _) _ = LT | 161 | compare (PassphraseSpec (Just _) _ _) _ = LT |
158 | compare PassphraseAgent _ = GT | 162 | compare PassphraseAgent _ = GT |
163 | compare (PassphraseSpec Nothing Nothing _) (PassphraseSpec _ _ _) = GT | ||
164 | compare (PassphraseSpec Nothing Nothing _) (PassphraseMemoizer _) = GT | ||
165 | compare (PassphraseSpec Nothing Nothing _) PassphraseAgent = LT | ||
159 | 166 | ||
160 | data Transform = | 167 | data Transform = |
161 | Autosign | 168 | Autosign |
@@ -349,17 +356,35 @@ isTrust _ = False | |||
349 | -- | 356 | -- |
350 | -- matchpr fp = Data.List.Extra.takeEnd (length fp) | 357 | -- matchpr fp = Data.List.Extra.takeEnd (length fp) |
351 | -- | 358 | -- |
352 | matchpr :: String -> Packet -> String | 359 | matchpr :: Word8 -> String -> Packet -> String |
353 | matchpr fp k = reverse $ zipWith const (reverse (show $ fingerprint k)) fp | 360 | matchpr ver fp k = |
361 | let (rev,v) = case ver of | ||
362 | 4 -> (reverse, 4) | ||
363 | 5 -> (id, 5) | ||
364 | _ -> case auto_fp_version k of | ||
365 | 5 -> (id, 5) | ||
366 | v -> (reverse, v) | ||
367 | in rev $ zipWith const (rev (show $ fingerprintv v k)) fp | ||
354 | 368 | ||
355 | 369 | ||
356 | 370 | ||
357 | 371 | ||
358 | data KeySpec = | 372 | data KeySpec = |
359 | KeyGrip String -- fp: | 373 | KeyFP { fpVer :: Word8 -- 5 or 4 to select fingerprint style, 0 to match either. |
374 | , fpPartial :: String -- partial fingerprint, matches trailing for 4, or leading for 5 | ||
375 | } -- fp: | ||
360 | | KeyTag Packet String -- fp:????/t: | 376 | | KeyTag Packet String -- fp:????/t: |
361 | | KeyUidMatch String -- u: | 377 | | KeyUidMatch String -- u: |
362 | deriving Show | 378 | deriving (Show,Eq) |
379 | |||
380 | instance Ord KeySpec where | ||
381 | compare (KeyFP av af) (KeyFP bv bf) = compare (av,af) (bv,bf) | ||
382 | compare (KeyTag ap a) (KeyTag bp b) = compare (fingerprint ap,a) (fingerprint bp,b) | ||
383 | compare (KeyUidMatch a) (KeyUidMatch b) = compare a b | ||
384 | compare (KeyFP {}) _ = LT | ||
385 | compare (KeyTag {}) _ = LT | ||
386 | compare _ _ = GT | ||
387 | |||
363 | 388 | ||
364 | {- | 389 | {- |
365 | RSAPrivateKey ::= SEQUENCE { | 390 | RSAPrivateKey ::= SEQUENCE { |
@@ -400,9 +425,9 @@ data SubkeyStatus = Unsigned | OwnerSigned | CrossSigned | |||
400 | data SecretPEMData = PEMPacket Packet | PEMCertificate ParsedCert | 425 | data SecretPEMData = PEMPacket Packet | PEMCertificate ParsedCert |
401 | deriving (Show,Eq) | 426 | deriving (Show,Eq) |
402 | 427 | ||
403 | data MatchingField = KeyTypeField | UserIDField | GroupIDField deriving (Show,Eq,Ord,Enum) | 428 | data MatchingField = KeyTypeField | UserIDField deriving (Show,Eq,Ord,Enum) |
404 | 429 | ||
405 | data SingleKeySpec = FingerprintMatch String | 430 | data SingleKeySpec = FingerprintMatch Word8 String |
406 | | SubstringMatch (Maybe MatchingField) String | 431 | | SubstringMatch (Maybe MatchingField) String |
407 | | EmptyMatch | 432 | | EmptyMatch |
408 | | AnyMatch | 433 | | AnyMatch |
@@ -423,12 +448,15 @@ secretToPublic pkt@(SecretKeyPacket {}) = | |||
423 | } | 448 | } |
424 | secretToPublic pkt = pkt | 449 | secretToPublic pkt = pkt |
425 | 450 | ||
451 | matchKeySpec :: KeySpec -> Packet -> Bool | ||
452 | matchKeySpec spec pkt = not $ null $ snd $ seek_key spec [pkt] | ||
453 | |||
426 | seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet]) | 454 | seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet]) |
427 | seek_key (KeyGrip grip) sec = (pre, subs) | 455 | seek_key (KeyFP ver grip) sec = (pre, subs) |
428 | where | 456 | where |
429 | (pre,subs) = break pred sec | 457 | (pre,subs) = break pred sec |
430 | pred p@(SecretKeyPacket {}) = matchpr grip p == grip | 458 | pred p@(SecretKeyPacket {}) = matchpr ver grip p == grip |
431 | pred p@(PublicKeyPacket {}) = matchpr grip p == grip | 459 | pred p@(PublicKeyPacket {}) = matchpr ver grip p == grip |
432 | pred _ = False | 460 | pred _ = False |
433 | 461 | ||
434 | seek_key (KeyTag key tag) ps | 462 | seek_key (KeyTag key tag) ps |
@@ -441,7 +469,7 @@ seek_key (KeyTag key tag) ps | |||
441 | (as,bs) = break (\p -> isSignaturePacket p | 469 | (as,bs) = break (\p -> isSignaturePacket p |
442 | && has_tag tag p | 470 | && has_tag tag p |
443 | && isJust (signature_issuer p) | 471 | && isJust (signature_issuer p) |
444 | && matchpr (fromJust $ signature_issuer p) key == fromJust (signature_issuer p) ) | 472 | && matchpr (version p) (fromJust $ signature_issuer p) key == fromJust (signature_issuer p) ) |
445 | ps | 473 | ps |
446 | (rs,qs) = break isKey (reverse as) | 474 | (rs,qs) = break isKey (reverse as) |
447 | 475 | ||