cokiki executable.

1 files changed, 78 insertions, 0 deletions

diff --git a/cokiki.hs b/cokiki.hs
new file mode 100644
index 0000000..3da337a
--- /dev/null
+++ b/cokiki.hs
@@ -0,0 +1,78 @@
+import System.Environment
+import System.IO
+import System.Posix.User
+import qualified Kiki
+import Data.Char
+import qualified Data.ByteString.Lazy.Char8 as L8
+import qualified Data.ByteString.Lazy.Char8 as L
+
+usage = unlines
+    [ "cokiki <command>"
+    , ""
+    , "COMMANDS"
+    , "  ssh-client"
+    , "  ssh-server"
+    , "  strongswan"
+    ]
+
+main = do
+    args <- getArgs
+    uid <- getEffectiveUserID
+    let whenRoot action
+            | uid==0    = action
+            | otherwise = hPutStrLn stderr "operaiton requires root."
+    case args of
+        ["ssh-client"] -> sshClient uid id
+        ["ssh-server"] -> whenRoot sshServer
+        ["strongswan"] -> whenRoot strongswan
+        _   -> hPutStr stderr usage
+
+maybeReadFile :: FilePath -> Maybe L.ByteString
+maybeReadFile path = do
+    doesFileExist path >>= bool (return Nothing) (Just <$> L.readFile path)
+
+sshClient 0 root = do
+    -- /etc/ssh/ssh_config    <--  'GlobalKnownHostsFile /var/cache/kiki/ssh_known_hosts'
+    sshconfig <- fromMaybe [] parseSshConfig <$> maybeReadFile (root "/etc/ssh/ssh_config")
+    let (ps,qs) = sshSplitAtDirective "GlobalKnownHostsFile" sshconfig
+    sshconfig' <-
+        case qs of
+            d:ds -> error "modify GlobalKnownHostsFile"
+            []   -> error "append GlobalKnownHostsFile"
+    L.writeFile (root "/var/cache/kiki/ssh_known_hosts") $ unparseSshConfig sshconfig'
+    -- /root/.gnupg/...       <--  contains known hosts from /etc/ssh/ssh_known_hosts
+    Kiki.refresh
+    -- /var/cache/kiki/ssh_known_hosts        <--  contains known hosts from /root/.gnupg/...
+
+
+sshClient uid = return ()
+
+sshServer = do
+    -- /etc/ssh/sshd_config <-- 'HostKey /var/cache/kiki/ssh_host_ecdsa_key' etc.
+    return ()
+
+strongswan = do
+    -- etc/ipsec.conf    <--  'include /var/cache/kiki/ipsec.conf'
+    -- /root/.gnupg/...   <--  contains newly-generated ipsec subkey
+    Kiki.refresh
+    -- /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 bs = map tokenize $ L8.lines bs
+ where
+    tokenize l = L8.groupBy tokrel l' ++ [comment]
+      where (l', comment) = L8.break (=='#') l
+    tokrel x y = isSpace x == isSpace y
+
+sshSplitAtDirective d sshconfig = splitAt (sshIsDirective d) sshconfig
+
+sshIsDirective d ls =
+    case dropWhile isSpaceTok ls of
+        g:_ | g == d -> True
+        _            -> False
+ where
+    isSpaceTok "" = True
+    isSpaceTok b  = isSpace $ L8.head b