diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 97 |
1 files changed, 58 insertions, 39 deletions
@@ -1286,7 +1286,7 @@ kiki "show" args = do | |||
1286 | 1286 | ||
1287 | kiki "merge" [] = do | 1287 | kiki "merge" [] = do |
1288 | putStr . unlines $ | 1288 | putStr . unlines $ |
1289 | [ "kiki merge [ --passphrase-fd=FD ... ]" | 1289 | [ "kiki merge [ ( --passphrase-fd=FD | --agent | --show-key=SPEC ) ... ]" |
1290 | , " ( --home[=HOMEDIR]" | 1290 | , " ( --home[=HOMEDIR]" |
1291 | , " | --type=(keyring|pem|wallet|hosts|dns)" | 1291 | , " | --type=(keyring|pem|wallet|hosts|dns)" |
1292 | , " | --access=[auto|secret|public]" | 1292 | , " | --access=[auto|secret|public]" |
@@ -1306,6 +1306,9 @@ kiki "merge" [] = do | |||
1306 | , "" | 1306 | , "" |
1307 | , " --agent Use gpg-agent." | 1307 | , " --agent Use gpg-agent." |
1308 | , "" | 1308 | , "" |
1309 | , " --show-key=SPEC After files have been written, show information for the" | ||
1310 | , " key identified by SPEC." | ||
1311 | , "" | ||
1309 | , " FILE A path to a key file to read or update." | 1312 | , " FILE A path to a key file to read or update." |
1310 | , "" | 1313 | , "" |
1311 | , "MODIFIERS" | 1314 | , "MODIFIERS" |
@@ -1335,12 +1338,14 @@ kiki "merge" args = do | |||
1335 | hPutStrLn stderr $ ppShow op | 1338 | hPutStrLn stderr $ ppShow op |
1336 | KikiResult rt report <- runKeyRing (mbAgent op) | 1339 | KikiResult rt report <- runKeyRing (mbAgent op) |
1337 | case rt of | 1340 | case rt of |
1338 | KikiSuccess rt -> return () | 1341 | KikiSuccess rt -> do let db = rtKeyDB rt |
1342 | forM_ keyspecs $ \keyspec -> do | ||
1343 | show_id keyspec (error "show_id wkgrip") db | ||
1339 | err -> putStrLn $ errorString err | 1344 | err -> putStrLn $ errorString err |
1340 | forM_ report $ \(fname,act) -> do | 1345 | forM_ report $ \(fname,act) -> do |
1341 | putStrLn $ fname ++ ": " ++ reportString act | 1346 | putStrLn $ fname ++ ": " ++ reportString act |
1342 | where | 1347 | where |
1343 | (_,(_,op)) = foldl' buildOp (True,(flow0,noop)) args' | 1348 | (_,((_,keyspecs),op)) = foldl' buildOp (True,((flow0,[]),noop)) args' |
1344 | (args',mbAgent) = case break (=="--agent") args of | 1349 | (args',mbAgent) = case break (=="--agent") args of |
1345 | (as,[]) -> (args, id) | 1350 | (as,[]) -> (args, id) |
1346 | (as,_:bs) -> ( as++bs | 1351 | (as,_:bs) -> ( as++bs |
@@ -1395,29 +1400,37 @@ kiki "merge" args = do | |||
1395 | m <- filter ("match=" `isPrefixOf`) goods | 1400 | m <- filter ("match=" `isPrefixOf`) goods |
1396 | return $ drop 6 m | 1401 | return $ drop 6 m |
1397 | 1402 | ||
1398 | doFile :: StreamInfo -> KeyRingOperation -> FilePath -> (StreamInfo,KeyRingOperation) | 1403 | doFile :: (StreamInfo,[String]) -> KeyRingOperation |
1399 | doFile flow op fname = | 1404 | -> FilePath |
1400 | ( flow0 { typ = typ flow } -- everything resets except for --type | 1405 | -> ((StreamInfo,[String]),KeyRingOperation) |
1406 | doFile (flow,specs) op fname = | ||
1407 | ( (,) flow0 { typ = typ flow } specs -- everything resets except for --type | ||
1401 | , op { opFiles= Map.insert (ArgFile fname) flow (opFiles op) }) | 1408 | , op { opFiles= Map.insert (ArgFile fname) flow (opFiles op) }) |
1402 | 1409 | ||
1403 | doDelete :: String -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation) | 1410 | doDelete :: String -> (StreamInfo,[String]) -> KeyRingOperation -> ((StreamInfo,[String]),KeyRingOperation) |
1404 | doDelete fp flow op = ( flow | 1411 | doDelete fp flow op = ( flow |
1405 | , op { opTransforms = opTransforms op ++ [DeleteSubkeyByFingerprint fp] } ) | 1412 | , op { opTransforms = opTransforms op ++ [DeleteSubkeyByFingerprint fp] } ) |
1406 | 1413 | ||
1407 | doDeleteUsage :: String -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation) | 1414 | doDeleteUsage :: String -> (StreamInfo,[String]) |
1415 | -> KeyRingOperation | ||
1416 | -> ((StreamInfo,[String]),KeyRingOperation) | ||
1408 | doDeleteUsage tag flow op = ( flow | 1417 | doDeleteUsage tag flow op = ( flow |
1409 | , op { opTransforms = opTransforms op ++ [DeleteSubkeyByUsage tag] } ) | 1418 | , op { opTransforms = opTransforms op ++ [DeleteSubkeyByUsage tag] } ) |
1410 | 1419 | ||
1411 | doAutosign :: Bool -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation) | 1420 | doAutosign :: Bool -> (StreamInfo,[String]) |
1412 | doAutosign True flow op = | 1421 | -> KeyRingOperation |
1422 | -> ((StreamInfo,[String]),KeyRingOperation) | ||
1423 | doAutosign True (flow,specs) op = | ||
1413 | if Map.null (opFiles op) | 1424 | if Map.null (opFiles op) |
1414 | then (flow, op { opTransforms = opTransforms op ++ [Autosign] }) | 1425 | then ((,) flow specs, op { opTransforms = opTransforms op ++ [Autosign] }) |
1415 | else (flow { transforms = transforms flow ++ [Autosign] }, op) | 1426 | else ((,) flow { transforms = transforms flow ++ [Autosign] } specs, op) |
1416 | doAutosign False flow op = | 1427 | doAutosign False (flow,specs) op = |
1417 | ( flow { transforms = filter (/=Autosign) (transforms flow) } | 1428 | ( (,) flow { transforms = filter (/=Autosign) (transforms flow) } specs |
1418 | , op { opTransforms = filter (/=Autosign) (opTransforms op) } ) | 1429 | , op { opTransforms = filter (/=Autosign) (opTransforms op) } ) |
1419 | 1430 | ||
1420 | doPassphrase :: StreamInfo -> KeyRingOperation -> String -> (StreamInfo,KeyRingOperation) | 1431 | doPassphrase :: (StreamInfo,[String]) -> KeyRingOperation |
1432 | -> String | ||
1433 | -> ((StreamInfo,[String]),KeyRingOperation) | ||
1421 | doPassphrase flow op pass = | 1434 | doPassphrase flow op pass = |
1422 | if Map.null (opFiles op) | 1435 | if Map.null (opFiles op) |
1423 | then ( flow | 1436 | then ( flow |
@@ -1427,8 +1440,11 @@ kiki "merge" args = do | |||
1427 | where | 1440 | where |
1428 | pfd = FileDesc (read pass) | 1441 | pfd = FileDesc (read pass) |
1429 | 1442 | ||
1443 | buildOp :: (Bool,((StreamInfo,[String]),KeyRingOperation)) | ||
1444 | -> String | ||
1445 | -> (Bool,((StreamInfo,[String]),KeyRingOperation)) | ||
1430 | buildOp (False,(flow,op)) fname = (False,doFile flow op fname) | 1446 | buildOp (False,(flow,op)) fname = (False,doFile flow op fname) |
1431 | buildOp (True,(flow,op)) arg@(splitArg->parsed) = | 1447 | buildOp (True,(flow@(si,specs),op)) arg@(splitArg->parsed) = |
1432 | case parsed of | 1448 | case parsed of |
1433 | Left ("",Nothing) -> (False,(flow,op)) | 1449 | Left ("",Nothing) -> (False,(flow,op)) |
1434 | _ -> (True,) dispatch | 1450 | _ -> (True,) dispatch |
@@ -1447,37 +1463,38 @@ kiki "merge" args = do | |||
1447 | Left ("autosign",Just "false")-> doAutosign False flow op | 1463 | Left ("autosign",Just "false")-> doAutosign False flow op |
1448 | Left ("passphrase-fd",Just pass) -> doPassphrase flow op pass | 1464 | Left ("passphrase-fd",Just pass) -> doPassphrase flow op pass |
1449 | Left ("create",Nothing) -> | 1465 | Left ("create",Nothing) -> |
1450 | ( flow { initializer = Internal (GenRSA (4096 `div` 8)) } | 1466 | ( (,) si { initializer = Internal (GenRSA (4096 `div` 8)) } specs |
1451 | , op ) | 1467 | , op ) |
1452 | Left ("create",Just cmd) | 1468 | Left ("create",Just cmd) |
1453 | | "cmd:" `isPrefixOf` cmd | 1469 | | "cmd:" `isPrefixOf` cmd |
1454 | -> ( flow { initializer = case drop 4 cmd of | 1470 | -> ( (,) si { initializer = case drop 4 cmd of |
1455 | [] -> NoCreate | 1471 | [] -> NoCreate |
1456 | extern -> External extern } | 1472 | extern -> External extern } specs |
1457 | , op ) | 1473 | , op ) |
1458 | Left ("create",Just cmd) | 1474 | Left ("create",Just cmd) |
1459 | | "rsa:" `isPrefixOf` cmd | 1475 | | "rsa:" `isPrefixOf` cmd |
1460 | -> ( flow { initializer = case drop 4 cmd of | 1476 | -> ( (,) si { initializer = case drop 4 cmd of |
1461 | [] -> NoCreate | 1477 | [] -> NoCreate |
1462 | bits -> | 1478 | bits -> |
1463 | case takeWhile isDigit bits of | 1479 | case takeWhile isDigit bits of |
1464 | [] -> NoCreate | 1480 | [] -> NoCreate |
1465 | digits -> Internal (GenRSA (read digits `div` 8)) } | 1481 | digits -> Internal (GenRSA (read digits `div` 8)) } |
1482 | specs | ||
1466 | , op ) | 1483 | , op ) |
1467 | Left ("type",Just "keyring") -> ( flow { typ = KeyRingFile } , op ) | 1484 | Left ("type",Just "keyring") -> ( (,) si { typ = KeyRingFile } specs, op ) |
1468 | Left ("type",Just "pem" ) -> ( flow { typ = PEMFile } , op ) | 1485 | Left ("type",Just "pem" ) -> ( (,) si { typ = PEMFile } specs, op ) |
1469 | Left ("type",Just "wallet" ) -> ( flow { typ = WalletFile } , op ) | 1486 | Left ("type",Just "wallet" ) -> ( (,) si { typ = WalletFile } specs, op ) |
1470 | Left ("type",Just "hosts" ) -> ( flow { typ = Hosts } , op ) | 1487 | Left ("type",Just "hosts" ) -> ( (,) si { typ = Hosts } specs, op ) |
1471 | Left ("type",Just "dns" ) -> ( flow { typ = DNSPresentation } , op ) | 1488 | Left ("type",Just "dns" ) -> ( (,) si { typ = DNSPresentation } specs, op ) |
1472 | Left ("access",Just "public") -> ( flow { access = Pub }, op ) | 1489 | Left ("access",Just "public") -> ( (,) si { access = Pub } specs, op ) |
1473 | Left ("access",Just "secret") -> ( flow { access = Sec }, op ) | 1490 | Left ("access",Just "secret") -> ( (,) si { access = Sec } specs, op ) |
1474 | Left ("access",Just "auto") -> ( flow { access = AutoAccess }, op ) | 1491 | Left ("access",Just "auto") -> ( (,) si { access = AutoAccess } specs, op ) |
1475 | Left ("home",mb) -> | 1492 | Left ("home",mb) -> |
1476 | ( flow | 1493 | ( flow |
1477 | , op { opFiles = Map.insert HomePub (flow { typ=KeyRingFile | 1494 | , op { opFiles = Map.insert HomePub (si { typ=KeyRingFile |
1478 | , access=Pub }) | 1495 | , access=Pub }) |
1479 | $ Map.insert HomeSec (flow { typ=KeyRingFile | 1496 | $ Map.insert HomeSec (si { typ=KeyRingFile |
1480 | , access=Sec }) | 1497 | , access=Sec }) |
1481 | $ opFiles op | 1498 | $ opFiles op |
1482 | , opHome = opHome op `mplus` mb | 1499 | , opHome = opHome op `mplus` mb |
1483 | } | 1500 | } |
@@ -1485,9 +1502,11 @@ kiki "merge" args = do | |||
1485 | Left ("flow",Just flowspec) -> | 1502 | Left ("flow",Just flowspec) -> |
1486 | case parseFlow flowspec of | 1503 | case parseFlow flowspec of |
1487 | Just ( (spil,fil), mtch ) -> | 1504 | Just ( (spil,fil), mtch ) -> |
1488 | ( updateFlow fil spil mtch flow | 1505 | ( (,) (updateFlow fil spil mtch si) specs |
1489 | , op ) | 1506 | , op ) |
1490 | Nothing -> error "Valid flow words are: spill,fill,sync,signed,subkeys or match=KEYSPEC" | 1507 | Nothing -> error "Valid flow words are: spill,fill,sync,signed,subkeys or match=KEYSPEC" |
1508 | Left ("show-key",Just keyspec) -> ( (,) si (keyspec:specs) | ||
1509 | , op ) | ||
1491 | Left (option,_) -> error $ "Unrecognized option: " ++ option | 1510 | Left (option,_) -> error $ "Unrecognized option: " ++ option |
1492 | 1511 | ||
1493 | kiki "init" args | "--help" `elem` args = do | 1512 | kiki "init" args | "--help" `elem` args = do |
@@ -1718,7 +1737,7 @@ tarC (sargs,margs) = do | |||
1718 | -- | 1737 | -- |
1719 | -- single leading hyphen, quits program with "Unrecognized option" error | 1738 | -- single leading hyphen, quits program with "Unrecognized option" error |
1720 | -- | 1739 | -- |
1721 | -- Otherwise, Left (key-value pair) is returend by parsing | 1740 | -- Otherwise, Left (key-value pair) is returned by parsing |
1722 | -- a string of the form --key=value. | 1741 | -- a string of the form --key=value. |
1723 | splitArg :: String -> Either (String,Maybe String) String | 1742 | splitArg :: String -> Either (String,Maybe String) String |
1724 | splitArg arg = | 1743 | splitArg arg = |