diff options
-rw-r--r-- | lib/ProcessUtils.hs | 19 | ||||
-rw-r--r-- | testkiki/testkiki.hs | 80 |
2 files changed, 94 insertions, 5 deletions
diff --git a/lib/ProcessUtils.hs b/lib/ProcessUtils.hs index 06f6893..a6902be 100644 --- a/lib/ProcessUtils.hs +++ b/lib/ProcessUtils.hs | |||
@@ -3,6 +3,7 @@ module ProcessUtils | |||
3 | ( ExitCode(ExitFailure,ExitSuccess) | 3 | ( ExitCode(ExitFailure,ExitSuccess) |
4 | , systemEnv | 4 | , systemEnv |
5 | , readPipe | 5 | , readPipe |
6 | , readProcessWithErrorH | ||
6 | ) where | 7 | ) where |
7 | 8 | ||
8 | import GHC.IO.Exception ( ioException, IOErrorType(..) ) | 9 | import GHC.IO.Exception ( ioException, IOErrorType(..) ) |
@@ -14,6 +15,8 @@ import Data.Maybe ( isNothing ) | |||
14 | import System.IO.Error ( mkIOError, ioeSetErrorString ) | 15 | import System.IO.Error ( mkIOError, ioeSetErrorString ) |
15 | import System.Exit ( ExitCode(..) ) | 16 | import System.Exit ( ExitCode(..) ) |
16 | import System.IO | 17 | import System.IO |
18 | import Control.Applicative | ||
19 | import Control.Exception (bracket) | ||
17 | 20 | ||
18 | 21 | ||
19 | -- | systemEnv | 22 | -- | systemEnv |
@@ -83,3 +86,19 @@ readPipe ((cmd,args):xs) stdin0 = do | |||
83 | (Nothing,Just sout,Just serr, ph) <- createProcess p | 86 | (Nothing,Just sout,Just serr, ph) <- createProcess p |
84 | readPipe0 xs sout | 87 | readPipe0 xs sout |
85 | readPipe0 [] h = hGetContents h | 88 | readPipe0 [] h = hGetContents h |
89 | |||
90 | |||
91 | readProcessWithErrorH :: FilePath -> [String] -> String -> Handle -> IO String | ||
92 | readProcessWithErrorH cmd args stdin erH = do | ||
93 | let p = (shell cmd) { std_in = CreatePipe | ||
94 | , std_out = CreatePipe | ||
95 | , std_err = UseHandle erH | ||
96 | , cmdspec = RawCommand cmd args | ||
97 | } | ||
98 | bracket (createProcess p) | ||
99 | (\(Just sinh,Just sout,_, ph) -> | ||
100 | mapM_ hClose [sinh,sout] ) | ||
101 | (\(Just sinh,Just sout,_, ph) -> do | ||
102 | hPutStr sinh stdin | ||
103 | hClose sinh | ||
104 | hGetContents sout ) | ||
diff --git a/testkiki/testkiki.hs b/testkiki/testkiki.hs index b693601..2a19889 100644 --- a/testkiki/testkiki.hs +++ b/testkiki/testkiki.hs | |||
@@ -1,6 +1,8 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | 1 | {-# LANGUAGE OverloadedStrings #-} |
2 | {-# LANGUAGE DoAndIfThenElse #-} | 2 | {-# LANGUAGE DoAndIfThenElse #-} |
3 | {-# LANGUAGE CPP #-} | 3 | {-# LANGUAGE CPP #-} |
4 | {-# LANGUAGE ScopedTypeVariables #-} | ||
5 | {-# LANGUAGE TupleSections #-} | ||
4 | #if !MIN_VERSION_base(4,7,0) | 6 | #if !MIN_VERSION_base(4,7,0) |
5 | import qualified System.Posix.Env | 7 | import qualified System.Posix.Env |
6 | #endif | 8 | #endif |
@@ -256,18 +258,86 @@ doTests tkConfig = hspec $ do | |||
256 | -- **** cokiki tests ***** | 258 | -- **** cokiki tests ***** |
257 | describe "cokiki ssh-client" $ do | 259 | describe "cokiki ssh-client" $ do |
258 | it "modifies system ssh configuration to respect /var/cache/kiki/ssh_known_hosts." $ do | 260 | it "modifies system ssh configuration to respect /var/cache/kiki/ssh_known_hosts." $ do |
259 | pending | 261 | bDidInit3 <-readIORef didInit3 |
262 | if not bDidInit3 then skipThisTest else do | ||
263 | let cfg' = appendpaths tkConfig "3" | ||
264 | home = chroot cfg' </> "root" | ||
265 | gnuhome = home </> ".gnupg" | ||
266 | cfg = cfg' { gnupghome = gnuhome } | ||
267 | etcFile = chroot cfg </> "etc" </> "ssh" </> "ssh_config" | ||
268 | etcFileBS = B.pack etcFile | ||
269 | -- dump stderr here | ||
270 | withErrFile (takeDirectory (chroot cfg)) $ \myStdErr -> do | ||
271 | -- initialize config file with actual systems | ||
272 | bNotHere <- not <$> doesFileExist etcFile | ||
273 | when bNotHere $ do | ||
274 | createDirectoryIfMissing True (takeDirectory etcFile) | ||
275 | copyFile "/etc/ssh/ssh_config" etcFile | ||
276 | -- copy ssh_config to ssh_config.old, preserving timestamps | ||
277 | (mtime0,etcFile0) <- saveFileInfo etcFile | ||
278 | let hasSubStr x file = B.isPrefixOf x . snd . B.breakSubstring x <$> B.readFile file | ||
279 | -- does it already mention /var/cache/kiki/ssh_known_hosts? expect not | ||
280 | subStr0 <- etcFileBS `hasSubStr` "/var/cache/kiki/ssh_known_hosts" | ||
281 | cokiki cfg ["ssh-client"] myStdErr | ||
282 | -- get counts of lines subtracted, and lines added, expect (1,1) | ||
283 | (lost,gained) <- linesSubtractedAndAdded etcFile | ||
284 | -- did Sha1 change? expect it did | ||
285 | bChanged <- compareSha1 etcFile | ||
286 | -- does it mention /var/cache/kiki/ssh_known_hosts now? expect it does | ||
287 | subStr <- etcFileBS `hasSubStr` "/var/cache/kiki/ssh_known_hosts" | ||
288 | -- new mtime | ||
289 | mtime <- getModificationTime etcFile | ||
290 | (lost,gained,bChanged,(subStr0,subStr),compare mtime mtime0) `shouldBe` (1,1,True,(False,True),GT) | ||
260 | 291 | ||
261 | describe "cokiki ssh-server" $ do | 292 | describe "cokiki ssh-server" $ do |
262 | it "modifies system ssh config to use /var/cache/kiki/ssh_host_rsa_key." $ do | 293 | it "modifies system ssh config to use /var/cache/kiki/ssh_host_rsa_key." $ do |
263 | pending | 294 | bDidInit3 <-readIORef didInit3 |
295 | if not bDidInit3 then skipThisTest else do | ||
296 | let cfg' = appendpaths tkConfig "3" | ||
297 | home = chroot cfg' </> "root" | ||
298 | gnuhome = home </> ".gnupg" | ||
299 | cfg = cfg' { gnupghome = gnuhome } | ||
300 | -- dump stderr here | ||
301 | withErrFile (takeDirectory (chroot cfg)) $ \myStdErr -> do | ||
302 | cokiki cfg ["ssh-server"] myStdErr | ||
303 | pending | ||
264 | 304 | ||
265 | describe "cokiki strongswan" $ do | 305 | describe "cokiki strongswan" $ do |
266 | it "modifies /etc/ipsec.conf to include settings from /var/cache/kiki/ipsec.conf." $ do | 306 | it "modifies /etc/ipsec.conf to include settings from /var/cache/kiki/ipsec.conf." $ do |
267 | pending | 307 | bDidInit3 <-readIORef didInit3 |
308 | if not bDidInit3 then skipThisTest else do | ||
309 | let cfg' = appendpaths tkConfig "3" | ||
310 | home = chroot cfg' </> "root" | ||
311 | gnuhome = home </> ".gnupg" | ||
312 | cfg = cfg' { gnupghome = gnuhome } | ||
313 | -- dump stderr here | ||
314 | withErrFile (takeDirectory (chroot cfg)) $ \myStdErr -> do | ||
315 | cokiki cfg ["strongswan"] myStdErr | ||
316 | pending | ||
268 | 317 | ||
269 | where | 318 | where |
270 | skipThisTest = pendingWith "SKIPPING due to prior failure." | 319 | skipThisTest = pendingWith "SKIPPING due to prior failure." |
320 | |||
321 | freshStdErrHandle tmpdir = openTempFile tmpdir "err.tmp" | ||
322 | |||
323 | withErrFile :: FilePath -> (Handle -> IO ()) -> IO () | ||
324 | withErrFile dir action = do | ||
325 | len <- (+1) . length <$> getCurrentDirectory | ||
326 | -- dump stderr here | ||
327 | bracket (freshStdErrHandle dir) | ||
328 | (\(_,h) -> hClose h) $ \(errfile,myStdErr) -> do | ||
329 | flip catch (\(e::SomeException) -> (do | ||
330 | b <- hIsOpen myStdErr | ||
331 | x <- if b then do | ||
332 | x' <- hGetContents myStdErr | ||
333 | hClose myStdErr | ||
334 | return x' | ||
335 | else readFile errfile | ||
336 | let e' = show e | ||
337 | if "Pending" `isPrefixOf` e' then throw e | ||
338 | else return (x,show e) | ||
339 | ) `shouldReturn` (drop len errfile,"EXCEPTION")) $ action myStdErr | ||
340 | |||
271 | kiki'Env config args = do | 341 | kiki'Env config args = do |
272 | setEnv "GNUPGHOME" (chroot config </> gnupghome config) | 342 | setEnv "GNUPGHOME" (chroot config </> gnupghome config) |
273 | let args' = args ++ ["--chroot=" ++ chroot config] | 343 | let args' = args ++ ["--chroot=" ++ chroot config] |
@@ -296,9 +366,9 @@ doTests tkConfig = hspec $ do | |||
296 | unsetEnv "GNUPGHOME" | 366 | unsetEnv "GNUPGHOME" |
297 | return r | 367 | return r |
298 | 368 | ||
299 | cokiki config args = do | 369 | cokiki config args eH = do |
300 | let args' = args ++ ["--chroot=" ++ chroot config, "--homedir=" ++ gnupghome config] | 370 | let args' = args ++ ["--chroot=" ++ chroot config, "--homedir=" ++ gnupghome config] |
301 | readProcess "./dist/build/kiki/kiki" args' "" | 371 | readProcessWithErrorH "./dist/build/kiki/kiki" args' "" eH |
302 | 372 | ||
303 | -- UTILS | 373 | -- UTILS |
304 | isInfixOf sub str = let (_,match) = B.breakSubstring (B.pack sub) (B.pack str) | 374 | isInfixOf sub str = let (_,match) = B.breakSubstring (B.pack sub) (B.pack str) |