ssh-server configuration

1 files changed, 16 insertions, 4 deletions

diff --git a/cokiki.hs b/cokiki.hs
index fb0523c..68923a7 100644
--- a/cokiki.hs
+++ b/cokiki.hs
@@ -4,6 +4,7 @@ import Control.Applicative
 import Control.DeepSeq
 import Data.Bool
 import Data.Char
+import Data.List
 import Data.Maybe
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.ByteString.Lazy.Char8 as L8
@@ -64,15 +65,15 @@ main = do
 maybeReadFile :: FilePath -> IO (Maybe L.ByteString)
 maybeReadFile path = do
     doesFileExist path >>= bool (return Nothing) (Just <$> L.readFile path)
+myWriteFile f bs = do
+    hPutStrLn stderr $ "Writing "++f
+    -- L8.putStr bs
+    L8.writeFile f bs
 
 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
-        myWriteFile f bs = do
-            hPutStrLn stderr $ "Writing "++f
-            -- L8.putStr bs
-            L8.writeFile f bs
     sshconfig' <-
         case qs of
             d:ds | elem "/var/cache/kiki/ssh_known_hosts" d
@@ -83,6 +84,7 @@ sshClient uid root cmn = do
                            stmt = take 1 d ++ hs
                        return $ Just (ps ++ stmt : ds)
             []   -> do -- Unconfigured add fresh directive.
+                       hPutStrLn stderr "adding GlobalKnownHostsFile directive"
                        let stmt = L8.unwords ["GlobalKnownHostsFile"
                                              ,  "/var/cache/kiki/ssh_known_hosts"
                                              ,  "/etc/ssh/ssh_known_hosts"
@@ -98,6 +100,15 @@ sshClient uid root cmn = do
     Kiki.importAndRefresh root cmn
 
 sshServer root cmn = do
+    sshconfig <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ssh/sshd_config")
+    let p:gs = groupBy (\_ d -> not $ sshIsDirective "HostKey" d) $ ["#"]:sshconfig
+        got = filter (\(d:ds) -> elem "/var/cache/kiki/ssh_host_rsa_key" d) gs
+    case got of
+        _:_ -> do hPutStrLn stderr "ssh-server already configured."
+        [] -> do let sshconfig' = drop 1 $ sshconfig ++ [stmt]
+                     stmt = ["HostKey", " ", "/var/cache/kiki/ssh_host_rsa_key"]
+                 hPutStrLn stderr "adding HostKey directive"
+                 myWriteFile (root "/etc/ssh/sshd_config") $ unparseSshConfig sshconfig'
     -- /etc/ssh/sshd_config <-- 'HostKey /var/cache/kiki/ssh_host_ecdsa_key' etc.
     Kiki.importAndRefresh root cmn
 
@@ -111,6 +122,7 @@ strongswan root cmn = do
     -- /var/cache/kiki/ipsec.d/private <--  contains private key
 
 
+parseSshConfig :: L.ByteString -> [[L.ByteString]]
 parseSshConfig bs = map tokenize $ L8.lines bs
  where
     tokenize l = L8.groupBy tokrel l' ++ [comment]