summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--KeyRing.hs475
-rw-r--r--kiki.hs396
2 files changed, 471 insertions, 400 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 5547673..9fd65f8 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -9,23 +9,35 @@ import System.Environment
9import Control.Monad 9import Control.Monad
10import Data.Maybe 10import Data.Maybe
11import Data.Char 11import Data.Char
12import Data.Ord
12import Data.List 13import Data.List
13import Data.OpenPGP 14import Data.OpenPGP
14import Data.Functor 15import Data.Functor
15import Data.Bits ( (.|.) ) 16import Data.Bits ( (.|.) )
16-- import Control.Applicative ( (<$>) ) 17import Control.Applicative ( liftA2, (<$>) )
17import System.Directory ( getHomeDirectory, doesFileExist ) 18import System.Directory ( getHomeDirectory, doesFileExist )
18import Control.Arrow ( first, second ) 19import Control.Arrow ( first, second )
19import Data.OpenPGP.Util ( fingerprint ) 20import Data.OpenPGP.Util (verify,fingerprint,decryptSecretKey,pgpSign)
20import Data.ByteString.Lazy ( ByteString ) 21import Data.ByteString.Lazy ( ByteString )
21import Text.Show.Pretty as PP ( ppShow ) 22import Text.Show.Pretty as PP ( ppShow )
22import Data.Word ( Word8 ) 23import Data.Word ( Word8 )
23import Data.Binary ( decode ) 24import Data.Binary ( decode )
24import ControlMaybe ( handleIO_ ) 25import ControlMaybe ( handleIO_ )
26import Data.ASN1.Types ( toASN1, ASN1Object, fromASN1
27 , ASN1(Start,End,IntVal,OID,BitString), ASN1ConstructionType(Sequence) )
28import Data.ASN1.BitArray ( BitArray(..), toBitArray )
29import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1' )
30import Data.ASN1.BinaryEncoding ( DER(..) )
31import Data.Time.Clock.POSIX ( getPOSIXTime )
25import qualified Data.Map as Map 32import qualified Data.Map as Map
26import qualified Data.ByteString.Lazy as L ( null, readFile, ByteString ) 33import qualified Data.ByteString.Lazy as L ( null, readFile, ByteString )
34import qualified Data.ByteString as S ( unpack )
27import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break ) 35import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break )
28import qualified Crypto.Types.PubKey.ECC as ECC 36import qualified Crypto.Types.PubKey.ECC as ECC
37import qualified Codec.Binary.Base32 as Base32
38import qualified Crypto.Hash.SHA1 as SHA1
39import qualified Data.Text as T ( Text, unpack, pack,
40 strip, reverse, drop, break, dropAround )
29import System.Posix.Types (EpochTime) 41import System.Posix.Types (EpochTime)
30import System.Posix.Files ( modificationTime, getFileStatus ) 42import System.Posix.Files ( modificationTime, getFileStatus )
31 43
@@ -97,12 +109,69 @@ filesToLock k secring pubring = do
97 109
98todo = error "unimplemented" 110todo = error "unimplemented"
99 111
100data KikiCondition a = KikiSuccess a | FailedToLock [FilePath] 112data RSAPublicKey = RSAKey MPI MPI deriving (Eq,Show)
113data PKCS8_RSAPublicKey = RSAKey8 MPI MPI deriving Show
114
115pkcs8 (RSAKey n e) = RSAKey8 n e
116
117instance ASN1Object RSAPublicKey where
118 -- PKCS #1 RSA Public Key
119 toASN1 (RSAKey (MPI n) (MPI e))
120 = \xs -> Start Sequence
121 : IntVal n
122 : IntVal e
123 : End Sequence
124 : xs
125 fromASN1 _ =
126 Left "fromASN1: RSAPublicKey: unexpected format"
127
128instance ASN1Object PKCS8_RSAPublicKey where
129
130 -- PKCS #8 Public key data
131 toASN1 (RSAKey8 (MPI n) (MPI e))
132 = \xs -> Start Sequence
133 : Start Sequence
134 : OID [1,2,840,113549,1,1,1]
135 : End Sequence
136 : BitString (toBitArray bs 0)
137 : End Sequence
138 : xs
139 where
140 pubkey = Start Sequence : IntVal n : IntVal e : End Sequence : []
141 bs = encodeASN1' DER pubkey
142
143 fromASN1 (Start Sequence:IntVal modulus:IntVal pubexp:End Sequence:xs) =
144 Right (RSAKey8 (MPI modulus) (MPI pubexp) , xs)
145 fromASN1 (Start Sequence:Start Sequence:OID [1,2,840,113549,1,1,1]:End Sequence:BitString b:End Sequence:xs) =
146 case decodeASN1' DER bs of
147 Right as -> fromASN1 as
148 Left e -> Left ("fromASN1: RSAPublicKey: "++show e)
149 where
150 BitArray _ bs = b
151
152 fromASN1 _ =
153 Left "fromASN1: RSAPublicKey: unexpected format"
154
155data RSAPrivateKey = RSAPrivateKey
156 { rsaN :: MPI
157 , rsaE :: MPI
158 , rsaD :: MPI
159 , rsaP :: MPI
160 , rsaQ :: MPI
161 , rsaDmodP1 :: MPI
162 , rsaDmodQminus1 :: MPI
163 , rsaCoefficient :: MPI
164 }
165 deriving Show
166
167
168data KikiCondition a = KikiSuccess a | FailedToLock [FilePath] | BadPassphrase
101 169
102#define TRIVIAL(OP) fmap _ (OP) = OP 170#define TRIVIAL(OP) fmap _ (OP) = OP
103instance Functor KikiCondition where 171instance Functor KikiCondition where
104 fmap f (KikiSuccess a) = KikiSuccess (f a) 172 fmap f (KikiSuccess a) = KikiSuccess (f a)
105 TRIVIAL( FailedToLock x ) 173 TRIVIAL( FailedToLock x )
174 TRIVIAL( BadPassphrase )
106instance FunctorToMaybe KikiCondition where 175instance FunctorToMaybe KikiCondition where
107 functorToMaybe (KikiSuccess a) = Just a 176 functorToMaybe (KikiSuccess a) = Just a
108 functorToMaybe _ = Nothing 177 functorToMaybe _ = Nothing
@@ -115,6 +184,8 @@ data KikiReportAction =
115 | NewWalletKey String 184 | NewWalletKey String
116 | YieldSignature 185 | YieldSignature
117 | YieldSecretKeyPacket String 186 | YieldSecretKeyPacket String
187 | UnableToUpdateExpiredSignature
188 | FailedToMakeSignature
118 189
119data KikiResult a = KikiResult 190data KikiResult a = KikiResult
120 { kikiCondition :: KikiCondition a 191 { kikiCondition :: KikiCondition a
@@ -130,6 +201,45 @@ usage (NotationDataPacket
130 }) = Just u 201 }) = Just u
131usage _ = Nothing 202usage _ = Nothing
132 203
204-- torsig g topk wkun uid timestamp extras = todo
205torSigOver topk wkun uid extras
206 = CertificationSignature (secretToPublic topk)
207 uid
208 (sigpackets 0x13
209 subpackets
210 subpackets_unh)
211 where
212 subpackets = -- implicit: [ SignatureCreationTimePacket (fromIntegral timestamp) ]
213 tsign
214 ++ extras
215 subpackets_unh = [IssuerPacket (fingerprint wkun)]
216 tsign = if keykey wkun == keykey topk
217 then [] -- tsign doesnt make sense for self-signatures
218 else [ TrustSignaturePacket 1 120
219 , RegularExpressionPacket regex]
220 -- <[^>]+[@.]asdf\.nowhere>$
221 regex = "<[^>]+[@.]"++hostname++">$"
222 -- regex = username ++ "@" ++ hostname
223 -- username = "[a-zA-Z0-9.][-a-zA-Z0-9.]*\\$?" :: String
224 hostname = subdomain' pu ++ "\\." ++ topdomain' pu
225 pu = parseUID uidstr where UserIDPacket uidstr = uid
226 subdomain' = escape . T.unpack . uid_subdomain
227 topdomain' = escape . T.unpack . uid_topdomain
228 escape s = concatMap echar s
229 where
230 echar '|' = "\\|"
231 echar '*' = "\\*"
232 echar '+' = "\\+"
233 echar '?' = "\\?"
234 echar '.' = "\\."
235 echar '^' = "\\^"
236 echar '$' = "\\$"
237 echar '\\' = "\\\\"
238 echar '[' = "\\["
239 echar ']' = "\\]"
240 echar c = [c]
241
242
133keyflags flgs@(KeyFlagsPacket {}) = 243keyflags flgs@(KeyFlagsPacket {}) =
134 Just . toEnum $ 244 Just . toEnum $
135 ( bit 0x1 certify_keys 245 ( bit 0x1 certify_keys
@@ -268,6 +378,37 @@ matchSpec (KeyUidMatch pat) (_,KeyData _ _ uids _) = not $ null us
268 where 378 where
269 us = filter (isInfixOf pat) $ Map.keys uids 379 us = filter (isInfixOf pat) $ Map.keys uids
270 380
381data UserIDRecord = UserIDRecord {
382 uid_full :: String,
383 uid_realname :: T.Text,
384 uid_user :: T.Text,
385 uid_subdomain :: T.Text,
386 uid_topdomain :: T.Text
387}
388 deriving Show
389
390parseUID str = UserIDRecord {
391 uid_full = str,
392 uid_realname = realname,
393 uid_user = user,
394 uid_subdomain = subdomain,
395 uid_topdomain = topdomain
396 }
397 where
398 text = T.pack str
399 (T.strip-> realname, T.dropAround isBracket-> email)
400 = T.break (=='<') text
401 (user, T.drop 1-> hostname) = T.break (=='@') email
402 ( T.reverse -> topdomain,
403 T.reverse . T.drop 1 -> subdomain)
404 = T.break (=='.') . T.reverse $ hostname
405isBracket :: Char -> Bool
406isBracket '<' = True
407isBracket '>' = True
408isBracket _ = False
409
410
411
271 412
272data KeySpec = 413data KeySpec =
273 KeyGrip String 414 KeyGrip String
@@ -309,11 +450,132 @@ buildKeyDB secring pubring grip0 keyring = do
309 db0 = foldl' (uncurry . merge) Map.empty ms 450 db0 = foldl' (uncurry . merge) Map.empty ms
310 451
311 wms <- mapM (readw wk) (files iswallet) 452 wms <- mapM (readw wk) (files iswallet)
312 453 let wms' = do
454 maybeToList wk
455 (fname,xs) <- wms
456 (_,sub,(_,m)) <- xs
457 (tag,top) <- Map.toList m
458 return (top,fname,sub,tag)
459
460 {-
461 importWalletKey db' (top,fname,sub,tag) = do
462 doImportG doDecrypt
463 db'
464 (fmap keykey $ maybeToList wk)
465 tag
466 fname
467 sub
468 -}
469
470 -- db <- foldM importWalletKey db0 ts
313 (db,report) <- return (db0,[]) -- todo 471 (db,report) <- return (db0,[]) -- todo
314 472
315 return ( (db, grip), report ) 473 return ( (db, grip), report )
316 474
475torhash key = maybe "" id $ derToBase32 <$> derRSA key
476
477derToBase32 = map toLower . Base32.encode . S.unpack . SHA1.hashlazy
478
479derRSA rsa = do
480 k <- rsaKeyFromPacket rsa
481 return $ encodeASN1 DER (toASN1 k [])
482
483try :: KikiCondition a -> (a -> IO (KikiCondition b)) -> IO (KikiCondition b)
484try wkun body =
485 case functorToEither wkun of
486 Left e -> return e
487 Right wkun -> body wkun
488
489doImportG
490 :: Ord k =>
491 (Packet -> IO (KikiCondition Packet))
492 -> Map.Map k KeyData
493 -> [k]
494 -> [Char]
495 -> [Char]
496 -> Packet
497 -> IO (KikiCondition (Map.Map k KeyData, [(FilePath,KikiReportAction)]))
498doImportG doDecrypt db m0 tag fname key = do
499 let kk = head m0
500 Just (KeyData top topsigs uids subs) = Map.lookup kk db
501 subkk = keykey key
502 (is_new, subkey) = maybe (True, SubKey (mappedPacket fname key)
503 [])
504 ( (False,) . addOrigin )
505 (Map.lookup subkk subs)
506 where
507 addOrigin (SubKey mp sigs) =
508 let mp' = mp
509 { locations = Map.insert fname
510 (origin (packet mp) (-1))
511 (locations mp) }
512 in SubKey mp' sigs
513 subs' = Map.insert subkk subkey subs
514
515 istor = do
516 guard (tag == "tor")
517 return $ "Anonymous <root@" ++ take 16 (torhash key) ++ ".onion>"
518
519 uids' <- flip (maybe $ return $ KikiSuccess (uids,[])) istor $ \idstr -> do
520 let has_torid = do
521 -- TODO: check for omitted real name field
522 (sigtrusts,om) <- Map.lookup idstr uids
523 listToMaybe $ do
524 s <- (signatures $ Message (packet top:UserIDPacket idstr:map (packet . fst) sigtrusts))
525 signatures_over $ verify (Message [packet top]) s
526 flip (flip maybe $ const $ return $ KikiSuccess (uids,[])) has_torid $ do
527 wkun <- doDecrypt (packet top)
528
529 try wkun $ \wkun -> do
530
531 let keyflags = keyFlags wkun (map packet $ flattenAllUids fname True uids)
532 uid = UserIDPacket idstr
533 -- sig_ov = fst $ torsig g (packet top) wkun uid timestamp keyflags
534 tor_ov = torSigOver (packet top) wkun uid keyflags
535 sig_ov <- pgpSign (Message [wkun])
536 tor_ov
537 SHA1
538 (fingerprint wkun)
539 flip (maybe $ return $ KikiSuccess (uids,[(fname, FailedToMakeSignature)]))
540 (sig_ov >>= listToMaybe . signatures_over)
541 $ \sig -> do
542 let om = Map.singleton fname (origin sig (-1))
543 trust = Map.empty
544 return $ KikiSuccess
545 ( Map.insert idstr ([( (mappedPacket fname sig) {locations=om}
546 , trust)],om) uids
547 , [] )
548
549 try uids' $ \(uids',report) -> do
550
551 let SubKey subkey_p subsigs = subkey
552 wk = packet top
553 (xs',minsig,ys') = findTag tag wk key subsigs
554 doInsert mbsig db = do
555 sig' <- makeSig doDecrypt top fname subkey_p tag mbsig
556 try sig' $ \(sig',report) -> do
557 report <- return $ fmap (fname,) report ++ [(fname, YieldSignature)]
558 let subs' = Map.insert subkk
559 (SubKey subkey_p $ xs'++[sig']++ys')
560 subs
561 return $ KikiSuccess ( Map.insert kk (KeyData top topsigs uids' subs') db
562 , report )
563
564 report <- let f = if is_new then (++[(fname,YieldSecretKeyPacket s)])
565 else id
566 s = show (fmap fst minsig,fingerprint key)
567 in return (f report)
568
569 case minsig of
570 Nothing -> doInsert Nothing db -- we need to create a new sig
571 Just (True,sig) -> -- we can deduce is_new == False
572 -- we may need to add a tor id
573 return $ KikiSuccess ( Map.insert kk (KeyData top topsigs uids' subs') db
574 , report )
575 Just (False,sig) -> doInsert (Just sig) db -- We have a sig, but is missing usage@ tag
576
577
578
317runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a) 579runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a)
318runKeyRing keyring op = do 580runKeyRing keyring op = do
319 (homedir,secring,pubring,grip0) <- getHomeDir (homeSpec keyring) 581 (homedir,secring,pubring,grip0) <- getHomeDir (homeSpec keyring)
@@ -409,6 +671,32 @@ isUserID _ = False
409isTrust (TrustPacket {}) = True 671isTrust (TrustPacket {}) = True
410isTrust _ = False 672isTrust _ = False
411 673
674sigpackets typ hashed unhashed = return $
675 signaturePacket
676 4 -- version
677 typ -- 0x18 subkey binding sig, or 0x19 back-signature
678 RSA
679 SHA1
680 hashed
681 unhashed
682 0 -- Word16 -- Left 16 bits of the signed hash value
683 [] -- [MPI]
684
685secretToPublic pkt@(SecretKeyPacket {}) =
686 PublicKeyPacket { version = version pkt
687 , timestamp = timestamp pkt
688 , key_algorithm = key_algorithm pkt
689 -- , ecc_curve = ecc_curve pkt
690 , key = let seckey = key pkt
691 pubs = public_key_fields (key_algorithm pkt)
692 in filter (\(k,v) -> k `elem` pubs) seckey
693 , is_subkey = is_subkey pkt
694 , v3_days_of_validity = Nothing
695 }
696secretToPublic pkt = pkt
697
698
699
412slurpWIPKeys :: System.Posix.Types.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString]) 700slurpWIPKeys :: System.Posix.Types.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString])
413slurpWIPKeys stamp "" = ([],[]) 701slurpWIPKeys stamp "" = ([],[])
414slurpWIPKeys stamp cs = 702slurpWIPKeys stamp cs =
@@ -465,6 +753,18 @@ decode_btc_key timestamp str = do
465 , is_subkey = True 753 , is_subkey = True
466 } 754 }
467 755
756rsaKeyFromPacket :: Packet -> Maybe RSAPublicKey
757rsaKeyFromPacket p@(PublicKeyPacket {}) = do
758 n <- lookup 'n' $ key p
759 e <- lookup 'e' $ key p
760 return $ RSAKey n e
761rsaKeyFromPacket p@(SecretKeyPacket {}) = do
762 n <- lookup 'n' $ key p
763 e <- lookup 'e' $ key p
764 return $ RSAKey n e
765rsaKeyFromPacket _ = Nothing
766
767
468readPacketsFromWallet :: 768readPacketsFromWallet ::
469 Maybe Packet 769 Maybe Packet
470 -> FilePath 770 -> FilePath
@@ -500,6 +800,149 @@ readPacketsFromFile fname = do
500 return $ decode input 800 return $ decode input
501#endif 801#endif
502 802
803now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime
804
805signature_time ov = case if null cs then ds else cs of
806 [] -> minBound
807 xs -> last (sort xs)
808 where
809 ps = signatures_over ov
810 ss = filter isSignaturePacket ps
811 cs = concatMap (concatMap creationTime . hashed_subpackets) ss
812 ds = concatMap (concatMap creationTime . unhashed_subpackets) ss
813 creationTime (SignatureCreationTimePacket t) = [t]
814 creationTime _ = []
815
816splitAtMinBy comp xs = minimumBy comp' xxs
817 where
818 xxs = zip (inits xs) (tails xs)
819 comp' (_,as) (_,bs) = compM (listToMaybe as) (listToMaybe bs)
820 compM (Just a) (Just b) = comp a b
821 compM Nothing mb = GT
822 compM _ _ = LT
823
824
825
826findTag tag wk subkey subsigs = (xs',minsig,ys')
827 where
828 vs = map (\sig ->
829 (sig, do
830 sig <- Just (packet . fst $ sig)
831 guard (isSignaturePacket sig)
832 guard $ flip isSuffixOf
833 (fingerprint wk)
834 . maybe "%bad%" id
835 . signature_issuer
836 $ sig
837 listToMaybe $
838 map (signature_time . verify (Message [wk]))
839 (signatures $ Message [wk,subkey,sig])))
840 subsigs
841 (xs,ys) = splitAtMinBy (comparing (Down . snd)) vs
842 xs' = map fst xs
843 ys' = map fst $ if isNothing minsig then ys else drop 1 ys
844 minsig = do
845 (sig,ov) <- listToMaybe ys
846 ov
847 let hs = filter (\p->isNotation p && notation_name p=="usage@")
848 (hashed_subpackets . packet . fst $ sig)
849 ks = map notation_value hs
850 isNotation (NotationDataPacket {}) = True
851 isNotation _ = False
852 return (tag `elem` ks, sig)
853
854
855makeSig doDecrypt top fname subkey_p tag mbsig = do
856 let wk = packet top
857 wkun <- doDecrypt wk
858 try wkun $ \wkun -> do
859 let grip = fingerprint wk
860 addOrigin new_sig = do
861 flip (maybe $ error "Failed to make signature.")
862 (new_sig >>= listToMaybe . signatures_over)
863 $ \new_sig -> do
864 let mp' = mappedPacket fname new_sig
865 return (mp', Map.empty)
866 parsedkey = [packet $ subkey_p]
867 hashed0 =
868 [ KeyFlagsPacket
869 { certify_keys = False
870 , sign_data = False
871 , encrypt_communication = False
872 , encrypt_storage = False
873 , split_key = False
874 , authentication = True
875 , group_key = False }
876 , NotationDataPacket
877 { human_readable = True
878 , notation_name = "usage@"
879 , notation_value = tag
880 }
881 -- implicitly added:
882 -- , SignatureCreationTimePacket (fromIntegral timestamp)
883 ]
884 subgrip = fingerprint (head parsedkey)
885
886 back_sig <- pgpSign (Message parsedkey)
887 (SubkeySignature wk
888 (head parsedkey)
889 (sigpackets 0x19
890 hashed0
891 [IssuerPacket subgrip]))
892 (if key_algorithm (head parsedkey)==ECDSA
893 then SHA256
894 else SHA1)
895 subgrip
896 let iss = IssuerPacket (fingerprint wk)
897 cons_iss back_sig = iss : map EmbeddedSignaturePacket (signatures_over back_sig)
898 unhashed0 = maybe [iss] cons_iss back_sig
899
900 new_sig <- pgpSign (Message [wkun])
901 (SubkeySignature wk
902 (head parsedkey)
903 (sigpackets 0x18
904 hashed0
905 unhashed0))
906 SHA1
907 grip
908 let newSig = do
909 (k,o) <- addOrigin new_sig
910 return $ KikiSuccess ((k,o),[])
911 flip (maybe newSig) mbsig $ \(mp,trustmap) -> do
912 let sig = packet mp
913 isCreation (SignatureCreationTimePacket {}) = True
914 isCreation _ = False
915 isExpiration (SignatureExpirationTimePacket {}) = True
916 isExpiration _ = False
917 (cs,ps) = partition isCreation (hashed_subpackets sig)
918 (es,qs) = partition isExpiration ps
919 stamp = listToMaybe . sortBy (comparing Down) $
920 map unwrap cs where unwrap (SignatureCreationTimePacket x) = x
921 exp = listToMaybe $ sort $
922 map unwrap es where unwrap (SignatureExpirationTimePacket x) = x
923 expires = liftA2 (+) stamp exp
924 timestamp <- now
925 if fmap ( (< timestamp) . fromIntegral) expires == Just True then do
926 return $ KikiSuccess ((mp,trustmap), [ UnableToUpdateExpiredSignature ] )
927 else do
928 let times = (:) (SignatureExpirationTimePacket (fromIntegral timestamp))
929 $ maybeToList $ do
930 e <- expires
931 return $ SignatureExpirationTimePacket (e - fromIntegral timestamp)
932 notation = NotationDataPacket
933 { notation_name = "usage@"
934 , notation_value = tag
935 , human_readable = True }
936 sig' = sig { hashed_subpackets = times ++ [notation] ++ qs }
937 new_sig <- pgpSign (Message [wkun])
938 (SubkeySignature wk
939 (packet subkey_p)
940 [sig'] )
941 SHA1
942 (fingerprint wk)
943 fmap (KikiSuccess . (,[])) $ addOrigin new_sig
944
945
503 946
504data OriginFlags = OriginFlags { 947data OriginFlags = OriginFlags {
505 originallyPublic :: Bool, 948 originallyPublic :: Bool,
@@ -696,6 +1139,30 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs)
696 mergeSubSig n sig Nothing = error $ 1139 mergeSubSig n sig Nothing = error $
697 "Unable to merge subkey signature: "++(words (show sig) >>= take 1) 1140 "Unable to merge subkey signature: "++(words (show sig) >>= take 1)
698 1141
1142unsig :: FilePath -> Bool -> SigAndTrust -> [MappedPacket]
1143unsig fname isPublic (sig,trustmap) =
1144 [sig]++ map (asMapped (-1)) ( take 1 . Map.elems $ Map.filterWithKey f trustmap)
1145 where
1146 f n _ = n==fname -- && trace ("fname=n="++show n) True
1147 asMapped n p = let m = mappedPacket fname p
1148 in m { locations = fmap (\x->x {originalNum=n}) (locations m) }
1149
1150concatSort fname getp f = concat . sortByHint fname getp . map f
1151
1152sortByHint fname f = sortBy (comparing gethint)
1153 where
1154 gethint = maybe defnum originalNum . Map.lookup fname . locations . f
1155 defnum = -1
1156
1157flattenAllUids :: FilePath -> Bool -> Map.Map String ([SigAndTrust],OriginMap) -> [MappedPacket]
1158flattenAllUids fname ispub uids =
1159 concatSort fname head (flattenUid fname ispub) (Map.assocs uids)
1160
1161flattenUid :: FilePath -> Bool -> (String,([SigAndTrust],OriginMap)) -> [MappedPacket]
1162flattenUid fname ispub (str,(sigs,om)) =
1163 (mappedPacket "" $ UserIDPacket str) {locations=om} : concatSort fname head (unsig fname ispub) sigs
1164
1165
699 1166
700{- 1167{-
701data Kiki a = 1168data Kiki a =
diff --git a/kiki.hs b/kiki.hs
index d7ea9c7..3c3fdc9 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -108,61 +108,6 @@ unprefix c spec = if null (snd p) then swap p else (fst p, tail (snd p))
108 where p = break (==c) spec 108 where p = break (==c) spec
109 109
110 110
111data RSAPublicKey = RSAKey MPI MPI deriving (Eq,Show)
112data PKCS8_RSAPublicKey = RSAKey8 MPI MPI deriving Show
113
114pkcs8 (RSAKey n e) = RSAKey8 n e
115
116instance ASN1Object RSAPublicKey where
117 -- PKCS #1 RSA Public Key
118 toASN1 (RSAKey (MPI n) (MPI e))
119 = \xs -> Start Sequence
120 : IntVal n
121 : IntVal e
122 : End Sequence
123 : xs
124 fromASN1 _ =
125 Left "fromASN1: RSAPublicKey: unexpected format"
126
127instance ASN1Object PKCS8_RSAPublicKey where
128
129 -- PKCS #8 Public key data
130 toASN1 (RSAKey8 (MPI n) (MPI e))
131 = \xs -> Start Sequence
132 : Start Sequence
133 : OID [1,2,840,113549,1,1,1]
134 : End Sequence
135 : BitString (toBitArray bs 0)
136 : End Sequence
137 : xs
138 where
139 pubkey = Start Sequence : IntVal n : IntVal e : End Sequence : []
140 bs = encodeASN1' DER pubkey
141
142 fromASN1 (Start Sequence:IntVal modulus:IntVal pubexp:End Sequence:xs) =
143 Right (RSAKey8 (MPI modulus) (MPI pubexp) , xs)
144 fromASN1 (Start Sequence:Start Sequence:OID [1,2,840,113549,1,1,1]:End Sequence:BitString b:End Sequence:xs) =
145 case decodeASN1' DER bs of
146 Right as -> fromASN1 as
147 Left e -> Left ("fromASN1: RSAPublicKey: "++show e)
148 where
149 BitArray _ bs = b
150
151 fromASN1 _ =
152 Left "fromASN1: RSAPublicKey: unexpected format"
153
154data RSAPrivateKey = RSAPrivateKey
155 { rsaN :: MPI
156 , rsaE :: MPI
157 , rsaD :: MPI
158 , rsaP :: MPI
159 , rsaQ :: MPI
160 , rsaDmodP1 :: MPI
161 , rsaDmodQminus1 :: MPI
162 , rsaCoefficient :: MPI
163 }
164 deriving Show
165
166{- 111{-
167RSAPrivateKey ::= SEQUENCE { 112RSAPrivateKey ::= SEQUENCE {
168 version Version, 113 version Version,
@@ -240,21 +185,6 @@ decode_sshrsa bs = do
240 return rsakey 185 return rsakey
241 186
242 187
243rsaKeyFromPacket :: Packet -> Maybe RSAPublicKey
244rsaKeyFromPacket p@(PublicKeyPacket {}) = do
245 n <- lookup 'n' $ key p
246 e <- lookup 'e' $ key p
247 return $ RSAKey n e
248rsaKeyFromPacket p@(SecretKeyPacket {}) = do
249 n <- lookup 'n' $ key p
250 e <- lookup 'e' $ key p
251 return $ RSAKey n e
252rsaKeyFromPacket _ = Nothing
253
254derRSA rsa = do
255 k <- rsaKeyFromPacket rsa
256 return $ encodeASN1 DER (toASN1 k [])
257
258rsaPrivateKeyFromPacket :: Packet -> Maybe RSAPrivateKey 188rsaPrivateKeyFromPacket :: Packet -> Maybe RSAPrivateKey
259rsaPrivateKeyFromPacket pkt@(SecretKeyPacket {}) = do 189rsaPrivateKeyFromPacket pkt@(SecretKeyPacket {}) = do
260 -- public fields... 190 -- public fields...
@@ -295,20 +225,6 @@ getPackets = do
295-} 225-}
296 226
297 227
298secretToPublic pkt@(SecretKeyPacket {}) =
299 PublicKeyPacket { version = version pkt
300 , timestamp = timestamp pkt
301 , key_algorithm = key_algorithm pkt
302 -- , ecc_curve = ecc_curve pkt
303 , key = let seckey = key pkt
304 pubs = public_key_fields (key_algorithm pkt)
305 in filter (\(k,v) -> k `elem` pubs) seckey
306 , is_subkey = is_subkey pkt
307 , v3_days_of_validity = Nothing
308 }
309secretToPublic pkt = pkt
310
311
312extractPEM typ pem = dta 228extractPEM typ pem = dta
313 where 229 where
314 dta = case ys of 230 dta = case ys of
@@ -446,38 +362,6 @@ accBindings bs = as
446 = (ac .|. bc,p,akind++bkind,ahashed++bhashed,aclaimaints++bclaimaints) 362 = (ac .|. bc,p,akind++bkind,ahashed++bhashed,aclaimaints++bclaimaints)
447 363
448 364
449data UserIDRecord = UserIDRecord {
450 uid_full :: String,
451 uid_realname :: T.Text,
452 uid_user :: T.Text,
453 uid_subdomain :: T.Text,
454 uid_topdomain :: T.Text
455}
456 deriving Show
457
458isBracket '<' = True
459isBracket '>' = True
460isBracket _ = False
461
462parseUID str = UserIDRecord {
463 uid_full = str,
464 uid_realname = realname,
465 uid_user = user,
466 uid_subdomain = subdomain,
467 uid_topdomain = topdomain
468 }
469 where
470 text = T.pack str
471 (T.strip-> realname, T.dropAround isBracket-> email)
472 = T.break (=='<') text
473 (user, T.drop 1-> hostname) = T.break (=='@') email
474 ( T.reverse -> topdomain,
475 T.reverse . T.drop 1 -> subdomain)
476 = T.break (=='.') . T.reverse $ hostname
477
478
479derToBase32 = map toLower . Base32.encode . S.unpack . SHA1.hashlazy
480
481fpmatch grip key = 365fpmatch grip key =
482 (==) Nothing 366 (==) Nothing
483 (fmap (backend (fingerprint key)) grip >>= guard . not) 367 (fmap (backend (fingerprint key)) grip >>= guard . not)
@@ -882,8 +766,6 @@ is40digitHex xs = ys == xs && length ys==40
882 | 'a' <= c && c <= 'f' = True 766 | 'a' <= c && c <= 'f' = True
883 ishex c = False 767 ishex c = False
884 768
885torhash key = maybe "" id $ derToBase32 <$> derRSA key
886
887flattenKeys :: Bool -> KeyDB -> Message 769flattenKeys :: Bool -> KeyDB -> Message
888flattenKeys isPublic db = Message $ concatMap (map packet . flattenTop "" isPublic . snd) (prefilter . Map.assocs $ db) 770flattenKeys isPublic db = Message $ concatMap (map packet . flattenTop "" isPublic . snd) (prefilter . Map.assocs $ db)
889 where 771 where
@@ -897,22 +779,12 @@ flattenKeys isPublic db = Message $ concatMap (map packet . flattenTop "" isPubl
897 isSecret _ = False 779 isSecret _ = False
898 780
899 781
900concatSort fname getp f = concat . sortByHint fname getp . map f
901
902flattenTop :: FilePath -> Bool -> KeyData -> [MappedPacket] 782flattenTop :: FilePath -> Bool -> KeyData -> [MappedPacket]
903flattenTop fname ispub (KeyData key sigs uids subkeys) = 783flattenTop fname ispub (KeyData key sigs uids subkeys) =
904 unk ispub key : 784 unk ispub key :
905 ( flattenAllUids fname ispub uids 785 ( flattenAllUids fname ispub uids
906 ++ concatSort fname head (flattenSub fname ispub) (Map.elems subkeys)) 786 ++ concatSort fname head (flattenSub fname ispub) (Map.elems subkeys))
907 787
908flattenAllUids :: FilePath -> Bool -> Map.Map String ([SigAndTrust],OriginMap) -> [MappedPacket]
909flattenAllUids fname ispub uids =
910 concatSort fname head (flattenUid fname ispub) (Map.assocs uids)
911
912flattenUid :: FilePath -> Bool -> (String,([SigAndTrust],OriginMap)) -> [MappedPacket]
913flattenUid fname ispub (str,(sigs,om)) =
914 (mappedPacket "" $ UserIDPacket str) {locations=om} : concatSort fname head (unsig fname ispub) sigs
915
916flattenSub :: FilePath -> Bool -> SubKey -> [MappedPacket] 788flattenSub :: FilePath -> Bool -> SubKey -> [MappedPacket]
917flattenSub fname ispub (SubKey key sigs) = unk ispub key: concatSort fname head (unsig fname ispub) sigs 789flattenSub fname ispub (SubKey key sigs) = unk ispub key: concatSort fname head (unsig fname ispub) sigs
918 790
@@ -920,14 +792,6 @@ unk :: Bool -> MappedPacket -> MappedPacket
920unk isPublic = if isPublic then toPacket secretToPublic else id 792unk isPublic = if isPublic then toPacket secretToPublic else id
921 where toPacket f mp@(MappedPacket {packet=p}) = mp {packet=(f p)} 793 where toPacket f mp@(MappedPacket {packet=p}) = mp {packet=(f p)}
922 794
923unsig :: FilePath -> Bool -> SigAndTrust -> [MappedPacket]
924unsig fname isPublic (sig,trustmap) =
925 [sig]++ map (asMapped (-1)) ( take 1 . Map.elems $ Map.filterWithKey f trustmap)
926 where
927 f n _ = n==fname -- && trace ("fname=n="++show n) True
928 asMapped n p = let m = mappedPacket fname p
929 in m { locations = fmap (\x->x {originalNum=n}) (locations m) }
930
931ifSecret (SecretKeyPacket {}) t f = t 795ifSecret (SecretKeyPacket {}) t f = t
932ifSecret _ t f = f 796ifSecret _ t f = f
933 797
@@ -940,11 +804,6 @@ showPacket p | isKey p = (if is_subkey p
940 | otherwise = showPacket0 p 804 | otherwise = showPacket0 p
941showPacket0 p = concat . take 1 $ words (show p) 805showPacket0 p = concat . take 1 $ words (show p)
942 806
943sortByHint fname f = sortBy (comparing gethint)
944 where
945 gethint = maybe defnum originalNum . Map.lookup fname . locations . f
946 defnum = -1
947
948keyMappedPacket (KeyData k _ _ _) = k 807keyMappedPacket (KeyData k _ _ _) = k
949 808
950writeOutKeyrings :: Map.Map FilePath t -> KeyDB -> IO () 809writeOutKeyrings :: Map.Map FilePath t -> KeyDB -> IO ()
@@ -1160,15 +1019,6 @@ parseSpec grip spec = (topspec,subspec)
1160 "" | top=="" && is40digitHex sub -> Nothing 1019 "" | top=="" && is40digitHex sub -> Nothing
1161 "" -> listToMaybe sub >> Just sub 1020 "" -> listToMaybe sub >> Just sub
1162 1021
1163splitAtMinBy comp xs = minimumBy comp' xxs
1164 where
1165 xxs = zip (inits xs) (tails xs)
1166 comp' (_,as) (_,bs) = compM (listToMaybe as) (listToMaybe bs)
1167 compM (Just a) (Just b) = comp a b
1168 compM Nothing mb = GT
1169 compM _ _ = LT
1170
1171
1172-- | systemEnv 1022-- | systemEnv
1173-- This is like System.Process.system except that it lets you set 1023-- This is like System.Process.system except that it lets you set
1174-- some environment variables. 1024-- some environment variables.
@@ -1239,34 +1089,6 @@ doExport doDecrypt (db,use_db) (fname,subspec,ms,cmd) =
1239 writeKeyToFile False "PEM" fname pun 1089 writeKeyToFile False "PEM" fname pun
1240 return (db,use_db) 1090 return (db,use_db)
1241 1091
1242findTag tag wk subkey subsigs = (xs',minsig,ys')
1243 where
1244 vs = map (\sig ->
1245 (sig, do
1246 sig <- Just (packet . fst $ sig)
1247 guard (isSignaturePacket sig)
1248 guard $ flip isSuffixOf
1249 (fingerprint wk)
1250 . maybe "%bad%" id
1251 . signature_issuer
1252 $ sig
1253 listToMaybe $
1254 map (signature_time . verify (Message [wk]))
1255 (signatures $ Message [wk,subkey,sig])))
1256 subsigs
1257 (xs,ys) = splitAtMinBy (comparing (Down . snd)) vs
1258 xs' = map fst xs
1259 ys' = map fst $ if isNothing minsig then ys else drop 1 ys
1260 minsig = do
1261 (sig,ov) <- listToMaybe ys
1262 ov
1263 let hs = filter (\p->isNotation p && notation_name p=="usage@")
1264 (hashed_subpackets . packet . fst $ sig)
1265 ks = map notation_value hs
1266 isNotation (NotationDataPacket {}) = True
1267 isNotation _ = False
1268 return (tag `elem` ks, sig)
1269
1270{- 1092{-
1271applyCurve curve x = x*x*x + x*a + b where (a,b)=(geta curve,getb curve) 1093applyCurve curve x = x*x*x + x*a + b where (a,b)=(geta curve,getb curve)
1272 1094
@@ -1426,175 +1248,6 @@ doImport doDecrypt db (fname,subspec,ms,_) = do
1426 $ error "Key specification is ambiguous." 1248 $ error "Key specification is ambiguous."
1427 doImportG doDecrypt db m0 tag fname key 1249 doImportG doDecrypt db m0 tag fname key
1428 1250
1429doImportG doDecrypt db m0 tag fname key = do
1430 let error s = do
1431 warn s
1432 exitFailure
1433 let kk = head m0
1434 Just (KeyData top topsigs uids subs) = Map.lookup kk db
1435 subkk = keykey key
1436 (is_new, subkey) = maybe (True, SubKey (mappedPacket fname key)
1437 [])
1438 ( (False,) . addOrigin )
1439 (Map.lookup subkk subs)
1440 where
1441 addOrigin (SubKey mp sigs) =
1442 let mp' = mp
1443 { locations = Map.insert fname
1444 (origin (packet mp) (-1))
1445 (locations mp) }
1446 in SubKey mp' sigs
1447 subs' = Map.insert subkk subkey subs
1448
1449 istor = do
1450 guard (tag == "tor")
1451 return $ "Anonymous <root@" ++ take 16 (torhash key) ++ ".onion>"
1452
1453 uids' <- flip (maybe $ return uids) istor $ \idstr -> do
1454 let has_torid = do
1455 -- TODO: check for omitted real name field
1456 (sigtrusts,om) <- Map.lookup idstr uids
1457 listToMaybe $ do
1458 s <- (signatures $ Message (packet top:UserIDPacket idstr:map (packet . fst) sigtrusts))
1459 signatures_over $ verify (Message [packet top]) s
1460 flip (flip maybe $ const $ return uids) has_torid $ do
1461 wkun <- doDecrypt (packet top)
1462 flip (maybe $ error "Bad passphrase?") wkun $ \wkun -> do
1463 let keyflags = keyFlags wkun (map packet $ flattenAllUids fname True uids)
1464 uid = UserIDPacket idstr
1465 -- sig_ov = fst $ torsig g (packet top) wkun uid timestamp keyflags
1466 tor_ov = torSigOver (packet top) wkun uid keyflags
1467 sig_ov <- pgpSign (Message [wkun])
1468 tor_ov
1469 SHA1
1470 (fingerprint wkun)
1471 flip (maybe $ warn "Failed to make signature" >> return uids)
1472 (sig_ov >>= listToMaybe . signatures_over)
1473 $ \sig -> do
1474 let om = Map.singleton fname (origin sig (-1))
1475 trust = Map.empty
1476 return $ Map.insert idstr ([( (mappedPacket fname sig) {locations=om}
1477 ,trust)],om) uids
1478
1479 let SubKey subkey_p subsigs = subkey
1480 wk = packet top
1481 (xs',minsig,ys') = findTag tag wk key subsigs
1482 doInsert mbsig db = do
1483 sig' <- makeSig doDecrypt top fname subkey_p tag mbsig
1484 warn $ fname ++ ": yield SignaturePacket"
1485 let subs' = Map.insert subkk
1486 (SubKey subkey_p $ xs'++[sig']++ys')
1487 subs
1488 return $ Map.insert kk (KeyData top topsigs uids' subs') db
1489 when is_new (warn $ fname ++ ": yield SecretKeyPacket "++show (fmap fst minsig,fingerprint key))
1490 case minsig of
1491 Nothing -> doInsert Nothing db -- we need to create a new sig
1492 Just (True,sig) -> -- we can deduce is_new == False
1493 -- we may need to add a tor id
1494 return $ Map.insert kk (KeyData top topsigs uids' subs') db
1495 Just (False,sig) -> doInsert (Just sig) db -- We have a sig, but is missing usage@ tag
1496
1497
1498makeSig doDecrypt top fname subkey_p tag mbsig = do
1499 let wk = packet top
1500 wkun <- doDecrypt wk
1501 flip (maybe $ error "Bad passphrase?") wkun $ \wkun -> do
1502 let grip = fingerprint wk
1503 addOrigin new_sig = do
1504 flip (maybe $ error "Failed to make signature.")
1505 (new_sig >>= listToMaybe . signatures_over)
1506 $ \new_sig -> do
1507 let mp' = mappedPacket fname new_sig
1508 return (mp', Map.empty)
1509 parsedkey = [packet $ subkey_p]
1510 hashed0 =
1511 [ KeyFlagsPacket
1512 { certify_keys = False
1513 , sign_data = False
1514 , encrypt_communication = False
1515 , encrypt_storage = False
1516 , split_key = False
1517 , authentication = True
1518 , group_key = False }
1519 , NotationDataPacket
1520 { human_readable = True
1521 , notation_name = "usage@"
1522 , notation_value = tag
1523 }
1524 -- implicitly added:
1525 -- , SignatureCreationTimePacket (fromIntegral timestamp)
1526 ]
1527 subgrip = fingerprint (head parsedkey)
1528
1529 back_sig <- pgpSign (Message parsedkey)
1530 (SubkeySignature wk
1531 (head parsedkey)
1532 (sigpackets 0x19
1533 hashed0
1534 [IssuerPacket subgrip]))
1535 (if key_algorithm (head parsedkey)==ECDSA
1536 then SHA256
1537 else SHA1)
1538 subgrip
1539 let iss = IssuerPacket (fingerprint wk)
1540 cons_iss back_sig = iss : map EmbeddedSignaturePacket (signatures_over back_sig)
1541 unhashed0 = maybe [iss] cons_iss back_sig
1542
1543 new_sig <- pgpSign (Message [wkun])
1544 (SubkeySignature wk
1545 (head parsedkey)
1546 (sigpackets 0x18
1547 hashed0
1548 unhashed0))
1549 SHA1
1550 grip
1551 let newSig = addOrigin new_sig
1552 flip (maybe newSig) mbsig $ \(mp,trustmap) -> do
1553 let sig = packet mp
1554 isCreation (SignatureCreationTimePacket {}) = True
1555 isCreation _ = False
1556 isExpiration (SignatureExpirationTimePacket {}) = True
1557 isExpiration _ = False
1558 (cs,ps) = partition isCreation (hashed_subpackets sig)
1559 (es,qs) = partition isExpiration ps
1560 stamp = listToMaybe . sortBy (comparing Down) $
1561 map unwrap cs where unwrap (SignatureCreationTimePacket x) = x
1562 exp = listToMaybe $ sort $
1563 map unwrap es where unwrap (SignatureExpirationTimePacket x) = x
1564 expires = liftA2 (+) stamp exp
1565 timestamp <- now
1566 if fmap ( (< timestamp) . fromIntegral) expires == Just True then do
1567 warn $ "Unable to update expired signature"
1568 return (mp,trustmap)
1569 else do
1570 let times = (:) (SignatureExpirationTimePacket (fromIntegral timestamp))
1571 $ maybeToList $ do
1572 e <- expires
1573 return $ SignatureExpirationTimePacket (e - fromIntegral timestamp)
1574 notation = NotationDataPacket
1575 { notation_name = "usage@"
1576 , notation_value = tag
1577 , human_readable = True }
1578 sig' = sig { hashed_subpackets = times ++ [notation] ++ qs }
1579 new_sig <- pgpSign (Message [wkun])
1580 (SubkeySignature wk
1581 (packet subkey_p)
1582 [sig'] )
1583 SHA1
1584 (fingerprint wk)
1585 addOrigin new_sig
1586
1587signature_time ov = case if null cs then ds else cs of
1588 [] -> minBound
1589 xs -> last (sort xs)
1590 where
1591 ps = signatures_over ov
1592 ss = filter isSignaturePacket ps
1593 cs = concatMap (concatMap creationTime . hashed_subpackets) ss
1594 ds = concatMap (concatMap creationTime . unhashed_subpackets) ss
1595 creationTime (SignatureCreationTimePacket t) = [t]
1596 creationTime _ = []
1597
1598-- We return into IO in case we want to make a signature here. 1251-- We return into IO in case we want to make a signature here.
1599setHostnames :: (SockAddr -> Bool) -> Hosts.Hosts -> KeyData -> IO KeyData 1252setHostnames :: (SockAddr -> Bool) -> Hosts.Hosts -> KeyData -> IO KeyData
1600setHostnames pred hosts kd@(KeyData topmp topsigs uids subs) = 1253setHostnames pred hosts kd@(KeyData topmp topsigs uids subs) =
@@ -2358,52 +2011,3 @@ makeTorUID g timestamp wkun keyflags topkey torkey = uid:signatures_over sig
2358 sig = fst $ torsig g topkey wkun uid timestamp keyflags 2011 sig = fst $ torsig g topkey wkun uid timestamp keyflags
2359-} 2012-}
2360 2013
2361-- torsig g topk wkun uid timestamp extras = todo
2362torSigOver topk wkun uid extras
2363 = CertificationSignature (secretToPublic topk)
2364 uid
2365 (sigpackets 0x13
2366 subpackets
2367 subpackets_unh)
2368 where
2369 subpackets = -- implicit: [ SignatureCreationTimePacket (fromIntegral timestamp) ]
2370 tsign
2371 ++ extras
2372 subpackets_unh = [IssuerPacket (fingerprint wkun)]
2373 tsign = if keykey wkun == keykey topk
2374 then [] -- tsign doesnt make sense for self-signatures
2375 else [ TrustSignaturePacket 1 120
2376 , RegularExpressionPacket regex]
2377 -- <[^>]+[@.]asdf\.nowhere>$
2378 regex = "<[^>]+[@.]"++hostname++">$"
2379 -- regex = username ++ "@" ++ hostname
2380 -- username = "[a-zA-Z0-9.][-a-zA-Z0-9.]*\\$?" :: String
2381 hostname = subdomain' pu ++ "\\." ++ topdomain' pu
2382 pu = parseUID uidstr where UserIDPacket uidstr = uid
2383 subdomain' = escape . T.unpack . uid_subdomain
2384 topdomain' = escape . T.unpack . uid_topdomain
2385 escape s = concatMap echar s
2386 where
2387 echar '|' = "\\|"
2388 echar '*' = "\\*"
2389 echar '+' = "\\+"
2390 echar '?' = "\\?"
2391 echar '.' = "\\."
2392 echar '^' = "\\^"
2393 echar '$' = "\\$"
2394 echar '\\' = "\\\\"
2395 echar '[' = "\\["
2396 echar ']' = "\\]"
2397 echar c = [c]
2398
2399sigpackets typ hashed unhashed = return $
2400 signaturePacket
2401 4 -- version
2402 typ -- 0x18 subkey binding sig, or 0x19 back-signature
2403 RSA
2404 SHA1
2405 hashed
2406 unhashed
2407 0 -- Word16 -- Left 16 bits of the signed hash value
2408 [] -- [MPI]
2409