From 6860098ed8f8b56eb5058e0c9c427abaa57021bf Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Mon, 25 Apr 2016 20:20:45 -0400
Subject: more work on cokiki (ssh-client)

---
 cokiki.hs | 22 ++++++++++++----------
 1 file changed, 12 insertions(+), 10 deletions(-)

(limited to 'cokiki.hs')

diff --git a/cokiki.hs b/cokiki.hs
index daf2be5..899608b 100644
--- a/cokiki.hs
+++ b/cokiki.hs
@@ -23,6 +23,7 @@ usage = unlines
     , "  strongswan"
     ]
 
+ㄧchroot :: Args (FilePath -> FilePath)
 ㄧchroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id
  where
     slash :: String -> String -> String
@@ -38,11 +39,11 @@ main = do
             | uid==0    = action
             | otherwise = hPutStrLn stderr "operation requires root."
     let sel = case cmd of
-                ["ssh-client"] -> pure (sshClient uid) <*> ㄧchroot
+                ["ssh-client"] -> pure (sshClient uid) <*> ㄧchroot <*> Kiki.ㄧhomedir
                 ["ssh-server"] -> pure (whenRoot sshServer)
                 ["strongswan"] -> pure (whenRoot strongswan)
                 _   -> pure $ hPutStr stderr usage
-        spec = fancy [("--chroot",1)] [] ""
+        spec = fancy [("--chroot",1),("--passphrase-fd",1),("--homedir",1)] [] ""
     case runArgs (parseInvocation spec args) sel of
         Left e   -> hPutStrLn stderr $ usageErrorMessage e
         Right io -> io
@@ -51,7 +52,7 @@ maybeReadFile :: FilePath -> IO (Maybe L.ByteString)
 maybeReadFile path = do
     doesFileExist path >>= bool (return Nothing) (Just <$> L.readFile path)
 
-sshClient uid root = do
+sshClient uid root cmn = do
     -- /etc/ssh/ssh_config    <--  'GlobalKnownHostsFile /var/cache/kiki/ssh_known_hosts'
     sshconfig <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ssh/ssh_config")
     let (ps,qs) = sshSplitAtDirective "GlobalKnownHostsFile" sshconfig
@@ -64,20 +65,21 @@ sshClient uid root = do
             d:ds | elem "/var/cache/kiki/ssh_known_hosts" d
                  -> do hPutStrLn stderr "ssh-client already configured."
                        return Nothing
-            d:ds -> do hPutStrLn stderr "modifying GlobalKnownHostsFile not implemented"
-                       return Nothing
-            []   -> do
+            d:ds -> do hPutStrLn stderr "modifying GlobalKnownHostsFile directive"
+                       let hs = " " : "/var/cache/kiki/ssh_known_hosts" : drop 1 d
+                           stmt = take 1 d ++ hs
+                       return $ Just (ps ++ stmt : ds)
+            []   -> do -- Unconfigured add fresh directive.
                        let stmt = L8.unwords ["GlobalKnownHostsFile"
                                              ,  "/var/cache/kiki/ssh_known_hosts"
                                              ,  "/etc/ssh/ssh_known_hosts"
                                              ,  "/etc/ssh/ssh_known_hosts2"
                                              ]
                        return $ Just (sshconfig ++ parseSshConfig stmt)
-    -- sshconfig' `deepseq` return () -- force lazy input
+    sshconfig' `deepseq` return () -- force lazy input
     maybe (return ()) (myWriteFile (root "/etc/ssh/ssh_config") . unparseSshConfig) sshconfig'
     -- /root/.gnupg/...       <--  contains known hosts from /etc/ssh/ssh_known_hosts
-
-    -- Kiki.refresh
+    Kiki.refresh root cmn
     -- /var/cache/kiki/ssh_known_hosts        <--  contains known hosts from /root/.gnupg/...
 
 sshServer = do
@@ -87,7 +89,7 @@ sshServer = do
 strongswan = do
     -- etc/ipsec.conf    <--  'include /var/cache/kiki/ipsec.conf'
     -- /root/.gnupg/...   <--  contains newly-generated ipsec subkey
-    Kiki.refresh
+    Kiki.refresh id (Kiki.CommonArgsParsed Nothing Nothing)
     -- /var/cache/kiki/ipsec.conf      <--  contains configurations for each remote ipsec host
     -- /var/cache/kiki/ipsec.conf      <--  contains '%default' configuration for this local host
     -- /var/cache/kiki/ipsec.d/certs   <--  contains relevant certs
-- 
cgit v1.2.3