diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 224 |
1 files changed, 159 insertions, 65 deletions
@@ -41,12 +41,69 @@ import DotLock | |||
41 | import LengthPrefixedBE | 41 | import LengthPrefixedBE |
42 | import KeyRing | 42 | import KeyRing |
43 | import Base58 | 43 | import Base58 |
44 | import qualified CryptoCoins | 44 | import qualified CryptoCoins |
45 | import Data.OpenPGP.Util (verify,fingerprint) | 45 | import Data.OpenPGP.Util (verify,fingerprint) |
46 | 46 | ||
47 | -- {-# ANN module ("HLint: ignore Eta reduce"::String) #-} | 47 | -- {-# ANN module ("HLint: ignore Eta reduce"::String) #-} |
48 | -- {-# ANN module ("HLint: ignore Use camelCase"::String) #-} | 48 | -- {-# ANN module ("HLint: ignore Use camelCase"::String) #-} |
49 | 49 | ||
50 | {- | ||
51 | - | ||
52 | - | ||
53 | accBindings :: forall t a a1 a2. | ||
54 | Bits t => | ||
55 | [(t, (Packet, Packet), [a], [a1], [a2])] | ||
56 | -> [(t, (Packet, Packet), [a], [a1], [a2])] | ||
57 | bitcoinAddress :: Word8 -> Packet -> String | ||
58 | cannonical_eckey :: forall b b1. | ||
59 | (Integral b1, Integral b) => | ||
60 | b -> b1 -> [Word8] | ||
61 | commands :: [(String, String)] | ||
62 | decode_sshrsa :: Char8.ByteString -> Maybe RSAPublicKey | ||
63 | disjoint_fp :: [Packet] -> [[Packet]] | ||
64 | doAutosign :: forall t. t -> KeyData -> [PacketUpdate] | ||
65 | fpmatch :: Maybe [Char] -> Packet -> Bool | ||
66 | getBindings :: [Packet] | ||
67 | -> ([([Packet], [SignatureOver])], | ||
68 | [(Word8, | ||
69 | (Packet, Packet), | ||
70 | [String], | ||
71 | [SignatureSubpacket], | ||
72 | [Packet])]) | ||
73 | isCertificationSig :: SignatureOver -> Bool | ||
74 | isSubkeySignature :: SignatureOver -> Bool | ||
75 | kiki :: forall a. | ||
76 | (Eq a, Data.String.IsString a) => | ||
77 | a -> [[Char]] -> IO () | ||
78 | kiki_sync_help :: IO () | ||
79 | listKeys :: [Packet] -> [Char] | ||
80 | listKeysFiltered :: [[Char]] -> [Packet] -> [Char] | ||
81 | :Main.main :: IO () | ||
82 | main :: IO () | ||
83 | partitionStaticArguments :: forall a. | ||
84 | Ord a => | ||
85 | [(a, Int)] -> [a] -> ([[a]], [a]) | ||
86 | readPublicKey :: Char8.ByteString -> RSAPublicKey | ||
87 | show_all :: KeyDB -> IO () | ||
88 | show_key :: forall t. | ||
89 | String -> t -> Map.Map KeyRing.KeyKey KeyData -> IO () | ||
90 | show_pem :: String -> String -> KeyDB -> IO () | ||
91 | show_ssh :: String -> String -> KeyDB -> IO () | ||
92 | show_whose_key :: Maybe RSAPublicKey -> KeyDB -> IO () | ||
93 | show_wip :: String -> String -> KeyDB -> IO () | ||
94 | show_wk :: FilePath | ||
95 | -> Maybe [Char] -> Map.Map KeyRing.KeyKey KeyData -> IO () | ||
96 | smallpr :: Packet -> [Char] | ||
97 | sshrsa :: Integer -> Integer -> Char8.ByteString | ||
98 | toLast :: forall x. (x -> x) -> [x] -> [x] | ||
99 | verifyBindings :: [Packet] | ||
100 | -> [Packet] -> ([SignatureOver], [SignatureOver]) | ||
101 | warn :: String -> IO () | ||
102 | whoseKey :: RSAPublicKey -> KeyDB -> [KeyData] | ||
103 | - | ||
104 | - | ||
105 | -} | ||
106 | |||
50 | warn str = hPutStrLn stderr str | 107 | warn str = hPutStrLn stderr str |
51 | 108 | ||
52 | sshrsa :: Integer -> Integer -> Char8.ByteString | 109 | sshrsa :: Integer -> Integer -> Char8.ByteString |
@@ -65,7 +122,7 @@ decode_sshrsa bs = do | |||
65 | LengthPrefixedBE n <- get | 122 | LengthPrefixedBE n <- get |
66 | return $ RSAKey (MPI n) (MPI e) | 123 | return $ RSAKey (MPI n) (MPI e) |
67 | return rsakey | 124 | return rsakey |
68 | 125 | ||
69 | isCertificationSig (CertificationSignature {}) = True | 126 | isCertificationSig (CertificationSignature {}) = True |
70 | isCertificationSig _ = True | 127 | isCertificationSig _ = True |
71 | 128 | ||
@@ -284,18 +341,19 @@ toLast f [] = [] | |||
284 | toLast f [x] = [f x] | 341 | toLast f [x] = [f x] |
285 | toLast f (x:xs) = x : toLast f xs | 342 | toLast f (x:xs) = x : toLast f xs |
286 | 343 | ||
344 | -- partitionStaticArguments :: Ord a => [(a, Int)] -> [a] -> ([[a]], [a]) | ||
287 | partitionStaticArguments specs args = psa args | 345 | partitionStaticArguments specs args = psa args |
288 | where | 346 | where |
289 | smap = Map.fromList specs | 347 | smap = Map.fromList specs |
290 | psa [] = ([],[]) | 348 | psa [] = ([],[]) |
291 | psa (a:as) = | 349 | psa (a:as) = |
292 | case Map.lookup a smap of | 350 | case Map.lookup a smap of |
293 | Nothing -> second (a:) $ psa as | 351 | Nothing -> second (a:) $ psa as |
294 | Just n -> first ((a:take n as):) $ psa (drop n as) | 352 | Just n -> first ((a:take n as):) $ psa (drop n as) |
295 | 353 | ||
296 | show_wk secring_file grip db = do | 354 | show_wk secring_file grip db = do |
297 | let sec_db = Map.filter gripmatch db | 355 | let sec_db = Map.filter gripmatch db |
298 | gripmatch (KeyData p _ _ _) = | 356 | gripmatch (KeyData p _ _ _) = |
299 | Map.member secring_file (locations p) | 357 | Map.member secring_file (locations p) |
300 | Message sec = flattenKeys False sec_db | 358 | Message sec = flattenKeys False sec_db |
301 | putStrLn $ listKeysFiltered (maybeToList grip) sec | 359 | putStrLn $ listKeysFiltered (maybeToList grip) sec |
@@ -304,7 +362,7 @@ show_all db = do | |||
304 | let Message packets = flattenKeys True db | 362 | let Message packets = flattenKeys True db |
305 | putStrLn $ listKeys packets | 363 | putStrLn $ listKeys packets |
306 | 364 | ||
307 | show_whose_key input_key db = | 365 | show_whose_key input_key db = |
308 | flip (maybe $ return ()) input_key $ \input_key -> do | 366 | flip (maybe $ return ()) input_key $ \input_key -> do |
309 | let ks = whoseKey input_key db | 367 | let ks = whoseKey input_key db |
310 | case ks of | 368 | case ks of |
@@ -327,7 +385,7 @@ show_pem keyspec wkgrip db = do | |||
327 | 385 | ||
328 | show_ssh keyspec wkgrip db = do | 386 | show_ssh keyspec wkgrip db = do |
329 | let s = parseSpec wkgrip keyspec | 387 | let s = parseSpec wkgrip keyspec |
330 | flip (maybe . void $ warn (keyspec ++ ": not found")) | 388 | flip (maybe . void $ warn (keyspec ++ ": not found")) |
331 | (selectPublicKey s db) | 389 | (selectPublicKey s db) |
332 | $ \k -> do | 390 | $ \k -> do |
333 | let Just (RSAKey (MPI n) (MPI e)) = rsaKeyFromPacket k | 391 | let Just (RSAKey (MPI n) (MPI e)) = rsaKeyFromPacket k |
@@ -337,7 +395,7 @@ show_ssh keyspec wkgrip db = do | |||
337 | 395 | ||
338 | show_key keyspec wkgrip db = do | 396 | show_key keyspec wkgrip db = do |
339 | let s = parseSpec "" keyspec | 397 | let s = parseSpec "" keyspec |
340 | let ps = do | 398 | let ps = do |
341 | (_,k) <- filterMatches (fst s) (Map.toList db) | 399 | (_,k) <- filterMatches (fst s) (Map.toList db) |
342 | mp <- flattenTop "" True k | 400 | mp <- flattenTop "" True k |
343 | return $ packet mp | 401 | return $ packet mp |
@@ -363,7 +421,7 @@ cannonical_eckey x y = 0x4:pad32(numToBytes x) ++ pad32(numToBytes y) :: [Word8] | |||
363 | pad32 xs = replicate zlen 0 ++ xs | 421 | pad32 xs = replicate zlen 0 ++ xs |
364 | where | 422 | where |
365 | zlen = 32 - length xs | 423 | zlen = 32 - length xs |
366 | 424 | ||
367 | 425 | ||
368 | bitcoinAddress network_id k = address | 426 | bitcoinAddress network_id k = address |
369 | where | 427 | where |
@@ -379,7 +437,7 @@ whoseKey rsakey db = filter matchkey (Map.elems db) | |||
379 | matchkey (KeyData k _ _ subs) = | 437 | matchkey (KeyData k _ _ subs) = |
380 | any (ismatch k) $ Map.elems subs | 438 | any (ismatch k) $ Map.elems subs |
381 | 439 | ||
382 | ismatch k (SubKey mp sigs) = | 440 | ismatch k (SubKey mp sigs) = |
383 | Just rsakey == rsaKeyFromPacket (packet mp) | 441 | Just rsakey == rsaKeyFromPacket (packet mp) |
384 | && any (check (packet k) (packet mp)) sigs | 442 | && any (check (packet k) (packet mp)) sigs |
385 | 443 | ||
@@ -474,7 +532,7 @@ kiki_usage cmd = putStr $ | |||
474 | ," format. Users incognisant of the fact that the public key (which" | 532 | ," format. Users incognisant of the fact that the public key (which" |
475 | ," is also stored separately) is in this file, often think of it as" | 533 | ," is also stored separately) is in this file, often think of it as" |
476 | ," their secret key file." | 534 | ," their secret key file." |
477 | ,"" | 535 | ,"" |
478 | ," Each KEYSPEC specifies that a key should match the content and" | 536 | ," Each KEYSPEC specifies that a key should match the content and" |
479 | ," timestamp of an external PKCS #1 private RSA key file." | 537 | ," timestamp of an external PKCS #1 private RSA key file." |
480 | ," " | 538 | ," " |
@@ -489,7 +547,7 @@ kiki_usage cmd = putStr $ | |||
489 | ," 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 " |
490 | ," executed in order to create the FILE." | 548 | ," executed in order to create the FILE." |
491 | ,"" | 549 | ,"" |
492 | ,"Output:" | 550 | {- ,"Output:" |
493 | ," --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" |
494 | ," make signatures) and all its subkeys and UID." | 552 | ," make signatures) and all its subkeys and UID." |
495 | ,"" | 553 | ,"" |
@@ -514,6 +572,7 @@ kiki_usage cmd = putStr $ | |||
514 | ,"" | 572 | ,"" |
515 | ," --help Shows this help screen." | 573 | ," --help Shows this help screen." |
516 | ,"" | 574 | ,"" |
575 | -} | ||
517 | ,"Specifying keys on the kiki command line:" | 576 | ,"Specifying keys on the kiki command line:" |
518 | ,"" | 577 | ,"" |
519 | ," SPEC ::= MASTER/SUBKEY" | 578 | ," SPEC ::= MASTER/SUBKEY" |
@@ -527,7 +586,7 @@ kiki_usage cmd = putStr $ | |||
527 | ,"" | 586 | ,"" |
528 | ," MASTER may be any of" | 587 | ," MASTER may be any of" |
529 | ," * The tail end of a fingerprint prefixed by 'fp:'" | 588 | ," * The tail end of a fingerprint prefixed by 'fp:'" |
530 | ," * A sub-string of a user id (without slashes) prefixed by 'u:'" | 589 | ," * A sub-string of a user id (without slashes) prefixed by 'u:'" |
531 | ," * 40 characters of hexidecimal (kiki will assume this to be a fingerprint)" | 590 | ," * 40 characters of hexidecimal (kiki will assume this to be a fingerprint)" |
532 | ," * A sub-string of a user id (without slashes, the prefix 'u:' is optional)" | 591 | ," * A sub-string of a user id (without slashes, the prefix 'u:' is optional)" |
533 | ,"" | 592 | ,"" |
@@ -581,62 +640,76 @@ doAutosign rt kd@(KeyData k ksigs umap submap) = ops | |||
581 | = fingerprint_material a==fingerprint_material b | 640 | = fingerprint_material a==fingerprint_material b |
582 | gs = groupBy sameMaster (sortBy (comparing code) bindings') | 641 | gs = groupBy sameMaster (sortBy (comparing code) bindings') |
583 | 642 | ||
584 | sync bModifyInput cmdarg args_raw = do | 643 | processArgs sargspec polyVariadicArgs defaultPoly args_raw = (sargs,margs) |
585 | let (args,trail1) = break (=="--") args_raw | 644 | where |
645 | (args,trail1) = break (=="--") args_raw | ||
586 | trail = drop 1 trail1 | 646 | trail = drop 1 trail1 |
587 | (sargs,margs) = | 647 | commonArgSpec = [ ("--homedir",1) |
648 | , ("--passphrase-fd",1) | ||
649 | ] | ||
650 | (sargs,margs) = | ||
588 | (sargs, foldl' (\m (k:xs)->Map.alter (appendArgs k xs) k m) | 651 | (sargs, foldl' (\m (k:xs)->Map.alter (appendArgs k xs) k m) |
589 | Map.empty | 652 | Map.empty |
590 | gargs) | 653 | gargs) |
591 | where (sargs,vargs) = partitionStaticArguments sargspec args | 654 | where (sargs,vargs) = partitionStaticArguments (commonArgSpec ++ sargspec) args |
592 | sargspec = [ ("--homedir",1) | 655 | argspec = map fst sargspec ++ polyVariadicArgs |
593 | , ("--passphrase-fd",1) | ||
594 | , ("--import",0) | ||
595 | , ("--autosign",0) | ||
596 | , ("--import-if-authentic",0) | ||
597 | , ("--show-wk",0) | ||
598 | , ("--show-all",0) | ||
599 | , ("--show-whose-key",0) | ||
600 | , ("--show-key",1) | ||
601 | , ("--show-pem",1) | ||
602 | , ("--show-ssh",1) | ||
603 | , ("--show-wip",1) | ||
604 | , ("--help",0) | ||
605 | ] | ||
606 | argspec = map fst sargspec ++ ["--keyrings" | ||
607 | ,"--keypairs" | ||
608 | ,"--wallets" | ||
609 | ,"--hosts"] | ||
610 | -- "--bitcoin-keypairs" | ||
611 | -- Disabled. We shouldn't accept private key | ||
612 | -- data on the command line. | ||
613 | args' = if map (take 1) (take 1 vargs) == ["-"] | 656 | args' = if map (take 1) (take 1 vargs) == ["-"] |
614 | then vargs | 657 | then vargs |
615 | else "--keyrings":vargs | 658 | else defaultPoly:vargs |
659 | -- grouped args | ||
616 | gargs = (sargs ++) | 660 | gargs = (sargs ++) |
617 | . toLast (++trail) | 661 | . toLast (++trail) |
618 | . groupBy (\_ s-> take 1 s /= "-") | 662 | . groupBy (\_ s-> take 1 s /= "-") |
619 | $ args' | 663 | $ args' |
620 | appendArgs k xs opt = | 664 | appendArgs k xs opt = |
621 | if k `elem` argspec | 665 | if k `elem` argspec |
622 | then Just . maybe xs (++xs) $ opt | 666 | then Just . maybe xs (++xs) $ opt |
623 | else error . unlines $ [ "unrecognized option "++k | 667 | else error . unlines $ [ "unrecognized option "++k |
624 | , "Use --help for usage." ] | 668 | , "Use --help for usage." ] |
669 | |||
670 | data CommonArgsParsed = CommonArgsParsed { cap_homespec :: Maybe String, cap_passfd :: Maybe InputFile } | ||
671 | |||
672 | parseCommonArgs margs = CommonArgsParsed { cap_homespec = homespec, cap_passfd = passfd } | ||
673 | where | ||
674 | passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs | ||
675 | homespec = join . take 1 <$> Map.lookup "--homedir" margs | ||
676 | passfd = fmap (FileDesc . read) passphrase_fd | ||
677 | |||
678 | parseKeySpecs = map $ \specfile -> do | ||
679 | let (spec,efilecmd) = break (=='=') specfile | ||
680 | guard $ take 1 efilecmd=="=" | ||
681 | let filecmd = drop 1 efilecmd | ||
682 | let (file,bcmdb0) = break (=='{') filecmd | ||
683 | bcmdb = if null bcmdb0 then "{}" else bcmdb0 | ||
684 | guard $ take 1 bcmdb=="{" | ||
685 | let bdmcb = (dropWhile isSpace . reverse) bcmdb | ||
686 | guard $ take 1 bdmcb == "}" | ||
687 | let cmd = (drop 1 . reverse . drop 1) bdmcb | ||
688 | Just (spec,file,cmd) | ||
689 | |||
690 | --kiki :: (Eq a, Data.String.IsString a) => a -> [String] -> IO () | ||
691 | sync bExport bSecret cmdarg args_raw = do | ||
692 | let (sargs,margs) = processArgs sargspec polyVariadicArgs "--keyrings" args_raw | ||
693 | sargspec = [ ("--import",0) | ||
694 | , ("--autosign",0) | ||
695 | , ("--import-if-authentic",0) | ||
696 | , ("--show-wk",0) | ||
697 | {-, ("--show-all",0) | ||
698 | , ("--show-whose-key",0) | ||
699 | , ("--show-key",1) | ||
700 | , ("--show-pem",1) | ||
701 | , ("--show-ssh",1) | ||
702 | , ("--show-wip",1) -} | ||
703 | , ("--help",0) | ||
704 | ] | ||
705 | polyVariadicArgs = ["--keyrings" | ||
706 | ,"--keypairs" | ||
707 | ,"--wallets" | ||
708 | ,"--hosts"] | ||
625 | -- putStrLn $ "margs = " ++ show (Map.assocs margs) | 709 | -- putStrLn $ "margs = " ++ show (Map.assocs margs) |
626 | unkeysRef <- newIORef Map.empty | 710 | unkeysRef <- newIORef Map.empty |
627 | pwRef <- newIORef Nothing | 711 | pwRef <- newIORef Nothing |
628 | let keypairs0 = | 712 | let keypairs0 = parseKeySpecs (fromMaybe [] $ Map.lookup "--keypairs" margs) |
629 | flip map (fromMaybe [] $ Map.lookup "--keypairs" margs) $ \specfile -> do | ||
630 | let (spec,efilecmd) = break (=='=') specfile | ||
631 | guard $ take 1 efilecmd=="=" | ||
632 | let filecmd = drop 1 efilecmd | ||
633 | let (file,bcmdb0) = break (=='{') filecmd | ||
634 | bcmdb = if null bcmdb0 then "{}" else bcmdb0 | ||
635 | guard $ take 1 bcmdb=="{" | ||
636 | let bdmcb = (dropWhile isSpace . reverse) bcmdb | ||
637 | guard $ take 1 bdmcb == "}" | ||
638 | let cmd = (drop 1 . reverse . drop 1) bdmcb | ||
639 | Just (spec,file,cmd) | ||
640 | keyrings_ = fromMaybe [] $ Map.lookup "--keyrings" margs | 713 | keyrings_ = fromMaybe [] $ Map.lookup "--keyrings" margs |
641 | wallets = fromMaybe [] $ Map.lookup "--wallets" margs | 714 | wallets = fromMaybe [] $ Map.lookup "--wallets" margs |
642 | passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs | 715 | passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs |
@@ -646,18 +719,18 @@ sync bModifyInput cmdarg args_raw = do | |||
646 | exitFailure | 719 | exitFailure |
647 | 720 | ||
648 | input_key <- maybe (return Nothing) | 721 | input_key <- maybe (return Nothing) |
649 | (const $ fmap (Just . readPublicKey) Char8.getContents) | 722 | (const $ fmap (Just . readPublicKey) Char8.getContents) |
650 | $ Map.lookup "--show-whose-key" margs | 723 | $ Map.lookup "--show-whose-key" margs |
651 | 724 | ||
652 | let keypairs = catMaybes keypairs0 | 725 | let keypairs = catMaybes keypairs0 |
653 | homespec = join . take 1 <$> Map.lookup "--homedir" margs | 726 | homespec = join . take 1 <$> Map.lookup "--homedir" margs |
654 | passfd = fmap (FileDesc . read) passphrase_fd | 727 | passfd = fmap (FileDesc . read) passphrase_fd |
655 | reftyp = if bModifyInput then MutableRef Nothing | 728 | reftyp = if bExport then MutableRef Nothing |
656 | else ConstRef | 729 | else ConstRef |
657 | pems = flip map keypairs | 730 | pems = flip map keypairs |
658 | $ \(usage,path,cmd) -> | 731 | $ \(usage,path,cmd) -> |
659 | let cmd' = guard (not $ null cmd) >> return cmd | 732 | let cmd' = guard (not $ null cmd) >> return cmd |
660 | in if bModifyInput | 733 | in if bExport |
661 | then (ArgFile path, (MutableRef cmd', PEMFile usage)) | 734 | then (ArgFile path, (MutableRef cmd', PEMFile usage)) |
662 | else if isNothing cmd' | 735 | else if isNothing cmd' |
663 | then (ArgFile path, (ConstRef, PEMFile usage)) | 736 | then (ArgFile path, (ConstRef, PEMFile usage)) |
@@ -678,12 +751,12 @@ sync bModifyInput cmdarg args_raw = do | |||
678 | return guardAuthentic | 751 | return guardAuthentic |
679 | kikiOp = KeyRingOperation | 752 | kikiOp = KeyRingOperation |
680 | { kFiles = Map.fromList $ | 753 | { kFiles = Map.fromList $ |
681 | [ ( HomeSec, (MutableRef Nothing, KeyRingFile passfd) ) | 754 | [ ( HomeSec, (if bSecret then MutableRef Nothing else ConstRef, KeyRingFile passfd) ) |
682 | , ( HomePub, (MutableRef Nothing, KeyRingFile Nothing) ) | 755 | , ( HomePub, (MutableRef Nothing, KeyRingFile Nothing) ) |
683 | ] | 756 | ] |
684 | ++ rings | 757 | ++ rings |
685 | ++ pems | 758 | ++ if bSecret then pems else [] |
686 | ++ walts | 759 | ++ if bSecret then walts else [] |
687 | ++ hosts | 760 | ++ hosts |
688 | , kImports = Map.fromList [ ( HomePub, importStyle ) ] | 761 | , kImports = Map.fromList [ ( HomePub, importStyle ) ] |
689 | , kManip = maybe noManip (const doAutosign) $ Map.lookup "--autosign" margs | 762 | , kManip = maybe noManip (const doAutosign) $ Map.lookup "--autosign" margs |
@@ -697,12 +770,13 @@ sync bModifyInput cmdarg args_raw = do | |||
697 | KikiSuccess rt -> do -- interpret --show-* commands. | 770 | KikiSuccess rt -> do -- interpret --show-* commands. |
698 | let grip = rtGrip rt | 771 | let grip = rtGrip rt |
699 | let shspec = Map.fromList [("--show-wk", const $ show_wk (rtSecring rt) grip) | 772 | let shspec = Map.fromList [("--show-wk", const $ show_wk (rtSecring rt) grip) |
700 | ,("--show-all",const show_all) | 773 | {-,("--show-all",const show_all) |
701 | ,("--show-whose-key", const $ show_whose_key input_key) | 774 | ,("--show-whose-key", const $ show_whose_key input_key) |
702 | ,("--show-key",\[x] -> show_key x $ fromMaybe "" grip) | 775 | ,("--show-key",\[x] -> show_key x $ fromMaybe "" grip) |
703 | ,("--show-pem",\[x] -> show_pem x $ fromMaybe "" grip) | 776 | ,("--show-pem",\[x] -> show_pem x $ fromMaybe "" grip) |
704 | ,("--show-ssh",\[x] -> show_ssh x $ fromMaybe "" grip) | 777 | ,("--show-ssh",\[x] -> show_ssh x $ fromMaybe "" grip) |
705 | ,("--show-wip",\[x] -> show_wip x $ fromMaybe "" grip)] | 778 | ,("--show-wip",\[x] -> show_wip x $ fromMaybe "" grip)-} |
779 | ] | ||
706 | shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs | 780 | shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs |
707 | 781 | ||
708 | forM_ shargs $ \(cmd,args) -> cmd args (rtKeyDB rt) | 782 | forM_ shargs $ \(cmd,args) -> cmd args (rtKeyDB rt) |
@@ -712,33 +786,53 @@ sync bModifyInput cmdarg args_raw = do | |||
712 | putStrLn $ fname ++ ": " ++ reportString act | 786 | putStrLn $ fname ++ ": " ++ reportString act |
713 | 787 | ||
714 | kiki "sync-secret" args_raw = | 788 | kiki "sync-secret" args_raw = |
715 | sync True "sync-secret" args_raw | 789 | sync True True "sync-secret" args_raw |
790 | |||
791 | kiki "sync-public" args_raw = | ||
792 | sync True False "sync-public" args_raw | ||
716 | 793 | ||
717 | kiki "import-secret" args_raw = | 794 | kiki "import-secret" args_raw = |
718 | sync False "import-secret" args_raw | 795 | sync False True "import-secret" args_raw |
796 | |||
797 | kiki "import-public" args_raw = | ||
798 | sync False False "import-public" args_raw | ||
719 | 799 | ||
720 | kiki "working-key" args = do | 800 | kiki "working-key" args = do |
721 | if "--help" `notElem` args | 801 | if "--help" `notElem` args |
722 | then sync False "working-key" ["--show-wk"] | 802 | then sync False False "working-key" ["--show-wk"] |
723 | else putStrLn $ | 803 | else putStrLn $ |
724 | unlines ["working-key" | 804 | unlines ["working-key" |
725 | ,"" | 805 | ,"" |
726 | ," Displays the master key with its subkeys that will be" | 806 | ," Displays the master key with its subkeys that will be" |
727 | ," used for making signatures"] | 807 | ," used for making signatures"] |
728 | 808 | ||
729 | kiki "help" args = do | 809 | -- Generic help |
810 | kiki "help" [] = do | ||
730 | putStrLn "Valid commands are:" | 811 | putStrLn "Valid commands are:" |
731 | let longest = maximum $ map (length . fst) commands | 812 | let longest = maximum $ map (length . fst) commands |
732 | pad cmd = take (longest+3) $ cmd ++ repeat ' ' | 813 | pad cmd = take (longest+3) $ cmd ++ repeat ' ' |
733 | forM commands $ \(cmd,help) -> do | 814 | forM commands $ \(cmd,help) -> do |
734 | putStrLn $ " " ++ pad cmd ++ help | 815 | putStrLn $ " " ++ pad cmd ++ help |
816 | putStr . unlines $ ["" | ||
817 | ,"See 'kiki help <command>' for more information on a specific command." | ||
818 | ] | ||
735 | return () | 819 | return () |
736 | 820 | ||
821 | kiki "help" args = forM_ args $ \arg -> case lookup arg commands of | ||
822 | Nothing -> putStrLn $ "No help available for commmand '" ++ arg ++ "'." | ||
823 | _ -> kiki arg ["--help"] | ||
824 | |||
825 | kiki "show" args = return () | ||
826 | |||
737 | commands :: [(String,String)] | 827 | commands :: [(String,String)] |
738 | commands = | 828 | commands = |
739 | [ ( "help", "display usage information" ) | 829 | [ ( "help", "display usage information" ) |
740 | , ( "sync-secret", "update key files of various kinds by propogating information" ) | 830 | --, ( "sync", "update key files of various kinds by propogating information" ) |
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" ) | ||
741 | , ( "import-secret", "import (both public and secret) information into your keyring" ) | 834 | , ( "import-secret", "import (both public and secret) information into your keyring" ) |
835 | , ( "import-public", "import (public) information into your keyring" ) | ||
742 | , ( "working-key", "show the current working master key and its subkeys" ) | 836 | , ( "working-key", "show the current working master key and its subkeys" ) |
743 | ] | 837 | ] |
744 | 838 | ||