diff options
-rw-r--r-- | KeyRing.hs | 16 | ||||
-rw-r--r-- | kiki.hs | 20 |
2 files changed, 29 insertions, 7 deletions
@@ -1360,11 +1360,13 @@ performManipulations doDecrypt operation rt wk = do | |||
1360 | flip (maybe $ return NoWorkingKey) wk $ \wk' -> do | 1360 | flip (maybe $ return NoWorkingKey) wk $ \wk' -> do |
1361 | wkun' <- doDecrypt wk' | 1361 | wkun' <- doDecrypt wk' |
1362 | try wkun' $ \wkun -> do | 1362 | try wkun' $ \wkun -> do |
1363 | let sigOver = makeInducerSig (keyPacket kd) wkun (UserIDPacket uid) subpaks | 1363 | let flgs = if keykey (keyPacket kd) == keykey wkun |
1364 | sigr <- pgpSign (Message [wkun]) sigOver SHA1 (fingerprint wkun) | 1364 | then keyFlags0 (keyPacket kd) (map (\(x,_,_)->x) selfsigs) |
1365 | let f ::([SigAndTrust],OriginMap) -> ([SigAndTrust],OriginMap) | 1365 | else [] |
1366 | f x = ( map ( (,Map.empty) . toMappedPacket om) (additional sigr) ++ fst x | 1366 | sigOver = makeInducerSig (keyPacket kd) |
1367 | , om `Map.union` snd x ) | 1367 | wkun |
1368 | (UserIDPacket uid) | ||
1369 | $ flgs ++ subpaks | ||
1368 | om = Map.singleton "--autosign" (origin p (-1)) where p = UserIDPacket uid | 1370 | om = Map.singleton "--autosign" (origin p (-1)) where p = UserIDPacket uid |
1369 | toMappedPacket om p = (mappedPacket "" p) {locations=om} | 1371 | toMappedPacket om p = (mappedPacket "" p) {locations=om} |
1370 | selfsigs = filter (\(sig,v,whosign) -> isJust (v >> Just wkun >>= guard | 1372 | selfsigs = filter (\(sig,v,whosign) -> isJust (v >> Just wkun >>= guard |
@@ -1388,6 +1390,10 @@ performManipulations doDecrypt operation rt wk = do | |||
1388 | new_sig <- maybeToList new_sig | 1390 | new_sig <- maybeToList new_sig |
1389 | guard (null $ selfsigs) | 1391 | guard (null $ selfsigs) |
1390 | signatures_over new_sig | 1392 | signatures_over new_sig |
1393 | sigr <- pgpSign (Message [wkun]) sigOver SHA1 (fingerprint wkun) | ||
1394 | let f ::([SigAndTrust],OriginMap) -> ([SigAndTrust],OriginMap) | ||
1395 | f x = ( map ( (,Map.empty) . toMappedPacket om) (additional sigr) ++ fst x | ||
1396 | , om `Map.union` snd x ) | ||
1391 | return $ KikiSuccess $ kd { rentryUids = Map.adjust f uid (rentryUids kd) } | 1397 | return $ KikiSuccess $ kd { rentryUids = Map.adjust f uid (rentryUids kd) } |
1392 | 1398 | ||
1393 | initializeMissingPEMFiles :: | 1399 | initializeMissingPEMFiles :: |
@@ -1157,7 +1157,7 @@ main = do | |||
1157 | ++ hosts | 1157 | ++ hosts |
1158 | , kImports = Map.fromList $ | 1158 | , kImports = Map.fromList $ |
1159 | [ ( HomePub, importStyle ) ] | 1159 | [ ( HomePub, importStyle ) ] |
1160 | , kManip = noManip | 1160 | , kManip = maybe noManip (const doAutosign) $ Map.lookup "--autosign" margs |
1161 | , homeSpec = homespec | 1161 | , homeSpec = homespec |
1162 | } | 1162 | } |
1163 | 1163 | ||
@@ -1183,6 +1183,22 @@ main = do | |||
1183 | return() | 1183 | return() |
1184 | where | 1184 | where |
1185 | 1185 | ||
1186 | doAutosign rt kd@(KeyData k ksigs umap submap) = ops | ||
1187 | where | ||
1188 | ops = map (\u -> InducerSignature u []) us | ||
1189 | us = filter torStyle $ Map.keys umap | ||
1190 | torbindings = getTorKeys (map packet $ flattenTop "" True kd) | ||
1191 | torStyle str = and [ uid_topdomain parsed == "onion" | ||
1192 | , uid_realname parsed `elem` ["","Anonymous"] | ||
1193 | , uid_user parsed == "root" | ||
1194 | , fmap (match . fst) (lookup (packet k) torbindings) | ||
1195 | == Just True ] | ||
1196 | where parsed = parseUID str | ||
1197 | match = ( (==subdom) . take (fromIntegral len)) | ||
1198 | subdom0 = L.fromChunks [encodeUtf8 (uid_subdomain parsed)] | ||
1199 | subdom = Char8.unpack subdom0 | ||
1200 | len = T.length (uid_subdomain parsed) | ||
1201 | |||
1186 | getTorKeys pub = do | 1202 | getTorKeys pub = do |
1187 | xs <- groupBindings pub | 1203 | xs <- groupBindings pub |
1188 | (_,(top,sub),us,_,_) <- xs | 1204 | (_,(top,sub),us,_,_) <- xs |
@@ -1244,7 +1260,7 @@ main = do | |||
1244 | o <- overs sig | 1260 | o <- overs sig |
1245 | k <- keys | 1261 | k <- keys |
1246 | let ov = verify (Message [k]) $ o | 1262 | let ov = verify (Message [k]) $ o |
1247 | signatures_over ov | 1263 | take 1 $ signatures_over ov |
1248 | return (sig,Just ov,k) | 1264 | return (sig,Just ov,k) |
1249 | selfsigs = filter (\(sig,v,whosign) -> isJust (v >> selfkey >>= guard | 1265 | selfsigs = filter (\(sig,v,whosign) -> isJust (v >> selfkey >>= guard |
1250 | . (== keykey whosign) | 1266 | . (== keykey whosign) |