Better gpg-agent support.

1 files changed, 34 insertions, 13 deletions

diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 25c98e2..c042540 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -2,9 +2,10 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Kiki where
 
-import Control.Exception
 import Control.Applicative
 import Control.Arrow
+import Control.Concurrent
+import Control.Exception
 import Control.Monad
 import Data.ASN1.BinaryEncoding
 import Data.ASN1.Encoding
@@ -22,6 +23,7 @@ import System.FilePath.Posix
 import System.IO
 import System.IO.Temp
 import System.IO.Error
+import System.Posix.IO as Posix (createPipe)
 import System.Posix.User
 import System.Process
 import System.Posix.Files
@@ -37,6 +39,7 @@ import qualified Data.ByteString.Lazy.Char8 as Char8
 import qualified Data.Map.Strict as Map
 import qualified SSHKey as SSH
 
+import GnuPGAgent (Query(..))
 import CommandLine
 import KeyRing
 import DotLock
@@ -138,9 +141,9 @@ importAndRefresh root cmn = do
 
     let passfd = cap_passfd cmn
 
-    pwds <-
+    (torgen,pwds) <-
      if gotsec
-      then return []
+      then return (Generate 0 $ GenRSA $ 1024 `div` 8, [])
       else do
         {-  ssh-keygen to create master key...
         let mkpath = home ++ "/master-key"
@@ -154,36 +157,47 @@ importAndRefresh root cmn = do
                         HomeSec
                         ( encode $ Message [mk { is_subkey = False }] )
         -}
-        master_un <- (\k -> k { is_subkey = False }) <$> generateKey (GenRSA $ 4096 `div` 8 )
+        master_un <- (\k -> MappedPacket (k { is_subkey = False }) Map.empty) <$> generateKey (GenRSA $ 4096 `div` 8 )
+        tor_un <- generateKey (GenRSA $ 1024 `div` 8 )
+        (read_tor,write_tor) <- Posix.createPipe
+        do rs <- writeKeyToFile (streaminfo { typ = PEMFile, access = Sec, spill = KF_Match "tor", fill = KF_All }) (FileDesc write_tor) tor_un
+           -- outputReport $ map (first show) rs
+           return ()
         let default_cipher = (CAST5 {- AES128 -}, IteratedSaltedS2K SHA1 4073382889203176146 7864320)
             ctx = InputFileContext secring pubring
+            main_passwds = withAgent $ do pfd <- maybeToList passfd
+                                          return $ PassphraseSpec Nothing Nothing pfd
             passwordop = KeyRingOperation
                             { opFiles = Map.empty
                             -- TODO: ask agent for new passphrase
-                            , opPassphrases = do pfd <- maybeToList passfd
-                                                 return $ PassphraseSpec Nothing Nothing pfd
+                            , opPassphrases = main_passwds
                             , opHome = homespec
                             , opTransforms = []
                             }
-        transcoder <- makeMemoizingDecrypter passwordop ctx Map.empty
-        master0 <- transcoder default_cipher $ MappedPacket master_un Map.empty
+        let uidentry = Map.singleton (keykey $ packet master_un)
+                        $ master_un { packet = Query (packet master_un)
+                                                     (torUIDFromKey tor_un)
+                                                     Nothing
+                                    }
+        transcoder <- makeMemoizingDecrypter passwordop ctx (Just master_un, uidentry)
+        master0 <- transcoder default_cipher master_un
         case master0 of
             KikiSuccess master -> do
                 mkdirFor secring
                 writeInputFileL ctx
                                 HomeSec
-                                $ encode $ Message [master { is_subkey = False}]
+                                $ encode $ Message [master]
                 putStrLn "Wrote master key"
-                return [PassphraseMemoizer transcoder]
+                return (FileDesc read_tor, [PassphraseMemoizer transcoder])
             er -> do
                 hPutStrLn stderr ("warning: " ++ errorString er)
                 hPutStrLn stderr "warning: keys will not be encrypted.";
                 mkdirFor secring
                 writeInputFileL ctx
                                 HomeSec
-                                $ encode $ Message [master_un { is_subkey = False}]
+                                $ encode $ Message [packet master_un]
                 putStrLn "Wrote master key"
-                return []
+                return (Generate 0 (GenRSA $ 1024 `div` 8 ), [])
     gotpub <- doesFileExist pubring
     when (not gotpub) $ do
         mkdirFor pubring
@@ -233,7 +247,14 @@ importAndRefresh root cmn = do
              { opFiles = Map.fromList $
                 [ ( HomeSec, buildStreamInfo KF_All KeyRingFile )
                 , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } )
-                , ( Generate 0 (GenRSA (1024 `div` 8)), strm { spill = KF_Match "tor" })
+                , ( torgen , case torgen of
+                                FileDesc _ -> StreamInfo { typ = PEMFile
+                                                         , fill = KF_Match "tor"
+                                                         , spill = KF_Match "tor"
+                                                         , access = Sec
+                                                         , initializer = NoCreate
+                                                         , transforms = [] }
+                                _          -> strm { spill = KF_Match "tor" })
                 , ( Generate 1 (GenRSA (1024 `div` 8)), strm { spill = KF_Match "ipsec" })
                 , ( ArgFile sshcpath, (peminfo 2048 "ssh-client") )
                 , ( ArgFile sshspath, (peminfo 2048 "ssh-server") )