summaryrefslogtreecommitdiff
path: root/kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'kiki.hs')
-rw-r--r--kiki.hs111
1 files changed, 75 insertions, 36 deletions
diff --git a/kiki.hs b/kiki.hs
index 211b0a4..b7092dc 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -459,28 +459,39 @@ whoseKey rsakey db = filter matchkey (Map.elems db)
459 459
460 460
461 461
462kiki_sync_help = putStr . unlines $ 462kiki_usage cmd = putStr $
463 {- 463 case cmd of
464 ["kiki - a pgp key editing utility" 464 "sync-secret" -> unlines
465 ,"" 465 ["kiki sync-secret [options...]"
466 ,"kiki [OPTIONS]" 466 ,""
467 ,"" 467 ," sync-secret merges a set of key files into a combined database and then"
468 ," kiki merges a set of keyring files into a combined database and then" 468 ," uses the database to update all the input files, those inside and outside of"
469 ," uses the database to update the files so that they have the most complete" 469 ," of the home directory (see --homedir), to have the most complete information."
470 ," information." 470 ,""
471 ,"" 471 ," The files pubring.gpg and subring.gpg in the directory specified by the "
472 ," The files pubring.gpg and subring.gpg in the directory specified by the " 472 ," --homedir option are implicitly included in the keyring set."
473 ," --homedir option are implicitly included in the keyring set." 473 ,""
474 ,"" 474 ," Subkeys that are imported with kiki are given an annotation \"usage@\" which"
475 ," kiki can also import or export secret subkeys by using the --keypairs option." 475 ," indicates what the key is for. This tag can be used as a SPEC to select a"
476 ,"" 476 ," particular key. Master keys may be specified by using fingerprints or by"
477 ," Subkeys that are imported with kiki are given an annotation \"usage@\" which" 477 ," specifying a substring of an associated UID."
478 ," indicates what the key is for. This tag can be used as a SPEC to select a" 478 ]
479 ," particular key. Master keys may be specified by using fingerprints or by" 479 "import-secret" -> unlines
480 ," specifying a substring of an associated UID." 480 ["kiki import-secret [options...]"
481 -} 481 ,""
482 ["kiki sync [options...]" 482 ," import-secret uses a set of key files to update your keyring. It does not"
483 ,"" 483 ," alter any files outside of the home directory (see --homedir)."
484 ,""
485 ," The files pubring.gpg and subring.gpg in the directory specified by the "
486 ," --homedir option are implicitly included in the keyring set."
487 ,""
488 ," Subkeys that are imported with kiki are given an annotation \"usage@\" which"
489 ," indicates what the key is for. This tag can be used as a SPEC to select a"
490 ," particular key. Master keys may be specified by using fingerprints or by"
491 ," specifying a substring of an associated UID."
492 ]
493 ++ unlines
494 [""
484 ,"Flags:" 495 ,"Flags:"
485 ," --homedir DIR" 496 ," --homedir DIR"
486 ," Where to find the the files secring.gpg and pubring.gpg. The " 497 ," Where to find the the files secring.gpg and pubring.gpg. The "
@@ -535,7 +546,6 @@ kiki_sync_help = putStr . unlines $
535 ,"" 546 ,""
536 ," If neither SPEC or FILE match any keys, then the CMD will be " 547 ," If neither SPEC or FILE match any keys, then the CMD will be "
537 ," executed in order to create the FILE." 548 ," executed in order to create the FILE."
538
539 ,"" 549 ,""
540{- ,"Output:" 550{- ,"Output:"
541 ," --show-wk Show fingerprints for the working key (which will be used to" 551 ," --show-wk Show fingerprints for the working key (which will be used to"
@@ -678,7 +688,7 @@ parseKeySpecs = map $ \specfile -> do
678 Just (spec,file,cmd) 688 Just (spec,file,cmd)
679 689
680--kiki :: (Eq a, Data.String.IsString a) => a -> [String] -> IO () 690--kiki :: (Eq a, Data.String.IsString a) => a -> [String] -> IO ()
681kiki "sync" args_raw = do 691sync bExport bSecret cmdarg args_raw = do
682 let (sargs,margs) = processArgs sargspec polyVariadicArgs "--keyrings" args_raw 692 let (sargs,margs) = processArgs sargspec polyVariadicArgs "--keyrings" args_raw
683 sargspec = [ ("--import",0) 693 sargspec = [ ("--import",0)
684 , ("--autosign",0) 694 , ("--autosign",0)
@@ -715,16 +725,22 @@ kiki "sync" args_raw = do
715 let keypairs = catMaybes keypairs0 725 let keypairs = catMaybes keypairs0
716 homespec = join . take 1 <$> Map.lookup "--homedir" margs 726 homespec = join . take 1 <$> Map.lookup "--homedir" margs
717 passfd = fmap (FileDesc . read) passphrase_fd 727 passfd = fmap (FileDesc . read) passphrase_fd
718 pems = flip map keypairs 728 reftyp = if bExport then MutableRef Nothing
729 else ConstRef
730 pems = flip map keypairs
719 $ \(usage,path,cmd) -> 731 $ \(usage,path,cmd) ->
720 let cmd' = guard (not $ null cmd) >> return cmd 732 let cmd' = guard (not $ null cmd) >> return cmd
721 in (ArgFile path, (MutableRef cmd', PEMFile usage)) 733 in if bExport
722 walts = map (\fname -> (ArgFile fname, (MutableRef Nothing, WalletFile))) 734 then (ArgFile path, (MutableRef cmd', PEMFile usage))
735 else if isNothing cmd'
736 then (ArgFile path, (ConstRef, PEMFile usage))
737 else error "Unexpected PEM file initializer."
738 walts = map (\fname -> (ArgFile fname, (reftyp, WalletFile)))
723 wallets 739 wallets
724 rings = map (\fname -> (ArgFile fname, (MutableRef Nothing, KeyRingFile passfd))) 740 rings = map (\fname -> (ArgFile fname, (reftyp, KeyRingFile passfd)))
725 keyrings_ 741 keyrings_
726 hosts = maybe [] (map decorate) $ Map.lookup "--hosts" margs 742 hosts = maybe [] (map decorate) $ Map.lookup "--hosts" margs
727 where decorate fname = (ArgFile fname, (MutableRef Nothing, Hosts)) 743 where decorate fname = (ArgFile fname, (reftyp, Hosts))
728 importStyle = maybe (\_ _ -> subkeysOnly) 744 importStyle = maybe (\_ _ -> subkeysOnly)
729 (\f rt kd -> f rt kd >> importPublic) 745 (\f rt kd -> f rt kd >> importPublic)
730 $ mplus import_f importifauth_f 746 $ mplus import_f importifauth_f
@@ -735,19 +751,20 @@ kiki "sync" args_raw = do
735 return guardAuthentic 751 return guardAuthentic
736 kikiOp = KeyRingOperation 752 kikiOp = KeyRingOperation
737 { kFiles = Map.fromList $ 753 { kFiles = Map.fromList $
738 [ ( HomeSec, (MutableRef Nothing, KeyRingFile passfd) ) 754 [ ( HomeSec, (if bSecret then MutableRef Nothing else ConstRef, KeyRingFile passfd) )
739 , ( HomePub, (MutableRef Nothing, KeyRingFile Nothing) ) 755 , ( HomePub, (MutableRef Nothing, KeyRingFile Nothing) )
740 ] 756 ]
741 ++ rings 757 ++ rings
742 ++ pems 758 ++ if bSecret then pems else []
743 ++ walts 759 ++ if bSecret then walts else []
744 ++ hosts 760 ++ hosts
745 , kImports = Map.fromList [ ( HomePub, importStyle ) ] 761 , kImports = Map.fromList [ ( HomePub, importStyle ) ]
746 , kManip = maybe noManip (const doAutosign) $ Map.lookup "--autosign" margs 762 , kManip = maybe noManip (const doAutosign) $ Map.lookup "--autosign" margs
747 , homeSpec = homespec 763 , homeSpec = homespec
748 } 764 }
749 765
750 KikiResult rt report <- runKeyRing kikiOp 766 (\f -> maybe f (const $ kiki_usage cmdarg) $ Map.lookup "--help" margs) $ do
767 KikiResult rt report <- runKeyRing kikiOp
751 768
752 case rt of 769 case rt of
753 KikiSuccess rt -> do -- interpret --show-* commands. 770 KikiSuccess rt -> do -- interpret --show-* commands.
@@ -759,7 +776,7 @@ kiki "sync" args_raw = do
759 ,("--show-pem",\[x] -> show_pem x $ fromMaybe "" grip) 776 ,("--show-pem",\[x] -> show_pem x $ fromMaybe "" grip)
760 ,("--show-ssh",\[x] -> show_ssh x $ fromMaybe "" grip) 777 ,("--show-ssh",\[x] -> show_ssh x $ fromMaybe "" grip)
761 ,("--show-wip",\[x] -> show_wip x $ fromMaybe "" grip)-} 778 ,("--show-wip",\[x] -> show_wip x $ fromMaybe "" grip)-}
762 ,("--help", \_ _ ->kiki_sync_help)] 779 ]
763 shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs 780 shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs
764 781
765 forM_ shargs $ \(cmd,args) -> cmd args (rtKeyDB rt) 782 forM_ shargs $ \(cmd,args) -> cmd args (rtKeyDB rt)
@@ -768,8 +785,26 @@ kiki "sync" args_raw = do
768 forM_ report $ \(fname,act) -> do 785 forM_ report $ \(fname,act) -> do
769 putStrLn $ fname ++ ": " ++ reportString act 786 putStrLn $ fname ++ ": " ++ reportString act
770 787
788kiki "sync-secret" args_raw =
789 sync True True "sync-secret" args_raw
790
791kiki "sync-public" args_raw =
792 sync True False "sync-public" args_raw
793
794kiki "import-secret" args_raw =
795 sync False True "import-secret" args_raw
796
797kiki "import-public" args_raw =
798 sync False False "import-public" args_raw
799
771kiki "working-key" args = do 800kiki "working-key" args = do
772 kiki "sync" ["--show-wk"] 801 if "--help" `notElem` args
802 then sync False False "working-key" ["--show-wk"]
803 else putStrLn $
804 unlines ["working-key"
805 ,""
806 ," Displays the master key with its subkeys that will be"
807 ," used for making signatures"]
773 808
774-- Generic help 809-- Generic help
775kiki "help" [] = do 810kiki "help" [] = do
@@ -792,8 +827,12 @@ kiki "show" args = return ()
792commands :: [(String,String)] 827commands :: [(String,String)]
793commands = 828commands =
794 [ ( "help", "display usage information" ) 829 [ ( "help", "display usage information" )
795 , ( "sync", "update key files of various kinds by propogating information" ) 830 --, ( "sync", "update key files of various kinds by propogating information" )
796 , ( "show", "display information from your keyrings") 831 , ( "show", "display information from your keyrings")
832 , ( "sync-secret", "update key files of various kinds by propogating information (both secret and public)" )
833 , ( "sync-public", "update key files of various kinds by propogating public information" )
834 , ( "import-secret", "import (both public and secret) information into your keyring" )
835 , ( "import-public", "import (public) information into your keyring" )
797 , ( "working-key", "show the current working master key and its subkeys" ) 836 , ( "working-key", "show the current working master key and its subkeys" )
798 ] 837 ]
799 838