diff options
Diffstat (limited to 'cokiki.hs')
-rw-r--r-- | cokiki.hs | 78 |
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 @@ | |||
1 | import System.Environment | ||
2 | import System.IO | ||
3 | import System.Posix.User | ||
4 | import qualified Kiki | ||
5 | import Data.Char | ||
6 | import qualified Data.ByteString.Lazy.Char8 as L8 | ||
7 | import qualified Data.ByteString.Lazy.Char8 as L | ||
8 | |||
9 | usage = unlines | ||
10 | [ "cokiki <command>" | ||
11 | , "" | ||
12 | , "COMMANDS" | ||
13 | , " ssh-client" | ||
14 | , " ssh-server" | ||
15 | , " strongswan" | ||
16 | ] | ||
17 | |||
18 | main = do | ||
19 | args <- getArgs | ||
20 | uid <- getEffectiveUserID | ||
21 | let whenRoot action | ||
22 | | uid==0 = action | ||
23 | | otherwise = hPutStrLn stderr "operaiton requires root." | ||
24 | case args of | ||
25 | ["ssh-client"] -> sshClient uid id | ||
26 | ["ssh-server"] -> whenRoot sshServer | ||
27 | ["strongswan"] -> whenRoot strongswan | ||
28 | _ -> hPutStr stderr usage | ||
29 | |||
30 | maybeReadFile :: FilePath -> Maybe L.ByteString | ||
31 | maybeReadFile path = do | ||
32 | doesFileExist path >>= bool (return Nothing) (Just <$> L.readFile path) | ||
33 | |||
34 | sshClient 0 root = do | ||
35 | -- /etc/ssh/ssh_config <-- 'GlobalKnownHostsFile /var/cache/kiki/ssh_known_hosts' | ||
36 | sshconfig <- fromMaybe [] parseSshConfig <$> maybeReadFile (root "/etc/ssh/ssh_config") | ||
37 | let (ps,qs) = sshSplitAtDirective "GlobalKnownHostsFile" sshconfig | ||
38 | sshconfig' <- | ||
39 | case qs of | ||
40 | d:ds -> error "modify GlobalKnownHostsFile" | ||
41 | [] -> error "append GlobalKnownHostsFile" | ||
42 | L.writeFile (root "/var/cache/kiki/ssh_known_hosts") $ unparseSshConfig sshconfig' | ||
43 | -- /root/.gnupg/... <-- contains known hosts from /etc/ssh/ssh_known_hosts | ||
44 | Kiki.refresh | ||
45 | -- /var/cache/kiki/ssh_known_hosts <-- contains known hosts from /root/.gnupg/... | ||
46 | |||
47 | |||
48 | sshClient uid = return () | ||
49 | |||
50 | sshServer = do | ||
51 | -- /etc/ssh/sshd_config <-- 'HostKey /var/cache/kiki/ssh_host_ecdsa_key' etc. | ||
52 | return () | ||
53 | |||
54 | strongswan = do | ||
55 | -- etc/ipsec.conf <-- 'include /var/cache/kiki/ipsec.conf' | ||
56 | -- /root/.gnupg/... <-- contains newly-generated ipsec subkey | ||
57 | Kiki.refresh | ||
58 | -- /var/cache/kiki/ipsec.conf <-- contains configurations for each remote ipsec host | ||
59 | -- /var/cache/kiki/ipsec.conf <-- contains '%default' configuration for this local host | ||
60 | -- /var/cache/kiki/ipsec.d/certs <-- contains relevant certs | ||
61 | -- /var/cache/kiki/ipsec.d/private <-- contains private key | ||
62 | |||
63 | |||
64 | parseSshConfig bs = map tokenize $ L8.lines bs | ||
65 | where | ||
66 | tokenize l = L8.groupBy tokrel l' ++ [comment] | ||
67 | where (l', comment) = L8.break (=='#') l | ||
68 | tokrel x y = isSpace x == isSpace y | ||
69 | |||
70 | sshSplitAtDirective d sshconfig = splitAt (sshIsDirective d) sshconfig | ||
71 | |||
72 | sshIsDirective d ls = | ||
73 | case dropWhile isSpaceTok ls of | ||
74 | g:_ | g == d -> True | ||
75 | _ -> False | ||
76 | where | ||
77 | isSpaceTok "" = True | ||
78 | isSpaceTok b = isSpace $ L8.head b | ||