diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 210 |
1 files changed, 147 insertions, 63 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 | ||
@@ -401,7 +459,7 @@ whoseKey rsakey db = filter matchkey (Map.elems db) | |||
401 | 459 | ||
402 | 460 | ||
403 | 461 | ||
404 | kiki_usage = putStr . unlines $ | 462 | kiki_sync_help = putStr . unlines $ |
405 | {- | 463 | {- |
406 | ["kiki - a pgp key editing utility" | 464 | ["kiki - a pgp key editing utility" |
407 | ,"" | 465 | ,"" |
@@ -463,14 +521,15 @@ kiki_usage = putStr . unlines $ | |||
463 | ," format. Users incognisant of the fact that the public key (which" | 521 | ," format. Users incognisant of the fact that the public key (which" |
464 | ," is also stored separately) is in this file, often think of it as" | 522 | ," is also stored separately) is in this file, often think of it as" |
465 | ," their secret key file." | 523 | ," their secret key file." |
466 | ,"" | 524 | ,"" |
467 | ," Each KEYSPEC specifies that a key should match the content and" | 525 | ," Each KEYSPEC specifies that a key should match the content and" |
468 | ," timestamp of an external PKCS #1 private RSA key file." | 526 | ," timestamp of an external PKCS #1 private RSA key file." |
469 | ," " | 527 | ," " |
470 | ," KEYSPEC ::= SPEC=FILE{CMD} " | 528 | ," KEYSPEC ::= SPEC=FILE{CMD} " |
471 | ,"" | 529 | ,"" |
472 | ," The form of SPEC is documented below. If there is only one master" | 530 | ," 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" | 531 | ," key in your keyring and only one key is used for each purpose, then" |
532 | ," 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" | 533 | ," information about what this key is used for, for example, any of" |
475 | ," `tor', `ssh-client', `ssh-host', or `strongswan' will do." | 534 | ," `tor', `ssh-client', `ssh-host', or `strongswan' will do." |
476 | ,"" | 535 | ,"" |
@@ -478,7 +537,7 @@ kiki_usage = putStr . unlines $ | |||
478 | ," executed in order to create the FILE." | 537 | ," executed in order to create the FILE." |
479 | 538 | ||
480 | ,"" | 539 | ,"" |
481 | ,"Output:" | 540 | {- ,"Output:" |
482 | ," --show-wk Show fingerprints for the working key (which will be used to" | 541 | ," --show-wk Show fingerprints for the working key (which will be used to" |
483 | ," make signatures) and all its subkeys and UID." | 542 | ," make signatures) and all its subkeys and UID." |
484 | ,"" | 543 | ,"" |
@@ -503,6 +562,7 @@ kiki_usage = putStr . unlines $ | |||
503 | ,"" | 562 | ,"" |
504 | ," --help Shows this help screen." | 563 | ," --help Shows this help screen." |
505 | ,"" | 564 | ,"" |
565 | -} | ||
506 | ,"Specifying keys on the kiki command line:" | 566 | ,"Specifying keys on the kiki command line:" |
507 | ,"" | 567 | ,"" |
508 | ," SPEC ::= MASTER/SUBKEY" | 568 | ," SPEC ::= MASTER/SUBKEY" |
@@ -516,7 +576,7 @@ kiki_usage = putStr . unlines $ | |||
516 | ,"" | 576 | ,"" |
517 | ," MASTER may be any of" | 577 | ," MASTER may be any of" |
518 | ," * The tail end of a fingerprint prefixed by 'fp:'" | 578 | ," * The tail end of a fingerprint prefixed by 'fp:'" |
519 | ," * A sub-string of a user id (without slashes) prefixed by 'u:'" | 579 | ," * A sub-string of a user id (without slashes) prefixed by 'u:'" |
520 | ," * 40 characters of hexidecimal (kiki will assume this to be a fingerprint)" | 580 | ," * 40 characters of hexidecimal (kiki will assume this to be a fingerprint)" |
521 | ," * A sub-string of a user id (without slashes, the prefix 'u:' is optional)" | 581 | ," * A sub-string of a user id (without slashes, the prefix 'u:' is optional)" |
522 | ,"" | 582 | ,"" |
@@ -570,63 +630,76 @@ doAutosign rt kd@(KeyData k ksigs umap submap) = ops | |||
570 | = fingerprint_material a==fingerprint_material b | 630 | = fingerprint_material a==fingerprint_material b |
571 | gs = groupBy sameMaster (sortBy (comparing code) bindings') | 631 | gs = groupBy sameMaster (sortBy (comparing code) bindings') |
572 | 632 | ||
573 | 633 | processArgs sargspec polyVariadicArgs defaultPoly args_raw = (sargs,margs) | |
574 | kiki "sync" args_raw = do | 634 | where |
575 | let (args,trail1) = break (=="--") args_raw | 635 | (args,trail1) = break (=="--") args_raw |
576 | trail = drop 1 trail1 | 636 | trail = drop 1 trail1 |
577 | (sargs,margs) = | 637 | commonArgSpec = [ ("--homedir",1) |
638 | , ("--passphrase-fd",1) | ||
639 | ] | ||
640 | (sargs,margs) = | ||
578 | (sargs, foldl' (\m (k:xs)->Map.alter (appendArgs k xs) k m) | 641 | (sargs, foldl' (\m (k:xs)->Map.alter (appendArgs k xs) k m) |
579 | Map.empty | 642 | Map.empty |
580 | gargs) | 643 | gargs) |
581 | where (sargs,vargs) = partitionStaticArguments sargspec args | 644 | where (sargs,vargs) = partitionStaticArguments (commonArgSpec ++ sargspec) args |
582 | sargspec = [ ("--homedir",1) | 645 | argspec = map fst sargspec ++ polyVariadicArgs |
583 | , ("--passphrase-fd",1) | ||
584 | , ("--import",0) | ||
585 | , ("--autosign",0) | ||
586 | , ("--import-if-authentic",0) | ||
587 | , ("--show-wk",0) | ||
588 | , ("--show-all",0) | ||
589 | , ("--show-whose-key",0) | ||
590 | , ("--show-key",1) | ||
591 | , ("--show-pem",1) | ||
592 | , ("--show-ssh",1) | ||
593 | , ("--show-wip",1) | ||
594 | , ("--help",0) | ||
595 | ] | ||
596 | argspec = map fst sargspec ++ ["--keyrings" | ||
597 | ,"--keypairs" | ||
598 | ,"--wallets" | ||
599 | ,"--hosts"] | ||
600 | -- "--bitcoin-keypairs" | ||
601 | -- Disabled. We shouldn't accept private key | ||
602 | -- data on the command line. | ||
603 | args' = if map (take 1) (take 1 vargs) == ["-"] | 646 | args' = if map (take 1) (take 1 vargs) == ["-"] |
604 | then vargs | 647 | then vargs |
605 | else "--keyrings":vargs | 648 | else defaultPoly:vargs |
649 | -- grouped args | ||
606 | gargs = (sargs ++) | 650 | gargs = (sargs ++) |
607 | . toLast (++trail) | 651 | . toLast (++trail) |
608 | . groupBy (\_ s-> take 1 s /= "-") | 652 | . groupBy (\_ s-> take 1 s /= "-") |
609 | $ args' | 653 | $ args' |
610 | appendArgs k xs opt = | 654 | appendArgs k xs opt = |
611 | if k `elem` argspec | 655 | if k `elem` argspec |
612 | then Just . maybe xs (++xs) $ opt | 656 | then Just . maybe xs (++xs) $ opt |
613 | else error . unlines $ [ "unrecognized option "++k | 657 | else error . unlines $ [ "unrecognized option "++k |
614 | , "Use --help for usage." ] | 658 | , "Use --help for usage." ] |
659 | |||
660 | data CommonArgsParsed = CommonArgsParsed { cap_homespec :: Maybe String, cap_passfd :: Maybe InputFile } | ||
661 | |||
662 | parseCommonArgs margs = CommonArgsParsed { cap_homespec = homespec, cap_passfd = passfd } | ||
663 | where | ||
664 | passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs | ||
665 | homespec = join . take 1 <$> Map.lookup "--homedir" margs | ||
666 | passfd = fmap (FileDesc . read) passphrase_fd | ||
667 | |||
668 | parseKeySpecs = map $ \specfile -> do | ||
669 | let (spec,efilecmd) = break (=='=') specfile | ||
670 | guard $ take 1 efilecmd=="=" | ||
671 | let filecmd = drop 1 efilecmd | ||
672 | let (file,bcmdb0) = break (=='{') filecmd | ||
673 | bcmdb = if null bcmdb0 then "{}" else bcmdb0 | ||
674 | guard $ take 1 bcmdb=="{" | ||
675 | let bdmcb = (dropWhile isSpace . reverse) bcmdb | ||
676 | guard $ take 1 bdmcb == "}" | ||
677 | let cmd = (drop 1 . reverse . drop 1) bdmcb | ||
678 | Just (spec,file,cmd) | ||
679 | |||
680 | --kiki :: (Eq a, Data.String.IsString a) => a -> [String] -> IO () | ||
681 | kiki "sync" args_raw = do | ||
682 | let (sargs,margs) = processArgs sargspec polyVariadicArgs "--keyrings" args_raw | ||
683 | sargspec = [ ("--import",0) | ||
684 | , ("--autosign",0) | ||
685 | , ("--import-if-authentic",0) | ||
686 | , ("--show-wk",0) | ||
687 | {-, ("--show-all",0) | ||
688 | , ("--show-whose-key",0) | ||
689 | , ("--show-key",1) | ||
690 | , ("--show-pem",1) | ||
691 | , ("--show-ssh",1) | ||
692 | , ("--show-wip",1) -} | ||
693 | , ("--help",0) | ||
694 | ] | ||
695 | polyVariadicArgs = ["--keyrings" | ||
696 | ,"--keypairs" | ||
697 | ,"--wallets" | ||
698 | ,"--hosts"] | ||
615 | -- putStrLn $ "margs = " ++ show (Map.assocs margs) | 699 | -- putStrLn $ "margs = " ++ show (Map.assocs margs) |
616 | unkeysRef <- newIORef Map.empty | 700 | unkeysRef <- newIORef Map.empty |
617 | pwRef <- newIORef Nothing | 701 | pwRef <- newIORef Nothing |
618 | let keypairs0 = | 702 | let keypairs0 = parseKeySpecs (fromMaybe [] $ Map.lookup "--keypairs" margs) |
619 | flip map (fromMaybe [] $ Map.lookup "--keypairs" margs) $ \specfile -> do | ||
620 | let (spec,efilecmd) = break (=='=') specfile | ||
621 | guard $ take 1 efilecmd=="=" | ||
622 | let filecmd = drop 1 efilecmd | ||
623 | let (file,bcmdb0) = break (=='{') filecmd | ||
624 | bcmdb = if null bcmdb0 then "{}" else bcmdb0 | ||
625 | guard $ take 1 bcmdb=="{" | ||
626 | let bdmcb = (dropWhile isSpace . reverse) bcmdb | ||
627 | guard $ take 1 bdmcb == "}" | ||
628 | let cmd = (drop 1 . reverse . drop 1) bdmcb | ||
629 | Just (spec,file,cmd) | ||
630 | keyrings_ = fromMaybe [] $ Map.lookup "--keyrings" margs | 703 | keyrings_ = fromMaybe [] $ Map.lookup "--keyrings" margs |
631 | wallets = fromMaybe [] $ Map.lookup "--wallets" margs | 704 | wallets = fromMaybe [] $ Map.lookup "--wallets" margs |
632 | passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs | 705 | passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs |
@@ -636,16 +709,16 @@ kiki "sync" args_raw = do | |||
636 | exitFailure | 709 | exitFailure |
637 | 710 | ||
638 | input_key <- maybe (return Nothing) | 711 | input_key <- maybe (return Nothing) |
639 | (const $ fmap (Just . readPublicKey) Char8.getContents) | 712 | (const $ fmap (Just . readPublicKey) Char8.getContents) |
640 | $ Map.lookup "--show-whose-key" margs | 713 | $ Map.lookup "--show-whose-key" margs |
641 | 714 | ||
642 | let keypairs = catMaybes keypairs0 | 715 | let keypairs = catMaybes keypairs0 |
643 | homespec = join . take 1 <$> Map.lookup "--homedir" margs | 716 | homespec = join . take 1 <$> Map.lookup "--homedir" margs |
644 | passfd = fmap (FileDesc . read) passphrase_fd | 717 | passfd = fmap (FileDesc . read) passphrase_fd |
645 | pems = flip map keypairs | 718 | pems = flip map keypairs |
646 | $ \(usage,path,cmd) -> | 719 | $ \(usage,path,cmd) -> |
647 | let cmd' = guard (not $ null cmd) >> return cmd | 720 | let cmd' = guard (not $ null cmd) >> return cmd |
648 | in (ArgFile path, (MutableRef cmd', PEMFile usage)) | 721 | in (ArgFile path, (MutableRef cmd', PEMFile usage)) |
649 | walts = map (\fname -> (ArgFile fname, (MutableRef Nothing, WalletFile))) | 722 | walts = map (\fname -> (ArgFile fname, (MutableRef Nothing, WalletFile))) |
650 | wallets | 723 | wallets |
651 | rings = map (\fname -> (ArgFile fname, (MutableRef Nothing, KeyRingFile passfd))) | 724 | rings = map (\fname -> (ArgFile fname, (MutableRef Nothing, KeyRingFile passfd))) |
@@ -674,19 +747,19 @@ kiki "sync" args_raw = do | |||
674 | , homeSpec = homespec | 747 | , homeSpec = homespec |
675 | } | 748 | } |
676 | 749 | ||
677 | KikiResult rt report <- runKeyRing kikiOp | 750 | KikiResult rt report <- runKeyRing kikiOp |
678 | 751 | ||
679 | case rt of | 752 | case rt of |
680 | KikiSuccess rt -> do -- interpret --show-* commands. | 753 | KikiSuccess rt -> do -- interpret --show-* commands. |
681 | let grip = rtGrip rt | 754 | let grip = rtGrip rt |
682 | let shspec = Map.fromList [("--show-wk", const $ show_wk (rtSecring rt) grip) | 755 | let shspec = Map.fromList [("--show-wk", const $ show_wk (rtSecring rt) grip) |
683 | ,("--show-all",const show_all) | 756 | {-,("--show-all",const show_all) |
684 | ,("--show-whose-key", const $ show_whose_key input_key) | 757 | ,("--show-whose-key", const $ show_whose_key input_key) |
685 | ,("--show-key",\[x] -> show_key x $ fromMaybe "" grip) | 758 | ,("--show-key",\[x] -> show_key x $ fromMaybe "" grip) |
686 | ,("--show-pem",\[x] -> show_pem x $ fromMaybe "" grip) | 759 | ,("--show-pem",\[x] -> show_pem x $ fromMaybe "" grip) |
687 | ,("--show-ssh",\[x] -> show_ssh x $ fromMaybe "" grip) | 760 | ,("--show-ssh",\[x] -> show_ssh x $ fromMaybe "" grip) |
688 | ,("--show-wip",\[x] -> show_wip x $ fromMaybe "" grip) | 761 | ,("--show-wip",\[x] -> show_wip x $ fromMaybe "" grip)-} |
689 | ,("--help", \_ _ ->kiki_usage)] | 762 | ,("--help", \_ _ ->kiki_sync_help)] |
690 | shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs | 763 | shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs |
691 | 764 | ||
692 | forM_ shargs $ \(cmd,args) -> cmd args (rtKeyDB rt) | 765 | forM_ shargs $ \(cmd,args) -> cmd args (rtKeyDB rt) |
@@ -698,18 +771,29 @@ kiki "sync" args_raw = do | |||
698 | kiki "working-key" args = do | 771 | kiki "working-key" args = do |
699 | kiki "sync" ["--show-wk"] | 772 | kiki "sync" ["--show-wk"] |
700 | 773 | ||
701 | kiki "help" args = do | 774 | -- Generic help |
775 | kiki "help" [] = do | ||
702 | putStrLn "Valid commands are:" | 776 | putStrLn "Valid commands are:" |
703 | let longest = maximum $ map (length . fst) commands | 777 | let longest = maximum $ map (length . fst) commands |
704 | pad cmd = take (longest+3) $ cmd ++ repeat ' ' | 778 | pad cmd = take (longest+3) $ cmd ++ repeat ' ' |
705 | forM commands $ \(cmd,help) -> do | 779 | forM commands $ \(cmd,help) -> do |
706 | putStrLn $ " " ++ pad cmd ++ help | 780 | putStrLn $ " " ++ pad cmd ++ help |
781 | putStr . unlines $ ["" | ||
782 | ,"See 'kiki help <command>' for more information on a specific command." | ||
783 | ] | ||
707 | return () | 784 | return () |
708 | 785 | ||
786 | kiki "help" args = forM_ args $ \arg -> case lookup arg commands of | ||
787 | Nothing -> putStrLn $ "No help available for commmand '" ++ arg ++ "'." | ||
788 | _ -> kiki arg ["--help"] | ||
789 | |||
790 | kiki "show" args = return () | ||
791 | |||
709 | commands :: [(String,String)] | 792 | commands :: [(String,String)] |
710 | commands = | 793 | commands = |
711 | [ ( "help", "display usage information" ) | 794 | [ ( "help", "display usage information" ) |
712 | , ( "sync", "update key files of various kinds by propogating information" ) | 795 | , ( "sync", "update key files of various kinds by propogating information" ) |
796 | , ( "show", "display information from your keyrings") | ||
713 | , ( "working-key", "show the current working master key and its subkeys" ) | 797 | , ( "working-key", "show the current working master key and its subkeys" ) |
714 | ] | 798 | ] |
715 | 799 | ||