diff options
-rw-r--r-- | cokiki.hs | 20 | ||||
-rw-r--r-- | kiki.cabal | 1 | ||||
-rw-r--r-- | lib/Kiki.hs | 20 | ||||
-rw-r--r-- | testkiki/testkiki.hs | 10 |
4 files changed, 32 insertions, 19 deletions
@@ -78,22 +78,22 @@ whenRoot uid root cmn action | |||
78 | no = hPutStrLn stderr "operation requires root." | 78 | no = hPutStrLn stderr "operation requires root." |
79 | 79 | ||
80 | sshClient uid root cmn = whenRoot uid root cmn $ do | 80 | sshClient uid root cmn = whenRoot uid root cmn $ do |
81 | -- /etc/ssh/ssh_config <-- 'GlobalKnownHostsFile /var/cache/kiki/ssh_known_hosts' | 81 | -- /etc/ssh/config/ssh_config <-- 'GlobalKnownHostsFile /var/cache/kiki/ssh_known_hosts' |
82 | sshconfig <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ssh/ssh_config") | 82 | sshconfig <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ssh/ssh_config") |
83 | let (ps,qs) = sshSplitAtDirective "GlobalKnownHostsFile" sshconfig | 83 | let (ps,qs) = sshSplitAtDirective "GlobalKnownHostsFile" sshconfig |
84 | sshconfig' <- | 84 | sshconfig' <- |
85 | case qs of | 85 | case qs of |
86 | d:ds | elem "/var/cache/kiki/ssh_known_hosts" d | 86 | d:ds | elem "/var/cache/kiki/config/ssh_known_hosts" d |
87 | -> do hPutStrLn stderr "ssh-client already configured." | 87 | -> do hPutStrLn stderr "ssh-client already configured." |
88 | return Nothing | 88 | return Nothing |
89 | d:ds -> do hPutStrLn stderr "modifying GlobalKnownHostsFile directive" | 89 | d:ds -> do hPutStrLn stderr "modifying GlobalKnownHostsFile directive" |
90 | let hs = " " : "/var/cache/kiki/ssh_known_hosts" : drop 1 d | 90 | let hs = " " : "/var/cache/kiki/config/ssh_known_hosts" : drop 1 d |
91 | stmt = take 1 d ++ hs | 91 | stmt = take 1 d ++ hs |
92 | return $ Just (ps ++ stmt : ds) | 92 | return $ Just (ps ++ stmt : ds) |
93 | [] -> do -- Unconfigured add fresh directive. | 93 | [] -> do -- Unconfigured add fresh directive. |
94 | hPutStrLn stderr "adding GlobalKnownHostsFile directive" | 94 | hPutStrLn stderr "adding GlobalKnownHostsFile directive" |
95 | let stmt = L8.unwords ["GlobalKnownHostsFile" | 95 | let stmt = L8.unwords ["GlobalKnownHostsFile" |
96 | , "/var/cache/kiki/ssh_known_hosts" | 96 | , "/var/cache/kiki/config/ssh_known_hosts" |
97 | , "/etc/ssh/ssh_known_hosts" | 97 | , "/etc/ssh/ssh_known_hosts" |
98 | , "/etc/ssh/ssh_known_hosts2" | 98 | , "/etc/ssh/ssh_known_hosts2" |
99 | ] | 99 | ] |
@@ -101,31 +101,31 @@ sshClient uid root cmn = whenRoot uid root cmn $ do | |||
101 | sshconfig' `deepseq` return () -- force lazy input | 101 | sshconfig' `deepseq` return () -- force lazy input |
102 | maybe (return ()) (myWriteFile (root "/etc/ssh/ssh_config") . unparseSshConfig) sshconfig' | 102 | maybe (return ()) (myWriteFile (root "/etc/ssh/ssh_config") . unparseSshConfig) sshconfig' |
103 | 103 | ||
104 | -- /var/cache/kiki/ssh_known_hosts <-- contains known hosts from /root/.gnupg/... | 104 | -- /var/cache/kiki/config/ssh_known_hosts <-- contains known hosts from /root/.gnupg/... |
105 | Kiki.importAndRefresh root cmn | 105 | Kiki.importAndRefresh root cmn |
106 | 106 | ||
107 | sshServer uid root cmn = whenRoot uid root cmn $ do | 107 | sshServer uid root cmn = whenRoot uid root cmn $ do |
108 | sshconfig <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ssh/sshd_config") | 108 | sshconfig <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ssh/sshd_config") |
109 | let p:gs = groupBy (\_ d -> not $ sshIsDirective "HostKey" d) $ ["#"]:sshconfig | 109 | let p:gs = groupBy (\_ d -> not $ sshIsDirective "HostKey" d) $ ["#"]:sshconfig |
110 | got = filter (\(d:ds) -> elem "/var/cache/kiki/ssh_host_rsa_key" d) gs | 110 | got = filter (\(d:ds) -> elem "/var/cache/kiki/config/ssh_host_rsa_key" d) gs |
111 | case got of | 111 | case got of |
112 | _:_ -> do hPutStrLn stderr "ssh-server already configured." | 112 | _:_ -> do hPutStrLn stderr "ssh-server already configured." |
113 | [] -> do let sshconfig' = drop 1 $ sshconfig ++ [stmt] | 113 | [] -> do let sshconfig' = drop 1 $ sshconfig ++ [stmt] |
114 | stmt = ["HostKey", " ", "/var/cache/kiki/ssh_host_rsa_key"] | 114 | stmt = ["HostKey", " ", "/var/cache/kiki/config/ssh_host_rsa_key"] |
115 | hPutStrLn stderr "adding HostKey directive" | 115 | hPutStrLn stderr "adding HostKey directive" |
116 | myWriteFile (root "/etc/ssh/sshd_config") $ unparseSshConfig sshconfig' | 116 | myWriteFile (root "/etc/ssh/sshd_config") $ unparseSshConfig sshconfig' |
117 | -- /etc/ssh/sshd_config <-- 'HostKey /var/cache/kiki/ssh_host_ecdsa_key' etc. | 117 | -- /etc/ssh/sshd_config <-- 'HostKey /var/cache/kiki/config/ssh_host_ecdsa_key' etc. |
118 | Kiki.importAndRefresh root cmn | 118 | Kiki.importAndRefresh root cmn |
119 | 119 | ||
120 | strongswan uid root cmn = whenRoot uid root cmn $ do | 120 | strongswan uid root cmn = whenRoot uid root cmn $ do |
121 | -- Parsing as if ssh config, that's not right, but good enough for now. | 121 | -- Parsing as if ssh config, that's not right, but good enough for now. |
122 | ipsecconf <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ipsec.conf") | 122 | ipsecconf <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ipsec.conf") |
123 | let p:gs = groupBy (\_ d -> not $ sshIsDirective "include" d) $ ["#"]:ipsecconf | 123 | let p:gs = groupBy (\_ d -> not $ sshIsDirective "include" d) $ ["#"]:ipsecconf |
124 | got = filter (\(d:ds) -> elem "/var/cache/kiki/ipsec.conf" d) gs | 124 | got = filter (\(d:ds) -> elem "/var/cache/kiki/config/ipsec.conf" d) gs |
125 | case got of | 125 | case got of |
126 | _:_ -> do hPutStrLn stderr "ipsec already configured." | 126 | _:_ -> do hPutStrLn stderr "ipsec already configured." |
127 | [] -> do let ipsecconf' = drop 1 $ ipsecconf ++ [stmt] | 127 | [] -> do let ipsecconf' = drop 1 $ ipsecconf ++ [stmt] |
128 | stmt = ["include", " ", "/var/cache/kiki/ipsec.conf"] | 128 | stmt = ["include", " ", "/var/cache/kiki/config/ipsec.conf"] |
129 | hPutStrLn stderr "adding include directive" | 129 | hPutStrLn stderr "adding include directive" |
130 | myWriteFile (root "/etc/ipsec.conf") $ unparseSshConfig ipsecconf' | 130 | myWriteFile (root "/etc/ipsec.conf") $ unparseSshConfig ipsecconf' |
131 | -- etc/ipsec.conf <-- 'include /var/cache/kiki/ipsec.conf' | 131 | -- etc/ipsec.conf <-- 'include /var/cache/kiki/ipsec.conf' |
@@ -96,6 +96,7 @@ library | |||
96 | FunctorToMaybe | 96 | FunctorToMaybe |
97 | 97 | ||
98 | Build-Depends: base >=4.6.0.0, | 98 | Build-Depends: base >=4.6.0.0, |
99 | temporary, | ||
99 | asn1-encoding, | 100 | asn1-encoding, |
100 | asn1-types, | 101 | asn1-types, |
101 | binary, | 102 | binary, |
diff --git a/lib/Kiki.hs b/lib/Kiki.hs index 0e06ee2..34594cc 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs | |||
@@ -18,8 +18,10 @@ import Data.Ord | |||
18 | import System.Directory | 18 | import System.Directory |
19 | import System.FilePath.Posix | 19 | import System.FilePath.Posix |
20 | import System.IO | 20 | import System.IO |
21 | import System.IO.Temp | ||
21 | import System.Posix.User | 22 | import System.Posix.User |
22 | import System.Process | 23 | import System.Process |
24 | import System.Posix.Files | ||
23 | import qualified Codec.Binary.Base64 as Base64 | 25 | import qualified Codec.Binary.Base64 as Base64 |
24 | import qualified Data.ByteString.Lazy as L | 26 | import qualified Data.ByteString.Lazy as L |
25 | import qualified Data.ByteString.Lazy.Char8 as Char8 | 27 | import qualified Data.ByteString.Lazy.Char8 as Char8 |
@@ -212,9 +214,19 @@ importAndRefresh root cmn = do | |||
212 | refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () | 214 | refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () |
213 | refreshCache rt rootdir = do | 215 | refreshCache rt rootdir = do |
214 | 216 | ||
215 | let mkpath pth = fromMaybe "" rootdir ++ "/var/cache/kiki/"++pth | 217 | let getMkPathAndCommit destdir = do |
216 | 218 | let cachedir = takeDirectory destdir | |
217 | write' wr f bs = do | 219 | unslash ('/':xs) = xs |
220 | unslash xs = xs | ||
221 | createDirectoryIfMissing True cachedir | ||
222 | tmpdir <- createTempDirectory cachedir "tmp.dir" | ||
223 | createSymbolicLink tmpdir (tmpdir ++ ".link") | ||
224 | let mkpath pth = tmpdir </> unslash pth | ||
225 | commit = rename (tmpdir ++ ".link") destdir | ||
226 | return (mkpath,commit) | ||
227 | (mkpath, commit) <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config") | ||
228 | |||
229 | let write' wr f bs = do | ||
218 | createDirectoryIfMissing True $ takeDirectory f | 230 | createDirectoryIfMissing True $ takeDirectory f |
219 | wr f bs | 231 | wr f bs |
220 | write = write' writeFile | 232 | write = write' writeFile |
@@ -347,7 +359,7 @@ refreshCache rt rootdir = do | |||
347 | , " auto=route" | 359 | , " auto=route" |
348 | , "" | 360 | , "" |
349 | ] ++ filter (not . Char8.null) cons | 361 | ] ++ filter (not . Char8.null) cons |
350 | return () | 362 | commit |
351 | 363 | ||
352 | strongswanForContact addr oname = Char8.unlines | 364 | strongswanForContact addr oname = Char8.unlines |
353 | [ "conn " <> p oname | 365 | [ "conn " <> p oname |
diff --git a/testkiki/testkiki.hs b/testkiki/testkiki.hs index 90b6635..c8b141b 100644 --- a/testkiki/testkiki.hs +++ b/testkiki/testkiki.hs | |||
@@ -262,7 +262,7 @@ doTests tkConfig = hspec $ do | |||
262 | 262 | ||
263 | -- **** cokiki tests ***** | 263 | -- **** cokiki tests ***** |
264 | describe "cokiki ssh-client" $ do | 264 | describe "cokiki ssh-client" $ do |
265 | it "modifies system ssh configuration to respect /var/cache/kiki/ssh_known_hosts." $ | 265 | it "modifies system ssh configuration to respect /var/cache/kiki/config/ssh_known_hosts." $ |
266 | onlyIf didInit3 $ do | 266 | onlyIf didInit3 $ do |
267 | let cfg' = appendpaths tkConfig "3" | 267 | let cfg' = appendpaths tkConfig "3" |
268 | home = "root" -- chroot cfg' </> "root" | 268 | home = "root" -- chroot cfg' </> "root" |
@@ -287,8 +287,8 @@ doTests tkConfig = hspec $ do | |||
287 | nonComment x = not ("#" `B.isPrefixOf` x) | 287 | nonComment x = not ("#" `B.isPrefixOf` x) |
288 | lines <- filter nonComment . map dropSp . B.lines <$> B.readFile file | 288 | lines <- filter nonComment . map dropSp . B.lines <$> B.readFile file |
289 | return (any (x `B.isInfixOf`) lines) ) | 289 | return (any (x `B.isInfixOf`) lines) ) |
290 | -- does it already mention /var/cache/kiki/ssh_known_hosts? expect not | 290 | -- does it already mention /var/cache/kiki/config/ssh_known_hosts? expect not |
291 | subStr0 <- etcFile `hasSubStr` "/var/cache/kiki/ssh_known_hosts" | 291 | subStr0 <- etcFile `hasSubStr` "/var/cache/kiki/config/ssh_known_hosts" |
292 | bReplace <- etcFile `hasUnCommentedSubStr` "GlobalKnownHostsFile" | 292 | bReplace <- etcFile `hasUnCommentedSubStr` "GlobalKnownHostsFile" |
293 | (code,(outs,ers)) <- runExternal (mkCokiki cfg ["ssh-client"]) Nothing | 293 | (code,(outs,ers)) <- runExternal (mkCokiki cfg ["ssh-client"]) Nothing |
294 | -- outs <- cokiki cfg ["ssh-client"] myStdErr | 294 | -- outs <- cokiki cfg ["ssh-client"] myStdErr |
@@ -298,8 +298,8 @@ doTests tkConfig = hspec $ do | |||
298 | (lost,gained) <- linesSubtractedAndAdded etcFile | 298 | (lost,gained) <- linesSubtractedAndAdded etcFile |
299 | -- did Sha1 change? expect it did | 299 | -- did Sha1 change? expect it did |
300 | bChanged <- isChangedSha1 etcFile | 300 | bChanged <- isChangedSha1 etcFile |
301 | -- does it mention /var/cache/kiki/ssh_known_hosts now? expect it does | 301 | -- does it mention /var/cache/kiki/config/ssh_known_hosts now? expect it does |
302 | subStr <- etcFile `hasSubStr` "/var/cache/kiki/ssh_known_hosts" | 302 | subStr <- etcFile `hasSubStr` "/var/cache/kiki/config/ssh_known_hosts" |
303 | -- new mtime | 303 | -- new mtime |
304 | mtime <- getModificationTime etcFile | 304 | mtime <- getModificationTime etcFile |
305 | if bReplace then | 305 | if bReplace then |