create nonexistent PEM files via external shell commands

1 files changed, 55 insertions, 26 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index d5eb9ea..798ad38 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -51,6 +51,7 @@ import qualified CryptoCoins as CryptoCoins
 import Base58
 import FunctorToMaybe
 import DotLock
+import ProcessUtils (systemEnv, ExitCode(ExitFailure, ExitSuccess) )
 
 -- DER-encoded elliptic curve ids
 nistp256_id  = 0x2a8648ce3d030107
@@ -68,19 +69,27 @@ home = HomeDir
     , optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"]
     }
 
-data InputFile = HomeSec | HomePub | ArgFile FilePath | FileDesc Int
+data InputFile = HomeSec
+               | HomePub
+               | ArgFile FilePath
+               | FileDesc Int
 
 type UsageTag = String
 type Initializer = String
 type PassWordFile = InputFile
 
-data FileType = KeyRingFile PassWordFile | PEMFile UsageTag | WalletFile
+data FileType = KeyRingFile PassWordFile
+              | PEMFile UsageTag
+              | WalletFile -- (Maybe UsageTag)
 
 data RefType = ConstRef | MutableRef (Maybe Initializer)
 
 initializer (MutableRef x) = x
 initializer _              = Nothing
 
+getUsage (PEMFile usage) = return usage
+getUsage _               = mzero
+
 
 data KeyRingRuntime = KeyRingRuntime
                         { rtPubring :: FilePath
@@ -247,6 +256,8 @@ data KikiReportAction =
         | YieldSecretKeyPacket String
         | UnableToUpdateExpiredSignature
         | WarnFailedToMakeSignature
+        | FailedExternal Int
+        | ExternallyGeneratedFile
 
 data KikiResult a = KikiResult
     { kikiCondition :: KikiCondition a
@@ -480,6 +491,8 @@ data KeySpec =
     | KeyUidMatch String
  deriving Show
 
+-- | Parse a key specification.
+-- The first argument is a grip for the default working key.
 parseSpec :: String -> String -> (KeySpec,Maybe String)
 parseSpec grip spec = (topspec,subspec)
  where
@@ -525,11 +538,8 @@ buildKeyDB secring pubring grip0 keyring = do
     let isring (KeyRingFile {}) = True
         isring _                = False
 
-        getUsage (PEMFile usage) = return usage
-        getUsage _               = mzero
-
-        iswallet WalletFile = True
-        iswallet _          = False
+        iswallet (WalletFile {}) = True
+        iswallet _               = False
 
         files isring = do
             (f,(rtyp,ftyp)) <- Map.toList (kFiles keyring)
@@ -812,7 +822,7 @@ writeWalletKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(F
 writeWalletKeys krd db wk = do
     let cs = db `coinKeysOwnedBy` wk
     -- export wallet keys
-        isMutableWallet (MutableRef {}) WalletFile = True
+        isMutableWallet (MutableRef {}) (WalletFile {}) = True
         isMutableWallet _ _ = False
         files pred = do
             (f,(rtyp,ftyp)) <- Map.toList (kFiles krd)
@@ -853,11 +863,6 @@ writeRingKeys :: KeyRingData -> KeyDB -> Maybe Packet
                 -> IO (KikiCondition [(FilePath,KikiReportAction)])
 writeRingKeys krd db wk secring pubring = do
     let ks = Map.elems db
-        {-
-        fs = Map.keys (foldr unionfiles Map.empty ks)
-                where unionfiles (KeyData p _ _ _) m =
-                        Map.union m (locations p)
-        -}
         isring (KeyRingFile {}) = True
         isring _                = False
         isMutable (MutableRef {}) = True
@@ -869,9 +874,6 @@ writeRingKeys krd db wk secring pubring = do
             return (n,isMutable rtyp)
         fromfile f kd@(KeyData p _ _ _) =
                    Map.member f $ locations p 
-         {- maybe (Map.member f $ locations p)
-                  (\pred -> pred kd)
-                  (Map.lookup f $ kImports krd) -}
     let s = do
         (f,mutable) <- fs
         let x = do
@@ -921,12 +923,31 @@ runKeyRing keyring op = do
                 if e==0 then return $ Just lk
                         else dotlock_destroy lk >> return Nothing
         return (v,f)
-    let (lked, map snd -> failed) = partition (isJust . fst) lks
-        ret = if null failed then KikiSuccess () else FailedToLock failed
-    ret <- case functorToEither ret of
-      Right {} -> do
-         bresult <- buildKeyDB secring pubring grip0 keyring -- build db
-         try' bresult $ \((db,grip,wk),report1) -> do
+    let (lked, map snd -> failed_locks) = partition (isJust . fst) lks
+    ret <-
+      if not $ null failed_locks
+        then return $ KikiResult (FailedToLock failed_locks) []
+        else do
+         -- create nonexistent files via external commands
+         report_externals <- do
+            let cmds = do
+                 (f,(rtyp,ftyp)) <- Map.toList (kFiles keyring)
+                 cmd <- maybeToList (initializer rtyp)
+                 (_,subspec) <- fmap (parseSpec "") $ getUsage ftyp
+                 fname <- resolveInputFile secring pubring f
+                 return (fname,maybe "" id subspec,cmd)
+            forM cmds $ \(fname,usage,cmd) -> do
+                e <- systemEnv [ ("file",fname)
+                               , ("usage",usage) ]
+                               cmd
+                case e of
+                    ExitFailure num -> return (fname,FailedExternal num)
+                    ExitSuccess     -> return (fname,ExternallyGeneratedFile)
+
+         -- merge all keyrings, PEM files, and wallets
+         bresult <- buildKeyDB secring pubring grip0 keyring
+
+         try' bresult $ \((db,grip,wk),report_imports) -> do
              a <- return $ op KeyRingRuntime
                             { rtPubring = pubring
                             , rtSecring = secring
@@ -935,12 +956,20 @@ runKeyRing keyring op = do
                             , rtGrip = grip
                             , rtKeyDB = db
                             }
+
              r <- writeWalletKeys keyring db wk
-             try' r $ \report2 -> do
+             try' r $ \report_wallets -> do
+
              r <- writeRingKeys keyring db wk secring pubring
-             try' r $ \report3 -> do
-             return $ KikiResult (KikiSuccess a) (report1 ++ report3)
-      Left err -> return $ KikiResult err []
+             try' r $ \report_rings -> do
+
+             -- writePEMKeys
+
+             return $ KikiResult (KikiSuccess a)
+                        $ concat [ report_externals
+                                 , report_imports
+                                 , report_wallets
+                                 , report_rings ]
 
     forM_ lked $ \(Just lk, fname) -> do dotlock_release lk
                                          dotlock_destroy lk -- todo: verify we want this