summaryrefslogtreecommitdiff
path: root/kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'kiki.hs')
-rw-r--r--kiki.hs81
1 files changed, 25 insertions, 56 deletions
diff --git a/kiki.hs b/kiki.hs
index 96138c4..c29076a 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -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