diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 81 |
1 files changed, 25 insertions, 56 deletions
@@ -1238,66 +1238,23 @@ main = do | |||
1238 | putStrLn $ "keyrings = "++show keyrings | 1238 | putStrLn $ "keyrings = "++show keyrings |
1239 | -} | 1239 | -} |
1240 | 1240 | ||
1241 | let homespec = join . take 1 <$> Map.lookup "--homedir" margs | 1241 | let auto_sign_feature rt = do |
1242 | todo | 1242 | use_db <- |
1243 | $ \(secfile,grip) db pubring -> do | 1243 | flip (maybe $ return (rtKeyDB rt)) |
1244 | |||
1245 | use_db0 <- return db | ||
1246 | |||
1247 | let pkeypairs = maybe [] id $ do | ||
1248 | keygrip <- grip | ||
1249 | return $ map (\(spec,f,cmd)-> (parseSpec keygrip spec,f,cmd)) keypairs | ||
1250 | fs <- forM pkeypairs $ \((topspec,subspec),f,cmd) -> do | ||
1251 | -- Note that it's important to discard the KeyData objects | ||
1252 | -- returned by filterMatches and retain only the keys. | ||
1253 | -- Otherwise, the iterations within the foldM would not be | ||
1254 | -- able to alter them by returning a modified KeyDB. | ||
1255 | let ms = map fst $ filterMatches topspec (Map.toList db) | ||
1256 | f_found <- doesFileExist f | ||
1257 | return (f_found,(f,subspec,ms,cmd)) | ||
1258 | |||
1259 | |||
1260 | let (imports,exports) = partition fst fs | ||
1261 | -- use_db <- foldM (doImport decrypt) use_db0 (map snd imports) | ||
1262 | |||
1263 | let use_db = todo | ||
1264 | |||
1265 | let (btcs,_) = partition isSupportedBTC btcpairs | ||
1266 | isSupportedBTC (spec,"base58",cnt) = True | ||
1267 | isSupportedBTC _ = False | ||
1268 | dblist = Map.toList use_db | ||
1269 | pbtcs = maybe [] id $ do | ||
1270 | keygrip <- grip | ||
1271 | let conv (spec,proto,cnt) = | ||
1272 | let (topspec,subspec) = parseSpec keygrip spec | ||
1273 | ms = map fst $ filterMatches topspec dblist | ||
1274 | in (ms,subspec,cnt) | ||
1275 | return $ map conv btcs | ||
1276 | |||
1277 | -- use_db <- foldM (doBTCImport decrypt) use_db pbtcs | ||
1278 | |||
1279 | -- (ret_db,_) <- foldM (doExport decrypt) (use_db,use_db) (map snd exports) | ||
1280 | |||
1281 | use_db <- | ||
1282 | flip (maybe $ return use_db) | ||
1283 | (lookup "--autosign" $ map (\(x:xs)->(x,xs)) sargs) | 1244 | (lookup "--autosign" $ map (\(x:xs)->(x,xs)) sargs) |
1284 | $ \_ -> do | 1245 | $ \_ -> do |
1285 | let keys = map keyPacket $ Map.elems use_db | 1246 | let keys = map keyPacket $ Map.elems (rtKeyDB rt) |
1286 | wk = workingKey grip use_db | 1247 | wk = workingKey (rtGrip rt) (rtKeyDB rt) |
1287 | -- g <- newGenIO | 1248 | -- g <- newGenIO |
1288 | -- stamp <- now | 1249 | -- stamp <- now |
1289 | wkun <- flip (maybe $ return Nothing) wk $ \wk -> do | 1250 | wkun <- flip (maybe $ return Nothing) wk $ \wk -> do |
1290 | wkun <- decrypt wk | 1251 | wkun <- decrypt wk |
1291 | maybe (error $ "Bad passphrase?") (return . Just) wkun | 1252 | maybe (error $ "Bad passphrase?") (return . Just) wkun |
1292 | -- return . snd $ Map.mapAccum (signTorIds stamp wkun keys) g use_db | 1253 | -- return . snd $ Map.mapAccum (signTorIds stamp wkun keys) g use_db |
1293 | Traversable.mapM (signTorIds wkun keys) use_db | 1254 | Traversable.mapM (signTorIds wkun keys) (rtKeyDB rt) |
1294 | 1255 | return use_db | |
1295 | use_db <- markForImport margs grip pubring use_db | ||
1296 | |||
1297 | ret_db <- return use_db | ||
1298 | 1256 | ||
1299 | ret_db <- do | 1257 | let doHostNames db = do |
1300 | let db = ret_db | ||
1301 | let hns = maybe [] id $ Map.lookup "--hosts" margs | 1258 | let hns = maybe [] id $ Map.lookup "--hosts" margs |
1302 | hostdbs0 <- mapM (fmap Hosts.decode . L.readFile) hns | 1259 | hostdbs0 <- mapM (fmap Hosts.decode . L.readFile) hns |
1303 | 1260 | ||
@@ -1366,9 +1323,22 @@ main = do | |||
1366 | 1323 | ||
1367 | return db' | 1324 | return db' |
1368 | 1325 | ||
1369 | do | 1326 | let homespec = join . take 1 <$> Map.lookup "--homedir" margs |
1370 | -- On last pass, interpret --show-* commands. | 1327 | kikiOp = KeyRingData |
1371 | let shspec = Map.fromList [("--show-wk", const $ show_wk secfile grip) | 1328 | { kFiles = Map.fromList |
1329 | [ ( HomeSec, (ConstRef, KeyRingFile (FileDesc 8)) ) | ||
1330 | , ( HomePub, (ConstRef, KeyRingFile (FileDesc 8)) ) | ||
1331 | ] | ||
1332 | , kImports = Map.empty | ||
1333 | , homeSpec = homespec | ||
1334 | } | ||
1335 | |||
1336 | rt <- runKeyRing kikiOp | ||
1337 | |||
1338 | case rt of | ||
1339 | KikiResult (KikiSuccess rt) _ -> do -- interpret --show-* commands. | ||
1340 | let grip = rtGrip rt | ||
1341 | let shspec = Map.fromList [("--show-wk", const $ show_wk (rtSecring rt) grip) | ||
1372 | ,("--show-all",const $ show_all) | 1342 | ,("--show-all",const $ show_all) |
1373 | ,("--show-whose-key", const $ show_whose_key input_key) | 1343 | ,("--show-whose-key", const $ show_whose_key input_key) |
1374 | ,("--show-key",\[x] -> show_key x $ maybe "" id grip) | 1344 | ,("--show-key",\[x] -> show_key x $ maybe "" id grip) |
@@ -1378,8 +1348,7 @@ main = do | |||
1378 | ,("--help", \_ _ ->kiki_usage)] | 1348 | ,("--help", \_ _ ->kiki_usage)] |
1379 | shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs | 1349 | shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs |
1380 | 1350 | ||
1381 | forM_ shargs $ \(cmd,args) -> cmd args use_db | 1351 | forM_ shargs $ \(cmd,args) -> cmd args (rtKeyDB rt) |
1382 | return ret_db | ||
1383 | 1352 | ||
1384 | return() | 1353 | return() |
1385 | where | 1354 | where |