blob: 3da337ac4e4ff0031a5eeb19337bfdf017c13707 (
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
|
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
|
