2 files changed, 124 insertions, 121 deletions

diff --git a/kiki.hs b/kiki.hs
index e4d8e23..2ea702f 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -53,7 +53,7 @@ import Control.Arrow   (first,second)
 import Data.Monoid ( (<>) )
 import Data.Binary.Put
 
-import Data.OpenPGP.Util (verify,fingerprint)
+import Data.OpenPGP.Util (verify,fingerprint,generateKey, GenerateKeyParams(..))
 import ScanningParser
 import PEM
 import DotLock
@@ -1048,7 +1048,7 @@ buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp
                                        , fill = rtyp
                                        , spill = KF_All
                                        , access = AutoAccess
-                                       , initializer = Nothing
+                                       , initializer =NoCreate
                                        , transforms = [] }
 
 
@@ -1105,7 +1105,7 @@ sync bExport bImport bSecret cmdarg args_raw = do
                                                                     then DNSPresentation
                                                                     else PEMFile
                                                        , access = if bSecret then Sec else Pub
-                                                       , initializer = cmd'
+                                                       , initializer = maybe NoCreate External cmd'
                                                        , transforms = []
                                                        } )
                         else if isNothing cmd'
@@ -1233,7 +1233,7 @@ kiki "show" args = do
         streaminfo = StreamInfo { fill = KF_None
                                 , typ = KeyRingFile
                                 , spill = KF_All
-                                , initializer = Nothing
+                                , initializer = NoCreate
                                 , access = AutoAccess
                                 , transforms = []
                                 }
@@ -1317,7 +1317,7 @@ kiki "merge" args = do
             , typ = KeyRingFile
             , spill = KF_None
             , fill = KF_None
-            , initializer = Nothing
+            , initializer = NoCreate
             , transforms = []
             }
     updateFlow fil spil mtch flow = spill' $ fill' $ flow
@@ -1402,7 +1402,7 @@ kiki "merge" args = do
             Left ("autosign",Just "false")-> doAutosign False flow op
             Left ("passphrase-fd",Just pass) -> doPassphrase flow op pass
             Left ("create",Just cmd) ->
-                ( flow { initializer = if null cmd then Nothing else Just cmd }
+                ( flow { initializer = if null cmd then NoCreate else External cmd }
                 , op )
             Left ("type",Just "keyring") -> ( flow { typ = KeyRingFile     } , op )
             Left ("type",Just "pem"    ) -> ( flow { typ = PEMFile         } , op )
@@ -1480,8 +1480,11 @@ kiki "init" args = do
     (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec
     osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root"
     -- putStrLn $ "home = " ++ show (home,secring,pubring,mbwk)
+
+    -- Generate secring.gpg if it does not exist...
     gotsec <- doesFileExist secring
     when (not gotsec) $ do
+        {-  ssh-keygen to create master key...
         let mkpath = home ++ "/master-key"
         mkdirFor mkpath
         e <- systemEnv [ ("file",mkpath) ] (fromJust $ sshkeygen 4096)
@@ -1492,12 +1495,20 @@ kiki "init" args = do
         writeInputFileL (InputFileContext secring pubring)
                         HomeSec
                         ( encode $ Message [mk { is_subkey = False }] )
+        -}
+        master <- generateKey (GenRSA $ 4096 `div` 8 )
+        writeInputFileL (InputFileContext secring pubring)
+                        HomeSec
+                        $ encode $ Message [master { is_subkey = False}]
+
     gotpub <- doesFileExist pubring
     when (not gotpub) $ do
         writeInputFileL (InputFileContext secring pubring)
                         HomePub
                         ( encode $ Message [] )
 
+    -- Old paths..
+    --
     -- Private
     -- pem tor        /var/lib/tor/samizdat/private_key
     -- pem ssh-client %(home)/.ssh/id_rsa
@@ -1509,18 +1520,6 @@ kiki "init" args = do
     -- ssh-server /etc/ssh/ssh_host_rsa_key.pub
     -- ipsec      /etc/ipsec.d/certs/%(onion).pem
 
-    -- TODO: These should be read from a configuration file.
-    --       (use SimpleConfig)
-    let torpath = fromMaybe "" rootdir ++ "/var/lib/tor/samizdat/private_key"
-        sshcpath0 = fromMaybe "" rootdir ++ osHomeDir </> ".ssh" </>"id_rsa"
-        sshspath0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key"
-        ipsecpath0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/private/%(onion).pem"
-        sshcpathpub0 = fromMaybe "" rootdir ++ osHomeDir </> ".ssh" </> "id_rsa.pub"
-        sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub"
-        ipsecpathpub0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem"
-        contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem"
-
-
     -- First, we ensure that the tor key exists and is imported
     -- so that we know where to put the strongswan key.
     let passfd = fmap (FileDesc . read) $ lookup "passphrase-fd" args
@@ -1528,34 +1527,40 @@ kiki "init" args = do
                                                , fill = rtyp
                                                , spill = KF_All
                                                , access = AutoAccess
-                                               , initializer = Nothing
+                                               , initializer = NoCreate
                                                , transforms = [] }
         peminfo bits usage =
                   StreamInfo { typ = PEMFile
                              , fill = KF_Match usage
                              , spill = KF_Match usage
                              , access = Sec
-                             , initializer = sshkeygen bits
+                             , initializer = Internal (GenRSA $ bits `div` 8)
                              , transforms = []
                              }
+        sshcpath = fromMaybe "" rootdir ++ osHomeDir ++ ".ssh/id_rsa"
+        sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key"
         op = KeyRingOperation
              { opFiles = Map.fromList $
                 [ ( HomeSec, buildStreamInfo KF_All KeyRingFile )
                 , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } )
-                , ( ArgFile torpath, peminfo 1024 "tor" ) ]
+                , ( Generate (GenRSA (1024 `div` 8)), peminfo 1024 "tor"   )
+                , ( Generate (GenRSA (1024 `div` 8)), peminfo 1024 "ipsec" )
+                , ( ArgFile sshcpath, (peminfo 2048 "ssh-client") { fill = KF_None } )
+                , ( ArgFile sshspath, (peminfo 2048 "ssh-server") { fill = KF_None } )
+                ]
              , opPassphrases = do pfd <- maybeToList passfd
                                   return $ PassphraseSpec Nothing Nothing pfd
              , opHome = homespec
              , opTransforms = []
              }
-        doNothing = return ()
+        -- doNothing = return ()
         nop = KeyRingOperation
             { opFiles = Map.empty
             , opPassphrases = do pfd <- maybeToList passfd
                                  return $ PassphraseSpec Nothing Nothing pfd
             , opHome=homespec, opTransforms = []
             }
-    if bUnprivileged then doNothing else mkdirFor torpath
+    -- if bUnprivileged then doNothing else mkdirFor torpath
     KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op)
     forM_ report $ \(fname,act) -> do
         putStrLn $ fname ++ ": " ++ reportString act
@@ -1564,87 +1569,7 @@ kiki "init" args = do
             error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)"
         _ -> unconditionally $ return rt
 
-    -- Now import, export, or generate the remaining secret keys.
-    let oname' = do wk <- rtWorkingKey rt
-                    onionNameForContact (keykey wk) (rtKeyDB rt)
-    if (oname' == Nothing) && (not bUnprivileged) then error "Missing tor key" else do
-    let oname = fromMaybe "" oname'
-    let [ sshcpath, sshcpathpub ] = {- map (interp (Map.fromList [("onion",oname)]))-} [ sshcpath0, sshcpathpub0 ]
-        [ sshspath , ipsecpath ]  = map (interp (Map.fromList [("onion",oname)])) [ sshspath0, ipsecpath0   ]
-        [ sshspathpub, ipsecpathpub ]
-                                  = map (interp (Map.fromList [("onion",oname)]))
-                                                                              [ sshspathpub0, ipsecpathpub0 ]
-    let opPriv = op
-             { opFiles = Map.fromList $
-                [ ( HomeSec, buildStreamInfo KF_All KeyRingFile )
-                , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } )
-                , ( ArgFile ipsecpath, peminfo 1024 "ipsec" )
-                , ( ArgFile sshcpath, peminfo 2048 "ssh-client" )
-                , ( ArgFile sshspath, peminfo 2048 "ssh-server" ) ]
-             , opPassphrases = [ PassphraseMemoizer (rtPassphrases rt) ]
-             }
-        opUnPriv = op
-             { opFiles = Map.fromList $
-                [ ( HomeSec, buildStreamInfo KF_All KeyRingFile )
-                , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } )
-                , ( ArgFile sshcpath, peminfo 2048 "ssh-client" )
-                ]
-             , opPassphrases = [ PassphraseMemoizer (rtPassphrases rt) ]
-             }
-    mapM_ mkdirFor $ [sshcpath,sshcpathpub] ++ if not bUnprivileged then [sshspath,ipsecpath,sshspathpub,ipsecpathpub] else []
-    KikiResult rt report <- runKeyRing (if bUnprivileged then opUnPriv else opPriv)
-    forM_ report $ \(fname,act) -> do
-        putStrLn $ fname ++ ": " ++ reportString act
-    rt <- case rt of
-        BadPassphrase ->
-            error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)"
-        _ -> unconditionally $ return rt
-
-    -- Finally, export public keys if they do not exist.
-    let writeFileWARNING fname bs = do
-            --TODO
-            hPutStrLn stderr $ fname ++ ": DID NOT CHECK TRUST (TODO)"
-            writeFile fname bs
-    flip (maybe $ warn "missing working key?") (rtGrip rt) $ \grip -> do
-    gotc <- doesFileExist (sshcpathpub)
-    when (not gotc) $ do
-        either warn (writeFile sshcpathpub)
-            $ show_ssh' "ssh-client" grip (rtKeyDB rt)
-    if (not bUnprivileged)
-        then do
-            goth <- doesFileExist (sshspathpub)
-            when (not goth) $ do
-                either warn (writeFile $ sshspathpub)
-                    $ show_ssh' "ssh-host" grip (rtKeyDB rt)
-            goti <- doesFileExist (ipsecpathpub)
-            when (not goti) $ do
-                either warn (writeFile $ ipsecpathpub)
-                    $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket
-        else return ()
-
-
-    let cs = filter notme (Map.elems $ rtKeyDB rt)
-        kk = keykey (fromJust $ rtWorkingKey rt)
-        notme kd = keykey (keyPacket kd) /= kk
-
-        installConctact kd = do
-            -- The getHostnames command requires a valid cross-signed tor key
-            -- for each onion name returned in (_,(ns,_)).
-            let (_,(ns,_)) = getHostnames kd
-                contactname = fmap Char8.unpack $ listToMaybe ns -- only first onion name.
-            flip (maybe $ return ()) contactname $ \contactname -> do
-
-            let cpath = interp (Map.singleton "onion" contactname) contactipsec0
-                their_master = packet $ keyMappedPacket kd
-                -- We find all cross-certified ipsec keys for the given cross-certified onion name.
-                ipsecs = sortOn (Down . timestamp)
-                         $ getCrossSignedSubkeys their_master (keySubKeys kd) "ipsec"
-            forM_ (take 1 ipsecs) $ \k -> do
-            goti <- doesFileExist (cpath)
-            when (not goti) $ do
-                either warn (writeFile cpath) $ pemFromPacket k
-
-    mapM_ installConctact cs
+    when (not bUnprivileged) $ refreshCache rt rootdir
 
 kiki "delete" args | "--help" `elem` args = do
     putStr . unlines $
@@ -1721,6 +1646,55 @@ kiki "tar" args = do
         ["-A":_] -> putStrLn "unimplemented." -- import tar file?
         _ -> kiki "tar" ["--help"]
 
+refreshCache rt rootdir = do
+
+    let mkpath pth = fromMaybe "" rootdir ++ "/var/cache/kiki/"++pth
+
+        write f bs = do
+            createDirectoryIfMissing True $ takeDirectory f
+            writeFile f bs
+
+    let oname' = do wk <- rtWorkingKey rt
+                    -- XXX unnecessary signature check
+                    onionNameForContact (keykey wk) (rtKeyDB rt)
+        bUnprivileged = False -- TODO
+    if (oname' == Nothing) && (not bUnprivileged) then error "Missing tor key" else do
+    let oname = fromMaybe "" oname'
+    -- sshcpathpub0 = fromMaybe "" rootdir ++ osHomeDir </> ".ssh" </> "id_rsa.pub"
+    -- sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub"
+    -- contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem"
+
+    -- Finally, export public keys if they do not exist.
+    flip (maybe $ warn "missing working key?") (rtGrip rt) $ \grip -> do
+    either warn (write $ mkpath "root/.ssh/id_rsa.pub")
+            $ show_ssh' "ssh-client" grip (rtKeyDB rt)
+    either warn (write $ mkpath "ssh_host_rsa_key.pub")
+        $ show_ssh' "ssh-server" grip (rtKeyDB rt)
+    either warn (write $ mkpath "ipsec.d/certs/" ++ oname++".pem")
+        $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket
+
+    let cs = filter notme (Map.elems $ rtKeyDB rt)
+        kk = keykey (fromJust $ rtWorkingKey rt)
+        notme kd = keykey (keyPacket kd) /= kk
+
+        installConctact kd = do
+            -- The getHostnames command requires a valid cross-signed tor key
+            -- for each onion name returned in (_,(ns,_)).
+            let (_,(ns,_)) = getHostnames kd
+                contactname = fmap Char8.unpack $ listToMaybe ns -- only first onion name.
+            flip (maybe $ return ()) contactname $ \contactname -> do
+
+            let cpath = interp (Map.singleton "onion" contactname) "ipsec.d/certs/%(onion).pem"
+                their_master = packet $ keyMappedPacket kd
+                -- We find all cross-certified ipsec keys for the given cross-certified onion name.
+                ipsecs = sortOn (Down . timestamp)
+                         $ getCrossSignedSubkeys their_master (keySubKeys kd) "ipsec"
+            forM_ (take 1 ipsecs) $ \k -> do
+            either warn (write $ mkpath cpath) $ pemFromPacket k
+
+    mapM_ installConctact cs
+
+
 tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root"
  where
     ipsecs = do
@@ -1831,7 +1805,7 @@ minimalOp cap = op
     streaminfo = StreamInfo { fill = KF_None
                             , typ = KeyRingFile
                             , spill = KF_All
-                            , initializer = Nothing
+                            , initializer = NoCreate
                             , access = AutoAccess
                             , transforms = []
                             }
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