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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
import Control.Applicative
import Control.DeepSeq
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
import CommandLine
usage = unlines
[ "cokiki <command> [--chroot=ROOTDIR] [--homedir=HOMEDIR] [--passphrase-fd=FD]"
, ""
, "COMMANDS"
, ""
, " ssh-client"
, " 1) Modify system ssh configuration to respect /var/cache/kiki/ssh_known_hosts."
, " 2) Set kiki ssh-server key to /etc/ssh/ssh_host_rsa_key. If kiki already has"
, " an ssh-server key configured, it will be replaced."
, " 3) Refresh /var/cache/kiki/*"
, ""
, " ssh-server: TODO"
, " strongswan: TODO"
]
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"] -> pure (sshClient uid) <*> Kiki.ㄧchroot <*> Kiki.ㄧhomedir
["ssh-server"] -> pure (whenRoot sshServer)
["strongswan"] -> pure (whenRoot strongswan)
_ -> pure $ hPutStr stderr usage
spec = uncurry fancy Kiki.kikiOptions ""
case runArgs (parseInvocation spec args) sel of
Left e -> hPutStrLn stderr $ usageErrorMessage e
Right io -> io
maybeReadFile :: FilePath -> IO (Maybe L.ByteString)
maybeReadFile path = do
doesFileExist path >>= bool (return Nothing) (Just <$> L.readFile path)
sshClient 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
myWriteFile f bs = do
hPutStrLn stderr $ "Writing "++f
-- L8.putStr bs
L8.writeFile f bs
sshconfig' <-
case qs of
d:ds | elem "/var/cache/kiki/ssh_known_hosts" d
-> do hPutStrLn stderr "ssh-client already configured."
return Nothing
d:ds -> do hPutStrLn stderr "modifying GlobalKnownHostsFile directive"
let hs = " " : "/var/cache/kiki/ssh_known_hosts" : drop 1 d
stmt = take 1 d ++ hs
return $ Just (ps ++ stmt : ds)
[] -> do -- Unconfigured add fresh directive.
let stmt = L8.unwords ["GlobalKnownHostsFile"
, "/var/cache/kiki/ssh_known_hosts"
, "/etc/ssh/ssh_known_hosts"
, "/etc/ssh/ssh_known_hosts2"
]
return $ Just (sshconfig ++ parseSshConfig stmt)
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 = 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 id (Kiki.CommonArgsParsed Nothing Nothing)
-- /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
#if !MIN_VERSION_base(4,7,0)
bool :: a -> a -> Bool -> a
bool f _ False = f
bool _ t True = t
#endif
|
