WIP: verify command to verify clear-sign PGP signatures.

1 files changed, 60 insertions, 9 deletions

diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index d6a8b3a..20ab1f2 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -6,6 +6,8 @@ module Kiki
     , setVerifyFlag
     ) where
 
+import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor
+import           Codec.Encryption.OpenPGP.ASCIIArmor.Types
 import           Control.Applicative
 import           Control.Exception
 import           Control.Monad
@@ -95,7 +97,7 @@ ciphers = takeWhile notFallback $ map toEnum $ [0..4]++[7..]
 refresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO ()
 refresh root homepass = do
     let homepass' = homepass { cap_homespec = fmap root (cap_homespec homepass) }
-    KikiResult r report <- runKeyRing $ minimalOp homepass'
+    KikiResult r report <- runKeyRing $ minimalOp False homepass'
     let mroot = case root "" of
                     "/" -> Nothing
                     ""  -> Nothing
@@ -116,8 +118,8 @@ streaminfo = StreamInfo
     , transforms = []
     }
 
-minimalOp :: CommonArgsParsed -> KeyRingOperation
-minimalOp cap = op
+minimalOp :: Bool -> CommonArgsParsed -> KeyRingOperation
+minimalOp isHomeless cap = op
  where
     streaminfo = StreamInfo { fill = KF_None
                             , typ = KeyRingFile
@@ -127,10 +129,12 @@ minimalOp cap = op
                             , transforms = []
                             }
     op = KeyRingOperation
-        { opFiles = Map.fromList $
-            [ ( HomeSec, streaminfo { access = Sec })
-            , ( HomePub, streaminfo { access = Pub })
-            ]
+        { opFiles = if isHomeless
+                        then Map.empty
+                        else Map.fromList $
+                            [ ( HomeSec, streaminfo { access = Sec })
+                            , ( HomePub, streaminfo { access = Pub })
+                            ]
         , opPassphrases = withAgent $ do pfile <- maybeToList (cap_passfd cap)
                                          return $ PassphraseSpec Nothing Nothing pfile
         , opTransforms = []
@@ -501,7 +505,10 @@ refreshCache rt rootdir = do
     flip (maybe $ warn "missing working key?") (rtWorkingKey rt) $ \wk -> do
 
     let grip = fingerprint wk
-        exportOp = passphrases <> pemSecrets <> minimalOp (CommonArgsParsed (Just $ takeDirectory $ rtPubring rt) Nothing)
+        exportOp = passphrases <> pemSecrets
+                               <> minimalOp False
+                                            (CommonArgsParsed (Just $ takeDirectory $ rtPubring rt)
+                                                              Nothing)
          where
           passphrases = mempty { opPassphrases = [PassphraseMemoizer (rtPassphrases rt)] }
           pemSecrets = mempty { opFiles = Map.fromList
@@ -663,7 +670,7 @@ replaceSshServerKeys root cmn = do
                 strm = streaminfo { typ = PEMFile, spill = KF_Match "ssh-server", access = Sec }
                 delssh strm = strm { transforms = DeleteSubkeyByUsage "ssh-server" : transforms strm
                                    , fill = KF_All }
-    KikiResult r report <- runKeyRing $ minimalOp homepass'
+    KikiResult r report <- runKeyRing $ minimalOp False homepass'
     case r of
         KikiSuccess rt -> Kiki.refreshCache rt $ case root "" of
                                                     "/" -> Nothing
@@ -694,3 +701,47 @@ kikiOptions = ( ss, ps )
  where
     ss = [("--chroot",1),("--passphrase-fd",1),("--homedir",1),("--cipher",1)]
     ps = []
+
+verifyFile :: Bool -> CommonArgsParsed -> [FilePath] -> FilePath -> IO ()
+verifyFile isHomeless cap keyrings filename = do
+    let mop = minimalOp isHomeless cap
+    KikiResult r report <- runKeyRing mop
+                                { opFiles = opFiles mop
+                                    `Map.union` Map.fromList
+                                        [ (ArgFile f, strm { access = Pub }) | f <- keyrings ]
+                                }
+    case r of
+        KikiSuccess rt -> go rt
+        err            -> hPutStrLn stderr $ errorString err
+ where
+    go :: KeyRingRuntime -> IO ()
+    go rt = do
+        bs <- L.readFile filename
+        case ASCIIArmor.decodeLazy bs of
+            Right (ClearSigned hashes txt (Armor ArmorSignature _ sig):_) ->
+                case parsePackets sig of
+                    Right sigs -> do
+                        let over = DataSignature lit sigs
+                            lit = LiteralDataPacket
+                                    { format    = error "format" :: Char
+                                    , filename  = filename
+                                    , timestamp = error "timestamp" :: Word32
+                                    , content   = bs
+                                    }
+                            -- TODO: Remove this take 1 after optimizing 'candidateSignerKeys'
+                            tentativeTake1 xs = take 1 xs
+                            keys = concatMap (candidateSignerKeys (rtKeyDB rt)) $ tentativeTake1 sigs
+                            good = verify (Message keys) over
+                        putStrLn $ "verifyFile: " ++ show (length $ signatures_over good)
+                    rs -> do
+                        hPutStrLn stderr $ show rs
+            _ -> do
+                hPutStrLn stderr "Unsupported file format."
+
+
+parsePackets :: L.ByteString -> Either String [Packet]
+parsePackets bs = case decodeOrFail bs of
+                Left  (more,off,er)  -> Left er
+                Right (more,off,pkt) -> do
+                    if (more/=L.empty) then parsePackets more >>= \pkts -> Right (pkt : pkts)
+                                       else Right [pkt]