1 files changed, 137 insertions, 125 deletions

diff --git a/kiki.hs b/kiki.hs
index 4aa5885..e06fa79 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
@@ -697,18 +697,8 @@ kiki_usage bExport bImport bSecret cmd = putStr $
                 ["     --help"
                 ,"                Gives usage information"
                 ,""
-                ,"     --homedir DIR"
-                ,"                Where to find the files secring.gpg and pubring.gpg. The"
-                ,"                default location is taken from the environment variable"
-                ,"                GNUPGHOME. If this environment variable is not set and no"
-                ,"                directory is specified using this option then a hardcoded"
-                ,"                default of ~/.gnupg is assumed. "
-                ,""
-                ,"                WARNING: Confusingly, this is *not* your home directory as"
-                ,"                given by the HOME environment variable. The option is named"
-                ,"                or rather misnamed in a fashion similar to the gpg option with"
-                ,"                exactly the same functionality."
-                ,""] ++ documentPassphraseFDFlag bExport bImport bSecret
+                ] ++ documentHomeDir ++ [""]
+                  ++ documentPassphraseFDFlag bExport bImport bSecret
             showwk :: [String]
             showwk =
                 ["     --show-wk"
@@ -769,6 +759,21 @@ kiki_usage bExport bImport bSecret cmd = putStr $
                  ,"      5E24CD442AA6965D2012E62A905C24185D5379C2"
                  ]
 
+documentHomeDir :: [String]
+documentHomeDir =
+                ["     --homedir DIR"
+                ,"                Where to find the files secring.gpg and pubring.gpg. The"
+                ,"                default location is taken from the environment variable"
+                ,"                GNUPGHOME. If this environment variable is not set and no"
+                ,"                directory is specified using this option then a hardcoded"
+                ,"                default of ~/.gnupg is assumed. "
+                ,""
+                ,"                WARNING: Confusingly, this is *not* your home directory as"
+                ,"                given by the HOME environment variable. The option is named"
+                ,"                or rather misnamed in a fashion similar to the gpg option with"
+                ,"                exactly the same functionality."
+                ]
+
 documentPassphraseFDFlag bExport bImport bSecret =
     if bSecret then
                 ["     --passphrase-fd FD"
@@ -1043,7 +1048,7 @@ buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp
                                        , fill = rtyp
                                        , spill = KF_All
                                        , access = AutoAccess
-                                       , initializer = Nothing
+                                       , initializer =NoCreate
                                        , transforms = [] }
 
 
@@ -1100,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'
@@ -1228,7 +1233,7 @@ kiki "show" args = do
         streaminfo = StreamInfo { fill = KF_None
                                 , typ = KeyRingFile
                                 , spill = KF_All
-                                , initializer = Nothing
+                                , initializer = NoCreate
                                 , access = AutoAccess
                                 , transforms = []
                                 }
@@ -1312,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
@@ -1397,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 )
@@ -1425,13 +1430,28 @@ kiki "merge" args = do
                     Nothing -> error "Valid flow words are: spill,fill,sync,subkeys or match=KEYSPEC"
             Left (option,_) -> error $ "Unrecognized option: " ++ option
 
-kiki "init-key" args | "--help" `elem` args = do
+kiki "init" args | "--help" `elem` args = do
     putStr . unlines $
-        [ "kiki init-key [ --passphrase-fd=FD"
-        , "              | --home[=HOMEDIR]"
-        , "              | --chroot=ROOTDIR ] ..."]
-    return ()
-kiki "init-key" args = do
+        [ "kiki init [ --passphrase-fd=FD"
+        , "          | --home[=HOMEDIR]"
+        , "          | --chroot=ROOTDIR ] ..."
+        , ""
+        , "Initialize a GnuPG keyring for use with kiki.  After completion, you"
+        , "willl have a GnuPG master key with following specialized subkeys:"
+        , ""
+        , "  tor        - freshly generated tor hidden service key"
+        , "  ipsec      - freshly generated VPN key"
+        , "  ssh-server - possibly read from /etc/ssh/*"
+        , "  ssh-client - possibly read from /root/.ssh/id_rsa"
+        , ""
+        , "OPTIONS"
+        , ""
+        , "     --chroot=ROOTDIR"
+        , "                Use ROOTDIR for input of ssh keys and export files to"
+        , "                ROOTDIR/var/cache/kiki instead of the current system path."
+        , ""
+        ] ++ documentHomeDir ++ [""] ++ documentPassphraseFDFlag True True True
+kiki "init" args = do
     me <- getEffectiveUserID
     {-
     if me/=0 then error "This command requires root." else do
@@ -1460,8 +1480,11 @@ kiki "init-key" 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)
@@ -1472,59 +1495,78 @@ kiki "init-key" args = do
         writeInputFileL (InputFileContext secring pubring)
                         HomeSec
                         ( encode $ Message [mk { is_subkey = False }] )
+        -}
+        master <- (\k -> k { is_subkey = False }) <$> 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 [] )
 
-    -- 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"
+    -- Old paths..
+    --
+    -- Private
+    -- pem tor        /var/lib/tor/samizdat/private_key
+    -- pem ssh-client %(home)/.ssh/id_rsa
+    -- pem ssh-server /etc/ssh/ssh_host_rsa_key
+    -- pem ipsec      /etc/ipsec.d/private/%(onion).pem
 
+    -- Public
+    -- ssh-client %(home)/.ssh/id_rsa.pub
+    -- ssh-server /etc/ssh/ssh_host_rsa_key.pub
+    -- ipsec      /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
+        strm = StreamInfo { typ = KeyRingFile
+                          , fill = KF_None
+                          , spill = KF_All
+                          , access = AutoAccess
+                          , initializer = NoCreate
+                          , transforms = [] }
         buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp
                                                , fill = rtyp
                                                , spill = KF_All
                                                , access = AutoAccess
-                                               , initializer = Nothing
+                                               , initializer = NoCreate
                                                , transforms = [] }
         peminfo bits usage =
                   StreamInfo { typ = PEMFile
-                             , fill = KF_Match usage
+                             , fill = KF_None -- 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 0 (GenRSA (1024 `div` 8)), strm { spill = KF_Match "tor" })
+                , ( Generate 1 (GenRSA (1024 `div` 8)), strm { spill = KF_Match "ipsec" })
+                , ( ArgFile sshcpath, (peminfo 2048 "ssh-client") )
+                , ( ArgFile sshspath, (peminfo 2048 "ssh-server") )
+                ]
              , 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
@@ -1533,87 +1575,7 @@ kiki "init-key" 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 "strongswan" )
-                , ( 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' "strongswan" 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) "strongswan"
-            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 $
@@ -1690,10 +1652,59 @@ 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
-        (kk,ipsec,sigs) <- selectPublicKeyAndSigs (KeyUidMatch "",Just "strongswan") (rtKeyDB rt)
+        (kk,ipsec,sigs) <- selectPublicKeyAndSigs (KeyUidMatch "",Just "ipsec") (rtKeyDB rt)
         let kd = (rtKeyDB rt Map.! kk)
             k = packet $ keyMappedPacket kd
             (addr,(onames,ns)) = getHostnames kd
@@ -1729,7 +1740,7 @@ tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root"
                         return $ spem (dir $ homedir ++ "/.ssh/" ++ sshkeyname k) k
             sshsvr = spem (dir "etc/ssh/ssh_host_rsa_key") <$> lookupSecret "ssh-host" kd
             ipseckey = do
-                k <- lookupSecret "strongswan" kd
+                k <- lookupSecret "ipsec" kd
                 oname <- fst . snd $ getHostnames kd
                 return $ spem (dir $ "etc/ipsec.d/private/"++Char8.unpack oname++".pem") k
         torkey ++ sshcli ++ sshsvr ++ ipseckey
@@ -1800,7 +1811,7 @@ minimalOp cap = op
     streaminfo = StreamInfo { fill = KF_None
                             , typ = KeyRingFile
                             , spill = KF_All
-                            , initializer = Nothing
+                            , initializer = NoCreate
                             , access = AutoAccess
                             , transforms = []
                             }
@@ -1849,7 +1860,8 @@ commands =
  , ( "export-secret", "export (both public and secret) information into your keyring" )
  , ( "export-public", "import (public) information into your keyring" )
  , ( "merge", "low level import/export operation" )
- , ( "init-key", "initialize the samizdat key ring")
+ -- , ( "init-key", "initialize the samizdat key ring")
+ , ( "init", "Initialize kiki")
  , ( "delete", "Delete a subkey and its associated signatures" )
  , ( "tar", "import or export system key files in tar format" )
  ]