init-key command

1 files changed, 120 insertions, 1 deletions

diff --git a/kiki.hs b/kiki.hs
index 160136d..4266ac5 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -22,6 +22,9 @@ import Data.Maybe
 import Data.OpenPGP
 import Data.Ord
 import Data.Text.Encoding
+-- import System.Posix.User
+import System.FilePath.Posix
+import System.Directory
 import System.Environment
 import System.Exit
 import System.IO (hPutStrLn,stderr)
@@ -38,6 +41,7 @@ import Data.Binary.Put (putWord32be,runPut,putByteString)
 import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
 import Data.Monoid ( (<>) )
 
+import Data.OpenPGP.Util (verify,fingerprint)
 import ScanningParser
 import PEM
 import DotLock
@@ -45,7 +49,8 @@ import LengthPrefixedBE
 import KeyRing
 import Base58
 import qualified CryptoCoins
-import Data.OpenPGP.Util (verify,fingerprint)
+-- import Chroot
+import ProcessUtils
 
 -- {-# ANN module ("HLint: ignore Eta reduce"::String) #-}
 -- {-# ANN module ("HLint: ignore Use camelCase"::String) #-}
@@ -138,6 +143,7 @@ fpmatch grip key =
 listKeys pkts = listKeysFiltered [] pkts
 
 listKeysFiltered grips pkts = do
+    -- FIXME: Will not show any output when there are no subkeys.
     let (certs,bs) = getBindings pkts
         as = accBindings bs
         defaultkind (k:_) hs = k
@@ -1105,6 +1111,118 @@ 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
+    putStr . unlines $
+        [ "kiki init-key [ --passphrase-fd=FD"
+        , "              | --home[=HOMEDIR]"
+        , "              | --chroot=ROOTDIR ] ..."]
+    return ()
+kiki "init-key" args = do
+    {-
+    me <- getEffectiveUserID
+    if me/=0 then error "This command requires root." else do
+    -}
+    let as = lefts $ map splitArg args
+        lefts = mapMaybe isLeft where { isLeft (Left x) = Just x; isLeft _ = Nothing }
+        bads = map fst as \\ ["passphrase-fd","home","chroot"]
+    if not (null bads) then error ("Bad option: " ++ unwords bads) else do
+    let rootdir = fmap (fromMaybe "") $ lookup "chroot" as
+    if rootdir==Just "" then error "--chroot requires an argument" else do
+    -- maybe id fchroot rootdir $ do
+    args <- return $ map (second $ fromMaybe "") as
+
+    let homespec = mplus ( (++) <$> rootdir <*> lookup "home" args )
+                         (fmap (++"/root/.gnupg") rootdir)
+        sshkeygen size = Just $ concat [ "mkdir -p \"$(dirname $file)\" && "
+                                       , "ssh-keygen -P \"\" -q -f $file -b "
+                                       , show size ]
+        mkdirFor path = do
+            let dir = takeDirectory path
+            putStrLn $ "mkdirFor " ++ show dir
+            createDirectoryIfMissing True dir
+        -- ssl = Just "mkdir -p \"$(dirname $file)\" && openssl genrsa -out $file 1024"
+    (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec
+    putStrLn $ "home = " ++ show (home,secring,pubring,mbwk)
+    gotsec <- doesFileExist secring
+    when (not gotsec) $ do
+        let mkpath = home ++ "/master-key"
+        mkdirFor mkpath
+        e <- systemEnv [ ("file",mkpath) ] (fromJust $ sshkeygen 4096)
+        case e of
+            ExitFailure num -> error "ssh-keygen failed to create master key"
+            ExitSuccess     -> return ()
+        [PEMPacket mk] <- readSecretPEMFile (ArgFile mkpath)
+        writeInputFileL (InputFileContext secring pubring)
+                        HomeSec
+                        ( encode $ Message [mk { is_subkey = False }] )
+    gotpub <- doesFileExist pubring
+    when (not gotpub) $ do
+        writeInputFileL (InputFileContext secring pubring)
+                        HomePub
+                        ( encode $ Message [] )
+    
+    -- First, we ensure that the tor key exists and is imported
+    -- so that we know where to put the strongswan key.
+    let torpath = fromMaybe "" rootdir ++ "/var/lib/tor/samizdat/private_key"
+        passfd = fmap (FileDesc . read) $ lookup "passphrase-fd" args
+        buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp
+                                               , fill = rtyp
+                                               , spill = KF_All
+                                               , access = AutoAccess
+                                               , initializer = Nothing
+                                               , transforms = [] }
+        peminfo bits usage =
+                  StreamInfo { typ = PEMFile
+                             , fill = KF_Match usage
+                             , spill = KF_Match usage
+                             , access = Sec
+                             , initializer = sshkeygen bits
+                             , transforms = []
+                             }
+        op = KeyRingOperation
+             { opFiles = Map.fromList $
+                [ ( HomeSec, buildStreamInfo KF_All KeyRingFile )
+                , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } )
+                , ( ArgFile torpath, peminfo 1024 "tor" ) ]
+             , opPassphrases = do pfd <- maybeToList passfd
+                                  return $ PassphraseSpec Nothing Nothing pfd
+             , opHome = homespec
+             , opTransforms = []
+             }
+    mkdirFor torpath
+    KikiResult rt report <- runKeyRing op
+    forM_ report $ \(fname,act) -> do
+        putStrLn $ fname ++ ": " ++ reportString act
+    rt <- unconditionally $ return rt
+    
+    -- Now import, export, or generate the remaining secret keys.
+    let oname = do wk <- rtWorkingKey rt
+                   onionNameForContact (keykey wk) (rtKeyDB rt)
+    flip (maybe $ error "Missing tor key") oname $ \oname -> do
+    let sshcpath = fromMaybe "" rootdir ++ "/root/.ssh/id_rsa"
+        sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key"
+        ipsecpath = fromMaybe "" rootdir ++ "/etc/ipsec.d/private/"++oname++".pem"
+        op2 = 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" ) ]
+             }
+    forM_ [sshcpath,sshspath,ipsecpath] mkdirFor
+    KikiResult rt report <- runKeyRing op2
+    forM_ report $ \(fname,act) -> do
+        putStrLn $ fname ++ ": " ++ reportString act
+    rt <- unconditionally $ return rt
+    
+    -- Finally, export public keys if they do not exist.
+    -- TODO
+    -- makepub ssh-client "$ROOT/root/.ssh/id_rsa.pub"
+    -- makepub ssh-host   "$ROOT/etc/ssh/ssh_host_rsa_key.pub"
+
+    return ()
+
 splitArg :: String -> Either (String,Maybe String) String
 splitArg arg =
     case hyphens of
@@ -1132,6 +1250,7 @@ commands =
  , ( "export-public", "import (public) information into your keyring" )
  , ( "working-key", "show the current working master key and its subkeys" )
  , ( "merge", "low level import/export operation" )
+ , ( "init-key", "initialize the samizdat key ring")
  ]
 
 main = do