From b1ae1ecdc9d1f16134ea40b07a6cedcc26a94db8 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Sat, 6 Jul 2019 17:26:54 -0400
Subject: Quiet down some of the warnings.

---
 kiki.hs | 24 +++++++++++++++++-------
 1 file changed, 17 insertions(+), 7 deletions(-)

(limited to 'kiki.hs')

diff --git a/kiki.hs b/kiki.hs
index 6a62312..47462a7 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -122,6 +122,7 @@ listKeysFiltered grips pkts = do
     subs0 <- map Left gs ++ map Right singles
     let (top,subs) = case subs0 of Left subs1@((_,(top0,_),_,_,_):_) -> (top0,subs1)
                                    Right top0                        -> (top0,[])
+                                   Left [] -> error "groupBy returned an empty group?"
     let subkeys = do
             (code,(top,sub), kind, hashed,claimants) <- subs
             let ar = case code of
@@ -129,6 +130,7 @@ listKeysFiltered grips pkts = do
                         1 -> " --> "
                         2 -> " <-- "
                         3 -> " <-> "
+                        _ -> error "Unknown signature scenario."
                 formkind = take kindcol $ defaultkind kind hashed ++ repeat ' '
                 -- torhash = fromMaybe "" $ derToBase32 <$> derRSA sub
                 (netid,kind') = maybe (0x0,"bitcoin")
@@ -656,6 +658,7 @@ kiki_usage ((== Export) -> bExport) ((== Import) -> bImport) ((== Secret) -> bSe
             ,""
             ] ++ syncflags ++ specifyingFiles
          "spec" -> unlines keyspec
+         x -> "Undocumented command "++show x++"."
         where
             commonOptions :: [String]
             commonOptions =
@@ -1149,13 +1152,14 @@ moreMoreSync kikiOp sargs = do
 
 doTransform :: [String] -> ([String]->[Transform]) -> IO ()
 doTransform args mktrans = do
-    let (sargs,margs) = processArgs sargspec polyVariadicArgs "---" args
+    let (_,margs) = processArgs sargspec polyVariadicArgs "---" args
             where sargspec = []
                   polyVariadicArgs = ["---"]
         passfd = fmap (FileDesc . read) passphrase_fd
             where passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs
         targs = fromMaybe [] $ Map.lookup "---" margs
         homespec = join . take 1 <$> Map.lookup "--homedir" margs
+        ts = mktrans targs
         kikiOp = KeyRingOperation
             { opFiles = Map.fromList $
                 [ ( HomeSec, buildStreamInfo KF_All KeyRingFile )
@@ -1163,10 +1167,11 @@ doTransform args mktrans = do
                 ]
             , opPassphrases = withAgent $ do pfile <- maybeToList passfd
                                              return $ PassphraseSpec Nothing Nothing pfile
-            , opTransforms = mktrans targs
+            , opTransforms = ts
             , opHome = homespec
             }
-    KikiResult rt report <- runKeyRing kikiOp
+    KikiResult rt report <- if null ts then return $ KikiResult OperationCanceled []
+                                       else runKeyRing kikiOp
     forM_ report $ \(fname,act) -> do
         putStrLn $ fname ++ ": " ++ reportString act
     case rt of
@@ -1595,6 +1600,7 @@ kiki "rename" args | "--help" `elem` args = do
 
 kiki "rename" args = doTransform args rename
  where rename (oldtag:newtag:_) = [ RenameSubkeys oldtag newtag ]
+       rename _                 = []
 
 kiki "tar" args | "--help" `elem` args = do
     putStr . unlines $
@@ -1641,6 +1647,12 @@ kiki "tar" args = do
         ["-A":_] -> putStrLn "unimplemented." -- import tar file?
         _ -> kiki "tar" ["--help"]
 
+kiki cmd args = hPutStrLn stderr $ "I don't know how to "++cmd++"."
+
+sshkeyname :: Packet -> [FilePath]
+sshkeyname SecretKeyPacket { key_algorithm = RSA } = ["id_rsa"]
+sshkeyname _ = []
+
 
 tarContent :: KeyRingRuntime
            -> Maybe String
@@ -1653,7 +1665,6 @@ tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root"
     ipsecs = do
         (kk,ipsec,sigs) <- selectPublicKeyAndSigs (KeyUidMatch "",Just "ipsec") (rtKeyDB rt)
         let kd = (rtKeyDB rt Map.! kk)
-            k = packet $ keyMappedPacket kd
             (addr,(onames,ns)) = getHostnames kd
         oname <- onames
         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"
       where
         m = Map.singleton (keykey $ keyPacket kd) kd
 
-    sshkeyname SecretKeyPacket { key_algorithm = RSA } = "id_rsa"
-
     dir :: FilePath -> FilePath
     dir d = d -- TODO: prepend prefix path?
 
@@ -1684,7 +1693,8 @@ tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root"
         kd <- secrets_kd
         let torkey = spem (dir "var/lib/tor/samizdat/private_key") <$> lookupSecret "tor" kd
             sshcli = do k <- lookupSecret "ssh-client" kd
-                        return $ spem (dir $ homedir ++ "/.ssh/" ++ sshkeyname k) k
+                        keyname <- sshkeyname k
+                        return $ spem (dir $ homedir ++ "/.ssh/" ++ keyname) k
             sshsvr = spem (dir "etc/ssh/ssh_host_rsa_key") <$> lookupSecret "ssh-host" kd
             ipseckey = do
                 k <- lookupSecret "ipsec" kd
-- 
cgit v1.2.3