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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
import Control.Applicative
import Control.DeepSeq
import Data.Bool
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.ByteString.Char8 as S8
import qualified Kiki
import System.Directory
import System.FilePath.Posix (takeDirectory)
import System.Environment
import System.Exit
import System.IO
import System.Posix.User
import CommandLine
import Data.OpenPGP (SymmetricAlgorithm(Unencrypted))
import qualified Hosts
usage = unlines
[ "cokiki <command> [--chroot=ROOTDIR]"
, " [--homedir=HOMEDIR]"
, " [--passphrase-fd=FD]"
, " [-(4|5)]"
, ""
, "cokiki modifies system configuration to recognize generated files"
, "in /var/cache/kiki. In addition to each command's documented effects"
, "(see COMMANDS), the following operation will be performed on your"
, "GnuPG keyring:"
, ""
, " master-key (generated if not present)"
, " tor (generated if not prsenet)"
, " ipsec (generated if not prsenet)"
, " ssh-server (imported or generated if not present)"
, " ssh-client (imported or gnnerated if not present)"
, ""
, "The /var/cache/kiki/* tree will also be refreshed."
, ""
, "COMMANDS"
, ""
, " ssh-client Modify system ssh configuration to respect"
, " /var/cache/kiki/config/ssh_known_hosts."
, ""
, " ssh-server Modify system ssh configuration to use the"
, " kiki-managed host key at"
, " /var/cache/kiki/config/ssh_host_rsa_key."
, ""
, " strongswan Modify /etc/ipsec.conf to include settings from"
, " /var/cache/kiki/config/ipsec.conf."
, ""
, " tor Modify /etc/tor/torrc to configure a tor hidden"
, " service for email (smtp), ssh, and http ports."
, ""
, " hosts Merge hostnames from /var/cache/kiki/config/hosts"
, " into system file /etc/hosts."
]
main = do
(cmd,args) <- splitAt 1 <$> getArgs
uid <- getEffectiveUserID
let msel = fmap (\c -> c <$> Kiki.dashdashPGPVersion <*> Kiki.dashdashChroot <*> Kiki.dashdashHomedir) $ case cmd of
["ssh-client"] -> Just $ sshClient uid
["ssh-server"] -> Just $ sshServer uid
["strongswan"] -> Just $ strongswan uid
["tor"] -> Just $ configureTor uid
["hosts"] -> Just $ configureHosts uid
_ -> Nothing
spec = uncurry fancy Kiki.kikiOptions ""
errorQuit msg = do
hPutStr stderr msg
System.Exit.exitFailure
fromMaybe (errorQuit usage) $ do
sel <- msel
Just $ do
case runArgs (parseInvocation spec args) sel of
Left e -> errorQuit $ usageErrorMessage e
Right io -> io
maybeReadFile :: FilePath -> IO (Maybe L.ByteString)
maybeReadFile path = do
doesFileExist path >>= bool (return Nothing) (Just <$> L.readFile path)
myWriteFile f bs = do
createDirectoryIfMissing True (takeDirectory f)
hPutStrLn stderr $ "Writing "++f
-- L8.putStr bs
L8.writeFile f bs
whenRoot uid root cmn action
| uid==0 = action
| root "" == "/" = no
| root "" == "" = no
| otherwise = action
where
no = hPutStrLn stderr "operation requires root."
sshClient uid pgpver root cmn = whenRoot uid root cmn $ do
-- /etc/ssh/config/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 | elem "/var/cache/kiki/config/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/config/ssh_known_hosts" : drop 1 d
stmt = take 1 d ++ hs
return $ Just (ps ++ stmt : ds)
[] -> do -- Unconfigured add fresh directive.
hPutStrLn stderr "adding GlobalKnownHostsFile directive"
let stmt = L8.unwords ["GlobalKnownHostsFile"
, "/var/cache/kiki/config/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'
-- /var/cache/kiki/config/ssh_known_hosts <-- contains known hosts from /root/.gnupg/...
Kiki.importAndRefresh pgpver root cmn Unencrypted
sshServer uid pgpver root cmn = whenRoot uid root cmn $ do
sshconfig <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ssh/sshd_config")
let p:gs = groupBy (\_ d -> not $ sshIsDirective "HostKey" d) $ ["#"]:sshconfig
got = filter (\(d:ds) -> elem "/var/cache/kiki/config/ssh_host_rsa_key" d) gs
case got of
_:_ -> do hPutStrLn stderr "ssh-server already configured."
[] -> do let sshconfig' = drop 1 $ sshconfig ++ [stmt]
stmt = ["HostKey", " ", "/var/cache/kiki/config/ssh_host_rsa_key"]
hPutStrLn stderr "adding HostKey directive"
myWriteFile (root "/etc/ssh/sshd_config") $ unparseSshConfig sshconfig'
-- /etc/ssh/sshd_config <-- 'HostKey /var/cache/kiki/config/ssh_host_ecdsa_key' etc.
Kiki.importAndRefresh pgpver root cmn Unencrypted
strongswan uid pgpver root cmn = whenRoot uid root cmn $ do
-- (1) /etc/ipsec.conf <-- 'include /var/cache/kiki/config/ipsec.conf'
-- Parsing as if ssh config, that's not right, but good enough for now.
ipsecconf <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ipsec.conf")
let p:gs = groupBy (\_ d -> not $ sshIsDirective "include" d) $ ["#"]:ipsecconf
got = filter (\(d:ds) -> elem "/var/cache/kiki/config/ipsec.conf" d) gs
case got of
_:_ -> do hPutStrLn stderr "ipsec.conf already configured."
[] -> do let ipsecconf' = drop 1 $ ipsecconf ++ [stmt]
stmt = ["include", " ", "/var/cache/kiki/config/ipsec.conf"]
hPutStrLn stderr "adding include directive"
myWriteFile (root "/etc/ipsec.conf") $ unparseSshConfig ipsecconf'
-- (2) /etc/ipsec.secrets/ <- include /var/cache/kiki/config/ipsec.secrets
-- Parsing as if ssh config, that's not right, but good enough for now.
ipsecconf <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ipsec.secrets")
let p:gs = groupBy (\_ d -> not $ sshIsDirective "include" d) $ ["#"]:ipsecconf
got = filter (\(d:ds) -> elem "/var/cache/kiki/config/ipsec.secrets" d) gs
case got of
_:_ -> do hPutStrLn stderr "ipsec.secrets already configured."
[] -> do let ipsecconf' = drop 1 $ ipsecconf ++ [stmt]
stmt = ["include", " ", "/var/cache/kiki/config/ipsec.secrets"]
hPutStrLn stderr "adding include directive"
myWriteFile (root "/etc/ipsec.secrets") $ unparseSshConfig ipsecconf'
Kiki.importAndRefresh pgpver root cmn Unencrypted
configureTor uid pgpver root cmn = whenRoot uid root cmn $ do
-- Parsing as if ssh config, that's not right, but good enough for now.
torrc <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/tor/torrc")
let p:gs = groupBy (\_ d -> not $ sshIsDirective "HiddenServiceDir" d) $ ["#"]:torrc
(fs, hs) = break (\(d:ds) -> elem "/var/cache/kiki/config/tor/" d) gs
case hs of
(d:ds):ks
| (pre:ports) <- groupBy (\_ d -> not $ sshIsDirective "HiddenServicePort" d) $ ["#"]:ds
, (got,need) <- partition (hasPort ports) ["80","22","25"]
-> case need of
[] -> hPutStrLn stderr "tor is already configured."
ns | (addr:_) <- mapMaybe (fmap fst . splitAddr . word 2) ds
-> do hPutStrLn stderr "binding tor ports for configured address"
bindports addr ns
| otherwise
-> do hPutStrLn stderr "binding tor ports for 127.0.0.1"
bindports "127.0.0.1" ns
where
bindports :: L.ByteString -> [L.ByteString] -> IO ()
bindports addr ns = do
let binds = map mkport ns
mkport n = ["HiddenServicePort"," ",n," ",addr <> ":" <> n]
torrc' = concat $ drop 1 p : fs ++ (d:binds ++ ds):ks
torrc' `deepseq` return () -- force lazy input
myWriteFile (root "/etc/tor/torrc") $ unparseSshConfig torrc'
hasPort :: [[[L.ByteString]]] -> L.ByteString -> Bool
hasPort ports p = not $ null $ flip filter ports
$ (==p) . word 1 . concat . take 1
word :: Int -> [L.ByteString] -> L.ByteString
word n toks = L.concat $ take 1 $ drop n words
where
words = filter (not . L8.any isSpace . L8.take 1)
toks
splitAddr lb
| S8.null saddr = Nothing
| otherwise = Just ( L.fromChunks [S8.init saddr]
, L.fromChunks [sport])
where
(saddr,sport) = S8.breakEnd (==':') sb
sb = S8.concat $ L.toChunks $ L.take 60 lb
[] -> do hPutStrLn stderr $ "configuring new hidden service"
let torrc' = torrc
++ [ []
, ["HiddenServiceDir"," ","/var/cache/kiki/config/tor/"]
, ["HiddenServicePort"," ","80"," ","127.0.0.1:80"]
, ["HiddenServicePort"," ","22"," ","127.0.0.1:22"]
, ["HiddenServicePort"," ","25"," ","127.0.0.1:25"] ]
myWriteFile (root "/etc/tor/torrc") $ unparseSshConfig torrc'
Kiki.importAndRefresh pgpver root cmn Unencrypted
return ()
configureHosts uid pgpver root cmn = whenRoot uid root cmn $ do
Kiki.importAndRefresh pgpver root cmn Unencrypted
hosts <- Hosts.decode . fromMaybe "" <$> maybeReadFile (root "/etc/hosts")
kikihosts <- Hosts.decode . fromMaybe "" <$> maybeReadFile (root "/var/cache/kiki/config/hosts")
let hosts' = hosts `Hosts.plus` kikihosts
case Hosts.diff hosts hosts' of
[] -> hPutStrLn stderr "kiki hosts are already merged."
_ -> myWriteFile (root "/etc/hosts") $ Hosts.encode hosts'
parseSshConfig :: L.ByteString -> [[L.ByteString]]
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
|
