combined secring/pubring paths into an InputFileContext structure.

1 files changed, 56 insertions, 49 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index d057cd4..85f2944 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -247,22 +247,22 @@ data KeyRingOperation = KeyRingOperation
     , homeSpec :: Maybe String
     }
 
-resolveInputFile :: FilePath -> FilePath -> InputFile -> [FilePath]
-resolveInputFile secring pubring = resolve
+resolveInputFile :: InputFileContext -> InputFile -> [FilePath]
+resolveInputFile ctx = resolve
  where
-    resolve HomeSec = return secring
-    resolve HomePub = return pubring
+    resolve HomeSec = return (homesecPath ctx)
+    resolve HomePub = return (homepubPath ctx)
     resolve (ArgFile f) = return f
     resolve _ = []
 
 
 filesToLock ::
-  KeyRingOperation -> FilePath -> FilePath -> [FilePath]
-filesToLock k secring pubring = do
+  KeyRingOperation -> InputFileContext -> [FilePath]
+filesToLock k ctx = do
     (f,stream) <- Map.toList (kFiles k)
     case fill stream of
         KF_None -> []
-        _       -> resolveInputFile secring pubring f
+        _       -> resolveInputFile ctx f
 
 
 -- kret :: a -> KeyRingOperation a
@@ -828,9 +828,20 @@ seek_key (KeyUidMatch pat) ps
     uidStr _                = ""
 
 
+data InputFileContext = InputFileContext
+    { homesecPath :: FilePath
+    , homepubPath :: FilePath
+    }
+
+
+readInputFileS :: InputFileContext -> InputFile -> IO S.ByteString
+readInputFileS ctx (FileDesc fd) = fdToHandle fd >>= S.hGetContents
+readInputFileS ctx inp = do
+    let fname = resolveInputFile ctx inp
+    fmap S.concat $ mapM S.readFile fname
 
-cachedContents :: FilePath -> FilePath -> InputFile -> IO (IO S.ByteString)
-cachedContents secring pubring fd = do
+cachedContents :: InputFileContext -> InputFile -> IO (IO S.ByteString)
+cachedContents ctx fd = do
     ref <- newIORef Nothing
     return $ get ref fd
  where
@@ -839,15 +850,10 @@ cachedContents secring pubring fd = do
     get ref fd = do
         pw <- readIORef ref
         flip (flip maybe return) pw $ do
-            pw <- fmap trimCR $ getContents fd
+            pw <- fmap trimCR $ readInputFileS ctx fd
             writeIORef ref (Just pw)
             return pw
 
-    getContents (FileDesc fd) = fdToHandle fd >>= S.hGetContents
-    getContents inp = do
-        let fname = resolveInputFile secring pubring inp
-        fmap S.concat $ mapM S.readFile fname
-
 importPEMKey ::
   (MappedPacket -> IO (KikiCondition Packet))
   -> KikiCondition
@@ -863,9 +869,7 @@ importPEMKey doDecrypt db' tup = do
             return $ KikiSuccess (db'', report0 ++ report)
 
 
-mergeHostFiles :: KeyRingOperation -> KeyDB
-                -> FilePath
-                -> FilePath
+mergeHostFiles :: KeyRingOperation -> KeyDB -> InputFileContext
      -> IO
           (KikiCondition
              ( ( Map.Map [Char8.ByteString] KeyData
@@ -875,14 +879,14 @@ mergeHostFiles :: KeyRingOperation -> KeyDB
                  , [(SockAddr, ([Char8.ByteString], [Char8.ByteString]))]
                  , [SockAddr]))
              , [(FilePath,KikiReportAction)]))
-mergeHostFiles krd db secring pubring = do
+mergeHostFiles krd db ctx = do
     let hns = files ishosts
         ishosts Hosts = True
         ishosts _     = False
         files istyp = do
             (f,stream) <- Map.toList (kFiles krd)
             guard (istyp $ typ stream)
-            resolveInputFile secring pubring f
+            resolveInputFile ctx f
 
     hostdbs0 <- mapM (fmap Hosts.decode . L.readFile) hns
 
@@ -924,16 +928,14 @@ mergeHostFiles krd db secring pubring = do
     return $ KikiSuccess ((db',(hostdbs0,hostdbs,u1,gpgnames,outgoing_names)),[])
 
 writeHostsFiles
-  :: KeyRingOperation
-     -> [Char]
-     -> [Char]
+  :: KeyRingOperation -> InputFileContext
      -> ([Hosts.Hosts],
          [Hosts.Hosts],
          Hosts.Hosts,
          [(SockAddr, (t1, [Char8.ByteString]))],
          [SockAddr])
      -> IO [(FilePath, KikiReportAction)]
-writeHostsFiles krd secring pubring (hostdbs0,hostdbs,u1,gpgnames,outgoing_names) = do
+writeHostsFiles krd ctx (hostdbs0,hostdbs,u1,gpgnames,outgoing_names) = do
     let hns = files isMutableHosts
         isMutableHosts (fill -> KF_None) = False
         isMutableHosts (typ -> Hosts)    = True
@@ -941,7 +943,7 @@ writeHostsFiles krd secring pubring (hostdbs0,hostdbs,u1,gpgnames,outgoing_names
         files istyp = do
             (f,stream) <- Map.toList (kFiles krd)
             guard (istyp stream)
-            resolveInputFile secring pubring f
+            resolveInputFile ctx f
 
     -- 3. add hostnames from gpg for addresses not in U
     let u = foldl' f u1 ans
@@ -964,7 +966,7 @@ writeHostsFiles krd secring pubring (hostdbs0,hostdbs,u1,gpgnames,outgoing_names
 
 
 buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet))
-              -> FilePath -> FilePath -> Maybe String -> KeyRingOperation
+              -> InputFileContext -> Maybe String -> KeyRingOperation
               -> IO (KikiCondition ((KeyDB
                                     ,Maybe String
                                     ,Maybe MappedPacket
@@ -976,17 +978,17 @@ buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet))
                                     ,Map.Map FilePath Access
                                     )
                                    ,[(FilePath,KikiReportAction)]))
-buildKeyDB doDecrypt secring pubring grip0 keyring = do
+buildKeyDB doDecrypt ctx grip0 keyring = do
     let 
         files isring = do
             (f,stream) <- Map.toList (kFiles keyring)
             guard (isring $ typ stream)
-            resolveInputFile secring pubring f
+            resolveInputFile ctx f
 
         filesAccs isring = do
             (f,stream) <- Map.toList (kFiles keyring)
             guard (isring $ typ stream)
-            n <- resolveInputFile secring pubring f
+            n <- resolveInputFile ctx f
             return (n, access stream)
 
         readp (n,acc) = fmap readp0 $ readPacketsFromFile n
@@ -1020,8 +1022,8 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do
               where
                 fstkey = listToMaybe $ mapMaybe isSecringKey ms
                           where isSecringKey ((fn,_),Message ps)
-                                    | fn==secring = listToMaybe ps
-                                isSecringKey _  = Nothing
+                                    | fn==homesecPath ctx = listToMaybe ps
+                                isSecringKey _            = Nothing
             db_rings = foldl' (\db ((fname,_),ps) -> merge db fname ps) Map.empty ms
 
             wk = listToMaybe $ do
@@ -1049,7 +1051,7 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do
     let pems = do
             (n,stream) <- Map.toList $ kFiles keyring
             grip <- maybeToList grip
-            n <- resolveInputFile secring pubring n
+            n <- resolveInputFile ctx n
             guard $ spillable stream && ispem (typ stream)
             let us = mapMaybe usageFromFilter [fill stream,spill stream]
             usage <- take 1 us
@@ -1063,7 +1065,7 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do
     db <- foldM (importPEMKey doDecrypt) (KikiSuccess (db,[])) imports
     try db $ \(db,reportPEMs) -> do
 
-    r <- mergeHostFiles keyring db secring pubring
+    r <- mergeHostFiles keyring db ctx
     try r $ \((db,hs),reportHosts) -> do
 
     return $ KikiSuccess ( (db, grip, mwk, hs, accs), reportWallets ++ reportPEMs )
@@ -1289,7 +1291,7 @@ writeWalletKeys krd db wk = do
         files pred = do
             (f,stream) <- Map.toList (kFiles krd)
             guard (pred stream)
-            resolveInputFile "" "" f
+            resolveInputFile (InputFileContext "" "") f
     let writeWallet report n = do
         let cs' = do
             (nw,mp) <- cs
@@ -1370,11 +1372,12 @@ writeRingKeys krd rt {- db wk secring pubring -} = do
         db = rtKeyDB rt
         secring = rtSecring rt
         pubring = rtPubring rt
+        ctx = InputFileContext secring pubring
     let s = do
         (f,f0,stream) <- do
             (f0,stream) <- Map.toList (kFiles krd)
             guard (isring $ typ stream)
-            f <- resolveInputFile secring pubring f0
+            f <- resolveInputFile ctx f0
             return (f,f0,stream)
         let x = do
                 let wantedForFill :: Access -> KeyFilter -> KeyData -> Maybe Bool
@@ -1533,15 +1536,15 @@ writePEMKeys doDecrypt db exports = do
         try pun $ \pun -> do
         return $ KikiSuccess (fname,pun)
 
-makeMemoizingDecrypter :: KeyRingOperation -> FilePath -> FilePath
+makeMemoizingDecrypter :: KeyRingOperation -> InputFileContext
                         -> IO (MappedPacket -> IO (KikiCondition Packet))
-makeMemoizingDecrypter operation secring pubring = do
+makeMemoizingDecrypter operation ctx = do
     pws <-
         -- TODO: head will throw an exception if a File Descriptor operation
         -- file is present.  We probably should change OriginMap to use InputFile
         -- instead of FilePath.
-        Traversable.mapM (cachedContents secring pubring . fromJust . pwfile . typ)
-                         (Map.mapKeys (head . resolveInputFile secring pubring)
+        Traversable.mapM (cachedContents ctx . fromJust . pwfile . typ)
+                         (Map.mapKeys (head . resolveInputFile ctx)
                             $ Map.filter (isJust . pwfile . typ) $ kFiles operation)
     unkeysRef <- newIORef Map.empty
     return $ doDecrypt unkeysRef pws
@@ -1630,7 +1633,7 @@ performManipulations doDecrypt operation rt wk = do
 
 initializeMissingPEMFiles ::
     KeyRingOperation
-      -> FilePath -> FilePath -> Maybe String
+      -> InputFileContext -> Maybe String
       -> (MappedPacket -> IO (KikiCondition Packet))
       -> KeyDB
       -> IO (KikiCondition ( (KeyDB,[( FilePath
@@ -1638,11 +1641,11 @@ initializeMissingPEMFiles ::
                                      , [MappedPacket]
                                      , Maybe Initializer)])
                            , [(FilePath,KikiReportAction)]))
-initializeMissingPEMFiles operation secring pubring grip decrypt db = do
+initializeMissingPEMFiles operation ctx grip decrypt db = do
         nonexistents <-
            filterM (fmap not . doesFileExist . fst)
                $ do (f,t) <- Map.toList (kFiles operation)
-                    f <- resolveInputFile secring pubring f
+                    f <- resolveInputFile ctx f
                     return (f,t)
 
         let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do
@@ -1715,7 +1718,10 @@ runKeyRing operation = do
                    Left e -> return $ KikiResult e []
                    Right wkun -> body wkun
     try' homedir $ \(homedir,secring,pubring,grip0) -> do
-    let tolocks = filesToLock operation secring pubring
+    let ctx = InputFileContext secring pubring
+        tolocks = filesToLock operation ctx 
+    secring <- return Nothing
+    pubring <- return Nothing
     lks <- forM tolocks $ \f -> do
         lk <- dotlock_create f 0
         v <- flip (maybe $ return Nothing) lk $ \lk -> do
@@ -1732,21 +1738,22 @@ runKeyRing operation = do
         -- memoizing decrypter
         -- TODO: Unspilled keyrings should be usable for decrypting
         --       and signing.
-        decrypt <- makeMemoizingDecrypter operation secring pubring
+        decrypt <- makeMemoizingDecrypter operation ctx
 
         -- merge all keyrings, PEM files, and wallets
-        bresult <- buildKeyDB decrypt secring pubring grip0 operation
+        bresult <- buildKeyDB decrypt ctx grip0 operation
         try' bresult $ \((db,grip,wk,hs,accs),report_imports) -> do
 
         externals_ret <- initializeMissingPEMFiles operation
-                                                   secring pubring grip
+                                                   ctx
+                                                   grip
                                                    decrypt
                                                    db
         try' externals_ret $ \((db,exports),report_externals) -> do
 
         let rt = KeyRingRuntime
-                       { rtPubring = pubring
-                       , rtSecring = secring
+                       { rtPubring = homepubPath ctx
+                       , rtSecring = homesecPath ctx
                        , rtGrip = grip
                        , rtWorkingKey = fmap packet wk
                        , rtKeyDB = db
@@ -1768,7 +1775,7 @@ runKeyRing operation = do
         r <- writePEMKeys decrypt (rtKeyDB rt) exports
         try' r $ \report_pems -> do
         
-        import_hosts <- writeHostsFiles operation secring pubring hs
+        import_hosts <- writeHostsFiles operation ctx hs
 
         return $ KikiResult (KikiSuccess rt)
                    $ concat [ report_imports