summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--kiki.hs26
1 files changed, 17 insertions, 9 deletions
diff --git a/kiki.hs b/kiki.hs
index c616445..034f58d 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -1104,12 +1104,9 @@ main = do
1104 where 1104 where
1105 w0:ws = pub 1105 w0:ws = pub
1106 1106
1107 signSelfAuthTorKeys pw g sec grip timestamp xs = ys 1107 signSelfAuthTorKeys selfkey g sec grip timestamp xs = ys
1108 where 1108 where
1109 keys = filter isKey sec 1109 keys = filter isKey sec
1110 selfkey = find_key fingerprint (Message keys) (fromJust grip) >>= decryptKey
1111 where
1112 decryptKey k = decryptSecretKey pw k
1113 mainpubkey = fst (head xs) 1110 mainpubkey = fst (head xs)
1114 uid:xs' = map snd xs 1111 uid:xs' = map snd xs
1115 (sigs, xs'') = span isSignaturePacket xs' 1112 (sigs, xs'') = span isSignaturePacket xs'
@@ -1184,8 +1181,16 @@ main = do
1184 , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg 1181 , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg
1185 , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321" 1182 , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321"
1186 ) <- getPGPEnviron cmd 1183 ) <- getPGPEnviron cmd
1187 S8.putStrLn $ "pasphrase_fd = " <> S8.pack (show (passphrase_fd cmd)) 1184 flip (maybe (error "No working key?")) grip $ \grip -> do
1188 pw <- getPassphrase cmd 1185 pw <- getPassphrase cmd
1186 let (pre, wk:subs) = seek_key (KeyGrip grip) sec
1187 wkun = if symmetric_algorithm wk == Unencrypted
1188 then Just wk
1189 else do
1190 k <- decryptSecretKey pw wk
1191 guard (symmetric_algorithm k == Unencrypted)
1192 return k
1193 flip (maybe (error "Bad passphrase?")) wkun$ \wkun -> do
1189 -- putStrLn $ "getPGPEnviron -> " ++ show (homedir,length sec,grip) 1194 -- putStrLn $ "getPGPEnviron -> " ++ show (homedir,length sec,grip)
1190 (Message pub) <- readPacketsFromFile (input cmd) 1195 (Message pub) <- readPacketsFromFile (input cmd)
1191 putStrLn $ listKeys pub 1196 putStrLn $ listKeys pub
@@ -1215,7 +1220,7 @@ main = do
1215 -- timestamp <- epochTime 1220 -- timestamp <- epochTime
1216 let xs:xss = groupBy (\_ (b,_)->not b) marked 1221 let xs:xss = groupBy (\_ (b,_)->not b) marked
1217 pub' = map (snd . cleanup) xs 1222 pub' = map (snd . cleanup) xs
1218 ++ concatMap (signSelfAuthTorKeys pw (g::SystemRandom) sec grip timestamp) 1223 ++ concatMap (signSelfAuthTorKeys (Just wkun) (g::SystemRandom) sec grip timestamp)
1219 (map (map cleanup) xss) 1224 (map (map cleanup) xss)
1220 cleanup (_,(topkey,_,pkt)) = (topkey,pkt) 1225 cleanup (_,(topkey,_,pkt)) = (topkey,pkt)
1221 putStrLn $ "-------- signed ------> " -- ++ show (length pub, length pub') 1226 putStrLn $ "-------- signed ------> " -- ++ show (length pub, length pub')
@@ -1656,11 +1661,14 @@ torsig g topk wkun uid timestamp extras
1656 timestamp 1661 timestamp
1657 g 1662 g
1658 where 1663 where
1659 subpackets = [ SignatureCreationTimePacket (fromIntegral timestamp) 1664 subpackets = [ SignatureCreationTimePacket (fromIntegral timestamp) ]
1660 , TrustSignaturePacket 1 60 1665 ++ tsign
1661 , RegularExpressionPacket regex]
1662 ++ extras 1666 ++ extras
1663 subpackets_unh = [IssuerPacket (fingerprint wkun)] 1667 subpackets_unh = [IssuerPacket (fingerprint wkun)]
1668 tsign = if keykey wkun == keykey topk
1669 then [] -- tsign doesnt make sense for self-signatures
1670 else [ TrustSignaturePacket 1 120
1671 , RegularExpressionPacket regex]
1664 -- <[^>]+[@.]asdf\.nowhere>$ 1672 -- <[^>]+[@.]asdf\.nowhere>$
1665 regex = "<[^>]+[@.]"++hostname++">$" 1673 regex = "<[^>]+[@.]"++hostname++">$"
1666 -- regex = username ++ "@" ++ hostname 1674 -- regex = username ++ "@" ++ hostname