cokiki: don't require root when using a --chroot.

1 files changed, 24 insertions, 17 deletions

diff --git a/cokiki.hs b/cokiki.hs
index 68923a7..26748b2 100644
--- a/cokiki.hs
+++ b/cokiki.hs
@@ -49,13 +49,10 @@ usage = unlines
 main = do
     (cmd,args) <- splitAt 1 <$> getArgs
     uid <- getEffectiveUserID
-    let whenRoot action
-            | uid==0    = action
-            | otherwise = hPutStrLn stderr "operation requires root."
     let sel = case cmd of
-                ["ssh-client"] -> fmap whenRoot $ sshClient uid <$> Kiki.ㄧchroot <*> Kiki.ㄧhomedir
-                ["ssh-server"] -> fmap whenRoot $ sshServer     <$> Kiki.ㄧchroot <*> Kiki.ㄧhomedir
-                ["strongswan"] -> fmap whenRoot $ strongswan    <$> Kiki.ㄧchroot <*> Kiki.ㄧhomedir
+                ["ssh-client"] -> sshClient  uid <$> Kiki.ㄧchroot <*> Kiki.ㄧhomedir
+                ["ssh-server"] -> sshServer  uid <$> Kiki.ㄧchroot <*> Kiki.ㄧhomedir
+                ["strongswan"] -> strongswan uid <$> Kiki.ㄧchroot <*> Kiki.ㄧhomedir
                 _   -> pure $ hPutStr stderr usage
         spec = uncurry fancy Kiki.kikiOptions ""
     case runArgs (parseInvocation spec args) sel of
@@ -70,7 +67,15 @@ myWriteFile f bs = do
     -- L8.putStr bs
     L8.writeFile f bs
 
-sshClient uid root cmn = do
+whenRoot uid root cmn action
+    | uid==0         = action
+    | root "" == "/" = no
+    | root "" == ""  = no
+    | otherwise      = action
+ where
+    no = hPutStrLn stderr "operation requires root."
+
+sshClient uid root cmn = whenRoot 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
@@ -94,12 +99,10 @@ sshClient uid root cmn = do
     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
     -- /var/cache/kiki/ssh_known_hosts        <--  contains known hosts from /root/.gnupg/...
-    -- Kiki.replaceSshServerKeys root cmn
     Kiki.importAndRefresh root cmn
 
-sshServer root cmn = do
+sshServer uid root cmn = whenRoot uid 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
@@ -112,15 +115,19 @@ sshServer root cmn = do
     -- /etc/ssh/sshd_config <-- 'HostKey /var/cache/kiki/ssh_host_ecdsa_key' etc.
     Kiki.importAndRefresh root cmn
 
-strongswan root cmn = do
+strongswan uid root cmn = whenRoot uid root cmn $ do
+    -- Parsing as if ssh config, that's not right, but good enough for now.
+    ipsecconf <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ipsec.conf")
+    let p:gs = groupBy (\_ d -> not $ sshIsDirective "include" d) $ ["#"]:ipsecconf
+        got = filter (\(d:ds) -> elem "/var/cache/kiki/ipsec.conf" d) gs
+    case got of
+        _:_ -> do hPutStrLn stderr "ipsec already configured."
+        [] -> do let ipsecconf' = drop 1 $ ipsecconf ++ [stmt]
+                     stmt = ["include", " ", "/var/cache/kiki/ipsec.conf"]
+                 hPutStrLn stderr "adding include directive"
+                 myWriteFile (root "/etc/ipsec.conf") $ unparseSshConfig ipsecconf'
     -- etc/ipsec.conf    <--  'include /var/cache/kiki/ipsec.conf'
-    -- /root/.gnupg/...   <--  contains newly-generated ipsec subkey
     Kiki.importAndRefresh root cmn
-    -- /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
-    -- /var/cache/kiki/ipsec.d/private <--  contains private key
-
 
 parseSshConfig :: L.ByteString -> [[L.ByteString]]
 parseSshConfig bs = map tokenize $ L8.lines bs