summaryrefslogtreecommitdiff
path: root/kiki.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-05-05 21:40:16 -0400
committerjoe <joe@jerkface.net>2014-05-05 21:40:16 -0400
commit9deb2a81dcfc3c4489824d5a753cbe03fe82c492 (patch)
tree1768763b39a8005f7c175bb9952949ac2eb54c7f /kiki.hs
parent67904f836d39cc844f85c2570d5a634d59a8f020 (diff)
better usage message for "merge" command
Diffstat (limited to 'kiki.hs')
-rw-r--r--kiki.hs200
1 files changed, 116 insertions, 84 deletions
diff --git a/kiki.hs b/kiki.hs
index f99a928..a7189f0 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -872,97 +872,129 @@ kiki "show" args = do
872 forM_ report $ \(fname,act) -> do 872 forM_ report $ \(fname,act) -> do
873 putStrLn $ fname ++ ": " ++ reportString act 873 putStrLn $ fname ++ ": " ++ reportString act
874 874
875kiki "merge" [] = do
876 putStr . unlines $
877 [ "kiki merge ( --home[=HOMEDIR]"
878 , " | --type=(keyring|pem|wallet|hosts)"
879 , " | --access=[auto|secret|public]"
880 , " | --flow=(fill|spill|sync)[,(subkeys|match=KEYSPEC)]"
881 , " | --create=CMD"
882 , " | --autosign[=no]"
883 , " | --"
884 , " | FILE ) ..."]
885kiki "merge" args | "--help" `elem` args = do
886 kiki "merge" []
887 -- TODO: more help
875kiki "merge" args = do 888kiki "merge" args = do
876 let op = snd $ foldl' buildOp (flow,noop) args
877 noop = KeyRingOperation
878 { opFiles = Map.empty
879 , opTransforms = []
880 , opHome = Nothing
881 , opPassphrases = []
882 }
883 flow = StreamInfo
884 { access = AutoAccess
885 , typ = KeyRingFile
886 , spill = KF_None
887 , fill = KF_None
888 , initializer = Nothing
889 , transforms = []
890 }
891 updateFlow fil spil mtch flow = spill' $ fill' $ flow
892 where
893 fill' flow = flow { fill = if fil then val else KF_None }
894 spill' flow = flow { spill = if spil then val else KF_None }
895 val = either (\subkeys -> if subkeys then KF_Subkeys else KF_All)
896 KF_Match
897 mtch
898 parseFlow spec =
899 if null bads
900 then Just ( ( "spill" `elem` goods
901 || "sync" `elem` goods
902 , "fill" `elem` goods
903 || "sync" `elem` goods )
904 , maybe (Left $ "subkeys" `elem` goods)
905 Right
906 match )
907 else Nothing
908 where
909 ws = case groupBy (\_ c->c/=',') spec of
910 w:xs -> w:map (drop 1) xs
911 [] -> []
912 (goods,bads) = partition acceptable ws
913 acceptable "spill" = True
914 acceptable "fill" = True
915 acceptable "sync" = True
916 acceptable "subkeys" = True
917 acceptable s | "match=" `isPrefixOf` s = True
918 acceptable _ = False
919 match = listToMaybe $ do
920 m <- filter ("match=" `isPrefixOf`) goods
921 return $ drop 6 m
922
923 buildOp (flow,op) arg =
924 case splitArg arg of
925 Right fname ->
926 ( flow
927 , op { opFiles= Map.insert (ArgFile fname) flow (opFiles op) })
928 Left ("autosign",Nothing) ->
929 if Map.null (opFiles op)
930 then (flow, op { opTransforms = opTransforms op ++ [Autosign] })
931 else (flow { transforms = transforms flow ++ [Autosign] }, op)
932 Left ("noautosign",Nothing) ->
933 ( flow { transforms = filter (/=Autosign) (transforms flow) }
934 , op { opTransforms = filter (/=Autosign) (opTransforms op) } )
935 Left ("create",Just cmd) ->
936 ( flow { initializer = if null cmd then Nothing else Just cmd }
937 , op )
938 Left ("type",Just "keyring") -> ( flow { typ = KeyRingFile }, op )
939 Left ("type",Just "pem" ) -> ( flow { typ = PEMFile }, op )
940 Left ("type",Just "wallet" ) -> ( flow { typ = WalletFile }, op )
941 Left ("type",Just "hosts" ) -> ( flow { typ = Hosts }, op )
942 Left ("access",Just "public") -> ( flow { access = Pub }, op )
943 Left ("access",Just "secret") -> ( flow { access = Sec }, op )
944 Left ("access",Just "auto") -> ( flow { access = AutoAccess }, op )
945 Left ("home",mb) ->
946 ( flow
947 , op { opFiles = Map.insert HomePub flow { access=Pub }
948 $ Map.insert HomeSec flow { access=Sec }
949 $ opFiles op
950 , opHome = opHome op `mplus` mb
951 }
952 )
953 Left ("flow",Just flowspec) ->
954 case parseFlow flowspec of
955 Just ( (fil,spil), mtch ) ->
956 ( updateFlow fil spil mtch flow
957 , op )
958 Nothing -> error "Valid flow words are: spill,fill,sync,subkeys or match=KEYSPEC"
959 Left (option,_) -> error $ "Unrecognized option: " ++ option
960 KikiResult rt report <- runKeyRing op 889 KikiResult rt report <- runKeyRing op
961 case rt of 890 case rt of
962 KikiSuccess rt -> return () 891 KikiSuccess rt -> return ()
963 err -> putStrLn $ errorString err 892 err -> putStrLn $ errorString err
964 forM_ report $ \(fname,act) -> do 893 forM_ report $ \(fname,act) -> do
965 putStrLn $ fname ++ ": " ++ reportString act 894 putStrLn $ fname ++ ": " ++ reportString act
895 where
896 (_,(_,op)) = foldl' buildOp (True,(flow,noop)) args
897 noop = KeyRingOperation
898 { opFiles = Map.empty
899 , opTransforms = []
900 , opHome = Nothing
901 , opPassphrases = []
902 }
903 flow = StreamInfo
904 { access = AutoAccess
905 , typ = KeyRingFile
906 , spill = KF_None
907 , fill = KF_None
908 , initializer = Nothing
909 , transforms = []
910 }
911 updateFlow fil spil mtch flow = spill' $ fill' $ flow
912 where
913 fill' flow = flow { fill = if fil then val else KF_None }
914 spill' flow = flow { spill = if spil then val else KF_None }
915 val = either (\subkeys -> if subkeys then KF_Subkeys else KF_All)
916 KF_Match
917 mtch
918 parseFlow spec =
919 if null bads
920 then Just ( ( "spill" `elem` goods
921 || "sync" `elem` goods
922 , "fill" `elem` goods
923 || "sync" `elem` goods )
924 , maybe (Left $ "subkeys" `elem` goods)
925 Right
926 match )
927 else Nothing
928 where
929 ws = case groupBy (\_ c->c/=',') spec of
930 w:xs -> w:map (drop 1) xs
931 [] -> []
932 (goods,bads) = partition acceptable ws
933 acceptable "spill" = True
934 acceptable "fill" = True
935 acceptable "sync" = True
936 acceptable "subkeys" = True
937 acceptable s | "match=" `isPrefixOf` s = True
938 acceptable _ = False
939 match = listToMaybe $ do
940 m <- filter ("match=" `isPrefixOf`) goods
941 return $ drop 6 m
942
943 doFile :: StreamInfo -> KeyRingOperation -> FilePath -> (StreamInfo,KeyRingOperation)
944 doFile flow op fname =
945 ( flow
946 , op { opFiles= Map.insert (ArgFile fname) flow (opFiles op) })
947
948 doAutosign :: Bool -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation)
949 doAutosign True flow op =
950 if Map.null (opFiles op)
951 then (flow, op { opTransforms = opTransforms op ++ [Autosign] })
952 else (flow { transforms = transforms flow ++ [Autosign] }, op)
953 doAutosign False flow op =
954 ( flow { transforms = filter (/=Autosign) (transforms flow) }
955 , op { opTransforms = filter (/=Autosign) (opTransforms op) } )
956
957 buildOp (False,(flow,op)) fname = (False,doFile flow op fname)
958 buildOp (True,(flow,op)) arg@(splitArg->parsed) =
959 case parsed of
960 Left ("",Nothing) -> (False,(flow,op))
961 _ -> (True,) dispatch
962 where
963 dispatch =
964 case parsed of
965 Right fname -> doFile flow op fname
966 Left ("autosign",Nothing) -> doAutosign True flow op
967 Left ("autosign",Just "y") -> doAutosign True flow op
968 Left ("autosign",Just "yes") -> doAutosign True flow op
969 Left ("autosign",Just "true") -> doAutosign True flow op
970 Left ("autosign",Just "n") -> doAutosign False flow op
971 Left ("autosign",Just "no") -> doAutosign False flow op
972 Left ("autosign",Just "false")-> doAutosign False flow op
973 Left ("create",Just cmd) ->
974 ( flow { initializer = if null cmd then Nothing else Just cmd }
975 , op )
976 Left ("type",Just "keyring") -> ( flow { typ = KeyRingFile }, op )
977 Left ("type",Just "pem" ) -> ( flow { typ = PEMFile }, op )
978 Left ("type",Just "wallet" ) -> ( flow { typ = WalletFile }, op )
979 Left ("type",Just "hosts" ) -> ( flow { typ = Hosts }, op )
980 Left ("access",Just "public") -> ( flow { access = Pub }, op )
981 Left ("access",Just "secret") -> ( flow { access = Sec }, op )
982 Left ("access",Just "auto") -> ( flow { access = AutoAccess }, op )
983 Left ("home",mb) ->
984 ( flow
985 , op { opFiles = Map.insert HomePub flow { access=Pub }
986 $ Map.insert HomeSec flow { access=Sec }
987 $ opFiles op
988 , opHome = opHome op `mplus` mb
989 }
990 )
991 Left ("flow",Just flowspec) ->
992 case parseFlow flowspec of
993 Just ( (fil,spil), mtch ) ->
994 ( updateFlow fil spil mtch flow
995 , op )
996 Nothing -> error "Valid flow words are: spill,fill,sync,subkeys or match=KEYSPEC"
997 Left (option,_) -> error $ "Unrecognized option: " ++ option
966 998
967splitArg :: String -> Either (String,Maybe String) String 999splitArg :: String -> Either (String,Maybe String) String
968splitArg arg = 1000splitArg arg =
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-29 09:42:01 +0000