diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 97 |
1 files changed, 63 insertions, 34 deletions
@@ -401,28 +401,39 @@ whoseKey rsakey db = filter matchkey (Map.elems db) | |||
401 | 401 | ||
402 | 402 | ||
403 | 403 | ||
404 | kiki_usage = putStr . unlines $ | 404 | kiki_usage cmd = putStr $ |
405 | {- | 405 | case cmd of |
406 | ["kiki - a pgp key editing utility" | 406 | "sync-secret" -> unlines |
407 | ,"" | 407 | ["kiki sync-secret [options...]" |
408 | ,"kiki [OPTIONS]" | 408 | ,"" |
409 | ,"" | 409 | ," sync-secret merges a set of key files into a combined database and then" |
410 | ," kiki merges a set of keyring files into a combined database and then" | 410 | ," uses the database to update all the input files, those inside and outside of" |
411 | ," uses the database to update the files so that they have the most complete" | 411 | ," of the home directory (see --homedir), to have the most complete information." |
412 | ," information." | 412 | ,"" |
413 | ,"" | 413 | ," The files pubring.gpg and subring.gpg in the directory specified by the " |
414 | ," The files pubring.gpg and subring.gpg in the directory specified by the " | 414 | ," --homedir option are implicitly included in the keyring set." |
415 | ," --homedir option are implicitly included in the keyring set." | 415 | ,"" |
416 | ,"" | 416 | ," Subkeys that are imported with kiki are given an annotation \"usage@\" which" |
417 | ," kiki can also import or export secret subkeys by using the --keypairs option." | 417 | ," indicates what the key is for. This tag can be used as a SPEC to select a" |
418 | ,"" | 418 | ," particular key. Master keys may be specified by using fingerprints or by" |
419 | ," Subkeys that are imported with kiki are given an annotation \"usage@\" which" | 419 | ," specifying a substring of an associated UID." |
420 | ," indicates what the key is for. This tag can be used as a SPEC to select a" | 420 | ] |
421 | ," particular key. Master keys may be specified by using fingerprints or by" | 421 | "import-secret" -> unlines |
422 | ," specifying a substring of an associated UID." | 422 | ["kiki import-secret [options...]" |
423 | -} | 423 | ,"" |
424 | ["kiki sync [options...]" | 424 | ," import-secret uses a set of key files to update your keyring. It does not" |
425 | ,"" | 425 | ," alter any files outside of the home directory (see --homedir)." |
426 | ,"" | ||
427 | ," The files pubring.gpg and subring.gpg in the directory specified by the " | ||
428 | ," --homedir option are implicitly included in the keyring set." | ||
429 | ,"" | ||
430 | ," Subkeys that are imported with kiki are given an annotation \"usage@\" which" | ||
431 | ," indicates what the key is for. This tag can be used as a SPEC to select a" | ||
432 | ," particular key. Master keys may be specified by using fingerprints or by" | ||
433 | ," specifying a substring of an associated UID." | ||
434 | ] | ||
435 | ++ unlines | ||
436 | ["" | ||
426 | ,"Flags:" | 437 | ,"Flags:" |
427 | ," --homedir DIR" | 438 | ," --homedir DIR" |
428 | ," Where to find the the files secring.gpg and pubring.gpg. The " | 439 | ," Where to find the the files secring.gpg and pubring.gpg. The " |
@@ -470,13 +481,13 @@ kiki_usage = putStr . unlines $ | |||
470 | ," KEYSPEC ::= SPEC=FILE{CMD} " | 481 | ," KEYSPEC ::= SPEC=FILE{CMD} " |
471 | ,"" | 482 | ,"" |
472 | ," The form of SPEC is documented below. If there is only one master" | 483 | ," The form of SPEC is documented below. If there is only one master" |
473 | ," key in your keyring and only one key is used for each purpose, then" ," it is possible for SPEC in this case to merely be a tag which offers" | 484 | ," key in your keyring and only one key is used for each purpose, then" |
485 | ," it is possible for SPEC in this case to merely be a tag which offers" | ||
474 | ," information about what this key is used for, for example, any of" | 486 | ," information about what this key is used for, for example, any of" |
475 | ," `tor', `ssh-client', `ssh-host', or `strongswan' will do." | 487 | ," `tor', `ssh-client', `ssh-host', or `strongswan' will do." |
476 | ,"" | 488 | ,"" |
477 | ," If neither SPEC or FILE match any keys, then the CMD will be " | 489 | ," If neither SPEC or FILE match any keys, then the CMD will be " |
478 | ," executed in order to create the FILE." | 490 | ," executed in order to create the FILE." |
479 | |||
480 | ,"" | 491 | ,"" |
481 | ,"Output:" | 492 | ,"Output:" |
482 | ," --show-wk Show fingerprints for the working key (which will be used to" | 493 | ," --show-wk Show fingerprints for the working key (which will be used to" |
@@ -570,8 +581,7 @@ doAutosign rt kd@(KeyData k ksigs umap submap) = ops | |||
570 | = fingerprint_material a==fingerprint_material b | 581 | = fingerprint_material a==fingerprint_material b |
571 | gs = groupBy sameMaster (sortBy (comparing code) bindings') | 582 | gs = groupBy sameMaster (sortBy (comparing code) bindings') |
572 | 583 | ||
573 | 584 | sync bModifyInput cmdarg args_raw = do | |
574 | kiki "sync" args_raw = do | ||
575 | let (args,trail1) = break (=="--") args_raw | 585 | let (args,trail1) = break (=="--") args_raw |
576 | trail = drop 1 trail1 | 586 | trail = drop 1 trail1 |
577 | (sargs,margs) = | 587 | (sargs,margs) = |
@@ -642,16 +652,22 @@ kiki "sync" args_raw = do | |||
642 | let keypairs = catMaybes keypairs0 | 652 | let keypairs = catMaybes keypairs0 |
643 | homespec = join . take 1 <$> Map.lookup "--homedir" margs | 653 | homespec = join . take 1 <$> Map.lookup "--homedir" margs |
644 | passfd = fmap (FileDesc . read) passphrase_fd | 654 | passfd = fmap (FileDesc . read) passphrase_fd |
655 | reftyp = if bModifyInput then MutableRef Nothing | ||
656 | else ConstRef | ||
645 | pems = flip map keypairs | 657 | pems = flip map keypairs |
646 | $ \(usage,path,cmd) -> | 658 | $ \(usage,path,cmd) -> |
647 | let cmd' = guard (not $ null cmd) >> return cmd | 659 | let cmd' = guard (not $ null cmd) >> return cmd |
648 | in (ArgFile path, (MutableRef cmd', PEMFile usage)) | 660 | in if bModifyInput |
649 | walts = map (\fname -> (ArgFile fname, (MutableRef Nothing, WalletFile))) | 661 | then (ArgFile path, (MutableRef cmd', PEMFile usage)) |
662 | else if isNothing cmd' | ||
663 | then (ArgFile path, (ConstRef, PEMFile usage)) | ||
664 | else error "Unexpected PEM file initializer." | ||
665 | walts = map (\fname -> (ArgFile fname, (reftyp, WalletFile))) | ||
650 | wallets | 666 | wallets |
651 | rings = map (\fname -> (ArgFile fname, (MutableRef Nothing, KeyRingFile passfd))) | 667 | rings = map (\fname -> (ArgFile fname, (reftyp, KeyRingFile passfd))) |
652 | keyrings_ | 668 | keyrings_ |
653 | hosts = maybe [] (map decorate) $ Map.lookup "--hosts" margs | 669 | hosts = maybe [] (map decorate) $ Map.lookup "--hosts" margs |
654 | where decorate fname = (ArgFile fname, (MutableRef Nothing, Hosts)) | 670 | where decorate fname = (ArgFile fname, (reftyp, Hosts)) |
655 | importStyle = maybe (\_ _ -> subkeysOnly) | 671 | importStyle = maybe (\_ _ -> subkeysOnly) |
656 | (\f rt kd -> f rt kd >> importPublic) | 672 | (\f rt kd -> f rt kd >> importPublic) |
657 | $ mplus import_f importifauth_f | 673 | $ mplus import_f importifauth_f |
@@ -674,6 +690,7 @@ kiki "sync" args_raw = do | |||
674 | , homeSpec = homespec | 690 | , homeSpec = homespec |
675 | } | 691 | } |
676 | 692 | ||
693 | (\f -> maybe f (const $ kiki_usage cmdarg) $ Map.lookup "--help" margs) $ do | ||
677 | KikiResult rt report <- runKeyRing kikiOp | 694 | KikiResult rt report <- runKeyRing kikiOp |
678 | 695 | ||
679 | case rt of | 696 | case rt of |
@@ -685,8 +702,7 @@ kiki "sync" args_raw = do | |||
685 | ,("--show-key",\[x] -> show_key x $ fromMaybe "" grip) | 702 | ,("--show-key",\[x] -> show_key x $ fromMaybe "" grip) |
686 | ,("--show-pem",\[x] -> show_pem x $ fromMaybe "" grip) | 703 | ,("--show-pem",\[x] -> show_pem x $ fromMaybe "" grip) |
687 | ,("--show-ssh",\[x] -> show_ssh x $ fromMaybe "" grip) | 704 | ,("--show-ssh",\[x] -> show_ssh x $ fromMaybe "" grip) |
688 | ,("--show-wip",\[x] -> show_wip x $ fromMaybe "" grip) | 705 | ,("--show-wip",\[x] -> show_wip x $ fromMaybe "" grip)] |
689 | ,("--help", \_ _ ->kiki_usage)] | ||
690 | shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs | 706 | shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs |
691 | 707 | ||
692 | forM_ shargs $ \(cmd,args) -> cmd args (rtKeyDB rt) | 708 | forM_ shargs $ \(cmd,args) -> cmd args (rtKeyDB rt) |
@@ -695,8 +711,20 @@ kiki "sync" args_raw = do | |||
695 | forM_ report $ \(fname,act) -> do | 711 | forM_ report $ \(fname,act) -> do |
696 | putStrLn $ fname ++ ": " ++ reportString act | 712 | putStrLn $ fname ++ ": " ++ reportString act |
697 | 713 | ||
714 | kiki "sync-secret" args_raw = | ||
715 | sync True "sync-secret" args_raw | ||
716 | |||
717 | kiki "import-secret" args_raw = | ||
718 | sync False "import-secret" args_raw | ||
719 | |||
698 | kiki "working-key" args = do | 720 | kiki "working-key" args = do |
699 | kiki "sync" ["--show-wk"] | 721 | if "--help" `notElem` args |
722 | then sync False "working-key" ["--show-wk"] | ||
723 | else putStrLn $ | ||
724 | unlines ["working-key" | ||
725 | ,"" | ||
726 | ," Displays the master key with its subkeys that will be" | ||
727 | ," used for making signatures"] | ||
700 | 728 | ||
701 | kiki "help" args = do | 729 | kiki "help" args = do |
702 | putStrLn "Valid commands are:" | 730 | putStrLn "Valid commands are:" |
@@ -709,7 +737,8 @@ kiki "help" args = do | |||
709 | commands :: [(String,String)] | 737 | commands :: [(String,String)] |
710 | commands = | 738 | commands = |
711 | [ ( "help", "display usage information" ) | 739 | [ ( "help", "display usage information" ) |
712 | , ( "sync", "update key files of various kinds by propogating information" ) | 740 | , ( "sync-secret", "update key files of various kinds by propogating information" ) |
741 | , ( "import-secret", "import (both public and secret) information into your keyring" ) | ||
713 | , ( "working-key", "show the current working master key and its subkeys" ) | 742 | , ( "working-key", "show the current working master key and its subkeys" ) |
714 | ] | 743 | ] |
715 | 744 | ||