1 files changed, 48 insertions, 3 deletions

diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 9513b0f..f89aad2 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -1,7 +1,8 @@
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE ViewPatterns      #-}
 module Kiki
     ( module Kiki
     , setVerifyFlag
@@ -48,9 +49,11 @@ import qualified SSHKey                     as SSH
 import           CommandLine
 import           DotLock
 import           GnuPGAgent                 (Query (..))
+import qualified IntMapClass as I
 import           KeyRing hiding (pemFromPacket)
 import           KeyDB
 import           KeyRing.BuildKeyDB (gpgipv6addr, Hostnames, allNames)
+import           TimeUtil
 
 withAgent :: [PassphraseSpec] -> [PassphraseSpec]
 withAgent [] = [PassphraseAgent]
@@ -763,6 +766,48 @@ verifyFile isHomeless cap keyrings filename = do
             _ -> do
                 hPutStrLn stderr "Unsupported file format."
 
+signFile :: Bool -> CommonArgsParsed -> [FilePath] -> String -> FilePath -> IO ()
+signFile isHomeless cap keyrings keyid filename = do
+    let mop = minimalOp isHomeless cap
+    KikiResult r report <- runKeyRing mop
+                                { opFiles = opFiles mop
+                                    `Map.union` Map.fromList
+                                        [ (ArgFile f, strm { access = Sec }) | f <- keyrings ]
+                                }
+    case r of
+        KikiSuccess rt -> go rt
+        err            -> hPutStrLn stderr $ errorString err
+ where
+    go :: KeyRingRuntime -> IO ()
+    go rt = do
+        tm <- modificationTime <$> getFileStatus filename
+        bs <- L.readFile filename
+        let hashed = [] -- TODO: FingerprintPacket
+            unhashed = [IssuerPacket keyid]
+            lit = LiteralDataPacket
+                    { format = 'b' -- b:binary, t:text, u:utf8
+                    , filename  = filename
+                    , timestamp = fromTime tm -- seconds since Jan 1, 1970 UTC
+                    , content = bs
+                    }
+            hash = SHA512
+            matchkey fp mp = matchpr fp (packet mp) == fp
+        case smallprGrip keyid of
+            Nothing -> hPutStrLn stderr "Bad keygrip."
+            Just grip -> do
+                let keydata = lookupByGrip grip (rtKeyDB rt)
+                case keydata of
+                    [] -> hPutStrLn stderr "No matching key."
+                    (k,_):_ -> rtPassphrases rt (Unencrypted,S2K 100 "") k >>= \case
+                        KikiSuccess un -> do
+                            mb <- pgpSign (Message [un]) (DataSignature lit []) hash keyid
+                            case mb of
+                                Nothing -> hPutStrLn stderr "Failed to make signature."
+                                Just o -> do
+                                    putStrLn $ "Using "++show (fingerprint un)++" to write " <> filename <> ".sig"
+                                    let sigs = map (\sig -> sig { unhashed_subpackets = unhashed }) (signatures_over o)
+                                    L.writeFile (filename <> ".sig") $ L.concat $ map encode sigs
+                        err -> hPutStrLn stderr $ errorString err
 
 parsePackets :: L.ByteString -> Either String [Packet]
 parsePackets bs = case decodeOrFail bs of