diff options
author | Joe Crayne <joe@jerkface.net> | 2019-07-06 17:26:54 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-07-06 17:26:54 -0400 |
commit | b1ae1ecdc9d1f16134ea40b07a6cedcc26a94db8 (patch) | |
tree | b46ce0c50abb65fdff3a80f5f072b9010c05294e /kiki.hs | |
parent | ea924c53e6ecb2148747353ce34ae7b0ea416d8c (diff) |
Quiet down some of the warnings.
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 24 |
1 files changed, 17 insertions, 7 deletions
@@ -122,6 +122,7 @@ listKeysFiltered grips pkts = do | |||
122 | subs0 <- map Left gs ++ map Right singles | 122 | subs0 <- map Left gs ++ map Right singles |
123 | let (top,subs) = case subs0 of Left subs1@((_,(top0,_),_,_,_):_) -> (top0,subs1) | 123 | let (top,subs) = case subs0 of Left subs1@((_,(top0,_),_,_,_):_) -> (top0,subs1) |
124 | Right top0 -> (top0,[]) | 124 | Right top0 -> (top0,[]) |
125 | Left [] -> error "groupBy returned an empty group?" | ||
125 | let subkeys = do | 126 | let subkeys = do |
126 | (code,(top,sub), kind, hashed,claimants) <- subs | 127 | (code,(top,sub), kind, hashed,claimants) <- subs |
127 | let ar = case code of | 128 | let ar = case code of |
@@ -129,6 +130,7 @@ listKeysFiltered grips pkts = do | |||
129 | 1 -> " --> " | 130 | 1 -> " --> " |
130 | 2 -> " <-- " | 131 | 2 -> " <-- " |
131 | 3 -> " <-> " | 132 | 3 -> " <-> " |
133 | _ -> error "Unknown signature scenario." | ||
132 | formkind = take kindcol $ defaultkind kind hashed ++ repeat ' ' | 134 | formkind = take kindcol $ defaultkind kind hashed ++ repeat ' ' |
133 | -- torhash = fromMaybe "" $ derToBase32 <$> derRSA sub | 135 | -- torhash = fromMaybe "" $ derToBase32 <$> derRSA sub |
134 | (netid,kind') = maybe (0x0,"bitcoin") | 136 | (netid,kind') = maybe (0x0,"bitcoin") |
@@ -656,6 +658,7 @@ kiki_usage ((== Export) -> bExport) ((== Import) -> bImport) ((== Secret) -> bSe | |||
656 | ,"" | 658 | ,"" |
657 | ] ++ syncflags ++ specifyingFiles | 659 | ] ++ syncflags ++ specifyingFiles |
658 | "spec" -> unlines keyspec | 660 | "spec" -> unlines keyspec |
661 | x -> "Undocumented command "++show x++"." | ||
659 | where | 662 | where |
660 | commonOptions :: [String] | 663 | commonOptions :: [String] |
661 | commonOptions = | 664 | commonOptions = |
@@ -1149,13 +1152,14 @@ moreMoreSync kikiOp sargs = do | |||
1149 | 1152 | ||
1150 | doTransform :: [String] -> ([String]->[Transform]) -> IO () | 1153 | doTransform :: [String] -> ([String]->[Transform]) -> IO () |
1151 | doTransform args mktrans = do | 1154 | doTransform args mktrans = do |
1152 | let (sargs,margs) = processArgs sargspec polyVariadicArgs "---" args | 1155 | let (_,margs) = processArgs sargspec polyVariadicArgs "---" args |
1153 | where sargspec = [] | 1156 | where sargspec = [] |
1154 | polyVariadicArgs = ["---"] | 1157 | polyVariadicArgs = ["---"] |
1155 | passfd = fmap (FileDesc . read) passphrase_fd | 1158 | passfd = fmap (FileDesc . read) passphrase_fd |
1156 | where passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs | 1159 | where passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs |
1157 | targs = fromMaybe [] $ Map.lookup "---" margs | 1160 | targs = fromMaybe [] $ Map.lookup "---" margs |
1158 | homespec = join . take 1 <$> Map.lookup "--homedir" margs | 1161 | homespec = join . take 1 <$> Map.lookup "--homedir" margs |
1162 | ts = mktrans targs | ||
1159 | kikiOp = KeyRingOperation | 1163 | kikiOp = KeyRingOperation |
1160 | { opFiles = Map.fromList $ | 1164 | { opFiles = Map.fromList $ |
1161 | [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) | 1165 | [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) |
@@ -1163,10 +1167,11 @@ doTransform args mktrans = do | |||
1163 | ] | 1167 | ] |
1164 | , opPassphrases = withAgent $ do pfile <- maybeToList passfd | 1168 | , opPassphrases = withAgent $ do pfile <- maybeToList passfd |
1165 | return $ PassphraseSpec Nothing Nothing pfile | 1169 | return $ PassphraseSpec Nothing Nothing pfile |
1166 | , opTransforms = mktrans targs | 1170 | , opTransforms = ts |
1167 | , opHome = homespec | 1171 | , opHome = homespec |
1168 | } | 1172 | } |
1169 | KikiResult rt report <- runKeyRing kikiOp | 1173 | KikiResult rt report <- if null ts then return $ KikiResult OperationCanceled [] |
1174 | else runKeyRing kikiOp | ||
1170 | forM_ report $ \(fname,act) -> do | 1175 | forM_ report $ \(fname,act) -> do |
1171 | putStrLn $ fname ++ ": " ++ reportString act | 1176 | putStrLn $ fname ++ ": " ++ reportString act |
1172 | case rt of | 1177 | case rt of |
@@ -1595,6 +1600,7 @@ kiki "rename" args | "--help" `elem` args = do | |||
1595 | 1600 | ||
1596 | kiki "rename" args = doTransform args rename | 1601 | kiki "rename" args = doTransform args rename |
1597 | where rename (oldtag:newtag:_) = [ RenameSubkeys oldtag newtag ] | 1602 | where rename (oldtag:newtag:_) = [ RenameSubkeys oldtag newtag ] |
1603 | rename _ = [] | ||
1598 | 1604 | ||
1599 | kiki "tar" args | "--help" `elem` args = do | 1605 | kiki "tar" args | "--help" `elem` args = do |
1600 | putStr . unlines $ | 1606 | putStr . unlines $ |
@@ -1641,6 +1647,12 @@ kiki "tar" args = do | |||
1641 | ["-A":_] -> putStrLn "unimplemented." -- import tar file? | 1647 | ["-A":_] -> putStrLn "unimplemented." -- import tar file? |
1642 | _ -> kiki "tar" ["--help"] | 1648 | _ -> kiki "tar" ["--help"] |
1643 | 1649 | ||
1650 | kiki cmd args = hPutStrLn stderr $ "I don't know how to "++cmd++"." | ||
1651 | |||
1652 | sshkeyname :: Packet -> [FilePath] | ||
1653 | sshkeyname SecretKeyPacket { key_algorithm = RSA } = ["id_rsa"] | ||
1654 | sshkeyname _ = [] | ||
1655 | |||
1644 | 1656 | ||
1645 | tarContent :: KeyRingRuntime | 1657 | tarContent :: KeyRingRuntime |
1646 | -> Maybe String | 1658 | -> Maybe String |
@@ -1653,7 +1665,6 @@ tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" | |||
1653 | ipsecs = do | 1665 | ipsecs = do |
1654 | (kk,ipsec,sigs) <- selectPublicKeyAndSigs (KeyUidMatch "",Just "ipsec") (rtKeyDB rt) | 1666 | (kk,ipsec,sigs) <- selectPublicKeyAndSigs (KeyUidMatch "",Just "ipsec") (rtKeyDB rt) |
1655 | let kd = (rtKeyDB rt Map.! kk) | 1667 | let kd = (rtKeyDB rt Map.! kk) |
1656 | k = packet $ keyMappedPacket kd | ||
1657 | (addr,(onames,ns)) = getHostnames kd | 1668 | (addr,(onames,ns)) = getHostnames kd |
1658 | oname <- onames | 1669 | oname <- onames |
1659 | return ("etc/ipsec.d/certs/" ++ Char8.unpack oname ++ ".pem", pubpem ns addr ipsec sigs) | 1670 | return ("etc/ipsec.d/certs/" ++ Char8.unpack oname ++ ".pem", pubpem ns addr ipsec sigs) |
@@ -1673,8 +1684,6 @@ tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" | |||
1673 | where | 1684 | where |
1674 | m = Map.singleton (keykey $ keyPacket kd) kd | 1685 | m = Map.singleton (keykey $ keyPacket kd) kd |
1675 | 1686 | ||
1676 | sshkeyname SecretKeyPacket { key_algorithm = RSA } = "id_rsa" | ||
1677 | |||
1678 | dir :: FilePath -> FilePath | 1687 | dir :: FilePath -> FilePath |
1679 | dir d = d -- TODO: prepend prefix path? | 1688 | dir d = d -- TODO: prepend prefix path? |
1680 | 1689 | ||
@@ -1684,7 +1693,8 @@ tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" | |||
1684 | kd <- secrets_kd | 1693 | kd <- secrets_kd |
1685 | let torkey = spem (dir "var/lib/tor/samizdat/private_key") <$> lookupSecret "tor" kd | 1694 | let torkey = spem (dir "var/lib/tor/samizdat/private_key") <$> lookupSecret "tor" kd |
1686 | sshcli = do k <- lookupSecret "ssh-client" kd | 1695 | sshcli = do k <- lookupSecret "ssh-client" kd |
1687 | return $ spem (dir $ homedir ++ "/.ssh/" ++ sshkeyname k) k | 1696 | keyname <- sshkeyname k |
1697 | return $ spem (dir $ homedir ++ "/.ssh/" ++ keyname) k | ||
1688 | sshsvr = spem (dir "etc/ssh/ssh_host_rsa_key") <$> lookupSecret "ssh-host" kd | 1698 | sshsvr = spem (dir "etc/ssh/ssh_host_rsa_key") <$> lookupSecret "ssh-host" kd |
1689 | ipseckey = do | 1699 | ipseckey = do |
1690 | k <- lookupSecret "ipsec" kd | 1700 | k <- lookupSecret "ipsec" kd |