Quiet down some of the warnings.

4 files changed, 34 insertions, 18 deletions

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
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index dd204d1..9a806a3 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -673,7 +673,13 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs)
     whatP (a,_) = concat . take 1 . words . show $ a
 
 
--- insertSubkey :: (MappedPacket -> IO (KikiCondition Packet)) -> t -> KeyData -> [SignatureSubpacket] -> [Char] -> Packet -> IO (KikiCondition (KeyData, [([Char], KikiReportAction)]))
+insertSubkey :: PacketTranscoder
+                      -> keykey
+                      -> KeyData
+                      -> [SignatureSubpacket]
+                      -> InputFile
+                      -> Packet
+                      -> IO (KikiCondition (KeyData, [(FilePath, KikiReportAction)]))
 insertSubkey transcode kk (KeyData top topsigs uids subs) tags inputfile key0 = do
     let topcipher = symmetric_algorithm $ packet top
         tops2k    = s2k $ packet top
diff --git a/lib/PacketTranscoder.hs b/lib/PacketTranscoder.hs
index 830ec2f..730a221 100644
--- a/lib/PacketTranscoder.hs
+++ b/lib/PacketTranscoder.hs
@@ -106,9 +106,9 @@ interpretPassSpec :: InputFileContext
                         -> (Maybe MappedPacket, Map.Map KeyKey (OriginMapped Query))
                         -> PassphraseSpec
                         -> IO (KikiCondition (PassphraseSource, IO ()) )
-interpretPassSpec ctx keys PassphraseSpec { passSpecPassFile = fd
-                                          , passSpecKeySpec = keyspec
-                                          , passSpecRingFile = inputfile } = do
+interpretPassSpec ctx _ PassphraseSpec { passSpecPassFile = fd
+                                       , passSpecKeySpec = keyspec
+                                       , passSpecRingFile = inputfile } = do
     getpw <-
         cachedContents (Just "Enter possibly multi-line passphrase (Press CTRL-D when finished):\n")
                        ctx
@@ -241,6 +241,7 @@ transcodeWithCache unkeysRef miss alg0 mp@MappedPacket{ packet = wk } = do
             else maybe (miss alg mp) (return . KikiSuccess)
                     $ Map.lookup (keykey wk,fst alg, snd alg) unkeys
 
+tryInOrder :: [PacketTranscoder] -> PacketTranscoder
 tryInOrder [] _ _        = return BadPassphrase
 tryInOrder [f] alg mp    = f alg mp
 tryInOrder (f:fs) alg mp = do
diff --git a/lib/Transforms.hs b/lib/Transforms.hs
index 664cf86..adb7830 100644
--- a/lib/Transforms.hs
+++ b/lib/Transforms.hs
@@ -343,17 +343,16 @@ getBindings ::
   ->
     ( [([Packet],[SignatureOver])] --  other signatures with key sets
                                    --  that were used for the verifications
-    , [(Word8,
-       (Packet, Packet), -- (topkey,subkey)
-       [String],         -- usage flags
+    , [(Word8,               -- 1-master, 2-subkey, 0-other(see last element of tuple)
+       (Packet, Packet),     -- (topkey,subkey)
+       [String],             -- usage flags
        [SignatureSubpacket], -- hashed data
-       [Packet])] -- binding signatures
+       [Packet])]            -- binding signatures
     )
 getBindings pkts = (sigs,bindings)
  where
     (sigs,concat->bindings) = unzip $ do
-        let (keys,_) = partition isKey pkts
-        keys <- disjoint_fp keys
+        keys <- disjoint_fp (filter isKey pkts)
         let (bs,sigs) = verifyBindings keys pkts
         return . ((keys,sigs),) $ do
             b <- bs -- trace ("sigs = "++show (map (map signature_issuer . signatures_over) sigs)) bs
@@ -370,7 +369,7 @@ getBindings pkts = (sigs,bindings)
             return (code,(topkey b,subkey b), kind, hashed,claimants)
 
 
--- Returned data is simmilar to getBindings but the Word8 codes
+-- Returned data is similar to getBindings but the Word8 codes
 -- are ORed together.
 accBindings ::
   Bits t =>