Changed "init" command to cokiki (/var/cache/kiki) design.

1 files changed, 45 insertions, 16 deletions

diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index faf5e70..b59fb9e 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -42,6 +42,7 @@ module KeyRing
     , Access(..)
     , FileType(..)
     , InputFile(..)
+    , Initializer(..)
     , KeyFilter(..)
     -- * Results of a KeyRing Operation
     , KeyRingRuntime(..)
@@ -248,7 +249,8 @@ data InputFile = HomeSec
  deriving (Eq,Ord,Show)
 
 -- type UsageTag = String
-type Initializer = String
+data Initializer = NoCreate | Internal GenerateKeyParams | External String
+ deriving (Eq,Ord,Show)
 
 data FileType = KeyRingFile
               | PEMFile
@@ -321,10 +323,10 @@ data StreamInfo = StreamInfo
     --  * The 'spill' setting is ignored and the file's contents are shared.
     --  (TODO)
     --
-    , initializer :: Maybe String
-    -- ^ If 'typ' is 'PEMFile' and an 'initializer' string is set, then it is
-    -- interpretted as a shell command that may be used to create the key if it
-    -- does not exist.
+    , initializer :: Initializer
+    -- ^ If 'typ' is 'PEMFile' and an 'External' 'initializer' string is set,
+    -- then it is interpretted as a shell command that may be used to create
+    -- the key if it does not exist.
     , transforms :: [Transform] 
     -- ^ Per-file transformations that occur before the contents of a file are
     -- spilled into the common pool.
@@ -1568,13 +1570,8 @@ buildKeyDB ctx grip0 keyring = do
     let gens = mapMaybe g $ Map.toList genMap
                 where g (Generate params,v) = Just (params,v)
                       g _                   = Nothing
-    db <- case mwk >>= \wk -> Map.lookup (keykey $ packet wk) db of
-            Just kd0 -> do
-                kd <- foldM (generateSubkey doDecrypt) (KikiSuccess (kd0,[])) gens
-                try kd $ \(kd,reportGens) -> do
-                let kk = keykey $ packet $ fromJust mwk
-                return $ KikiSuccess (Map.insert kk kd db,reportGens)
-            Nothing -> return $ KikiSuccess (db,[])
+
+    db <- generateInternals doDecrypt mwk db gens
     try db $ \(db,reportGens) -> do
 
     r <- mergeHostFiles keyring db ctx
@@ -1583,6 +1580,21 @@ buildKeyDB ctx grip0 keyring = do
     return $ KikiSuccess ( (db, grip, mwk, hs, accs, doDecrypt, unspilled)
                          , reportTrans ++ reportWallets ++ reportPEMs ++ reportGens ++ reportHosts )
 
+generateInternals ::
+    (MappedPacket -> IO (KikiCondition Packet))
+    -> Maybe MappedPacket
+    -> Map.Map KeyKey KeyData
+    -> [(GenerateKeyParams,StreamInfo)]
+    -> IO (KikiCondition (Map.Map KeyKey KeyData, [(FilePath, KikiReportAction)]))
+generateInternals doDecrypt mwk db gens = do
+    case fmap packet mwk >>= \wk -> Map.lookup (keykey wk) db of
+        Just kd0 -> do
+            kd <- foldM (generateSubkey doDecrypt) (KikiSuccess (kd0,[])) gens
+            try kd $ \(kd,reportGens) -> do
+            let kk = keykey $ packet $ fromJust mwk
+            return $ KikiSuccess (Map.insert kk kd db,reportGens)
+        Nothing -> return $ KikiSuccess (db,[])
+
 torhash :: Packet -> String
 torhash key = fromMaybe "" $ derToBase32 <$> derRSA key
 
@@ -2443,7 +2455,9 @@ performManipulations doDecrypt rt wk manip = do
 
 initializeMissingPEMFiles ::
     KeyRingOperation
-      -> InputFileContext -> Maybe String
+      -> InputFileContext
+      -> Maybe String
+      -> Maybe MappedPacket
       -> (MappedPacket -> IO (KikiCondition Packet))
       -> KeyDB
       -> IO (KikiCondition ( (KeyDB,[( FilePath
@@ -2451,7 +2465,7 @@ initializeMissingPEMFiles ::
                                      , [MappedPacket]
                                      , StreamInfo )])
                            , [(FilePath,KikiReportAction)]))
-initializeMissingPEMFiles operation ctx grip decrypt db = do
+initializeMissingPEMFiles operation ctx grip mwk decrypt db = do
         nonexistents <-
            filterM (fmap not . doesFileExist . fst)
                $ do (f,t) <- Map.toList (opFiles operation)
@@ -2489,7 +2503,9 @@ initializeMissingPEMFiles operation ctx grip decrypt db = do
            let cmds = mapMaybe getcmd missing
                  where
                    getcmd (fname,subspec,ms,stream) = do
-                       cmd <- initializer stream
+                       cmd <- case initializer stream of
+                                External str -> Just str
+                                _            -> Nothing
                        return (fname,subspec,ms,stream,cmd)
            rs <- forM cmds $ \tup@(fname,subspec,ms,stream,cmd) -> do
                e <- systemEnv [ ("file",fname)
@@ -2508,8 +2524,20 @@ initializeMissingPEMFiles operation ctx grip decrypt db = do
                     return (f,subspec,map fst ms,stream,cmd)
 
            try v $ \(db,import_rs) -> do
+
+           -- generateInternals
+           let internals = mapMaybe getParams missing
+                where
+                    getParams (fname,subspec,ms,stream) =
+                        case initializer stream of
+                            Internal p -> Just (p, stream)[
+                            _          -> Nothing
+           v <- generateInternals decrypt mwk db internals
+
+           try v $ \(db,internals_rs) -> do
+
            return $ KikiSuccess ((db,exports), map (\((f,_,_,_,_),r)->(f,r)) rs
-                                     ++ import_rs)
+                                     ++ import_rs ++ internals_rs)
 {-
 interpretManip :: KeyData -> KeyRingAddress PacketUpdate -> IO KeyData
 interpretManip kd (KeyRingAddress kk sk (InducerSignature ps)) = error "todo"
@@ -2695,6 +2723,7 @@ runKeyRing operation = do
         externals_ret <- initializeMissingPEMFiles operation
                                                    ctx
                                                    grip
+                                                   wk
                                                    decrypt
                                                    db
         try' externals_ret $ \((db,exports),report_externals) -> do