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

1 files changed, 79 insertions, 105 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 = []
                             }