summaryrefslogtreecommitdiff
path: root/cokiki.hs
blob: 2cb6491b3c8bb28a12595c9c056e9977cd115586 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative
import Data.Bool
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Kiki
import System.Directory
import System.Environment
import System.IO
import System.Posix.User

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 -> IO (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 <- parseSshConfig . fromMaybe "" <$> 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 root = 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

unparseSshConfig ls = L8.unlines $ map L.concat $ ls

sshSplitAtDirective d sshconfig = break (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

bool :: a -> a -> Bool -> a
bool f _ False = f
bool _ t True  = t