diff options
-rw-r--r-- | lib/ProcessUtils.hs | 1 | ||||
-rw-r--r-- | testkiki/testkiki.hs | 30 |
2 files changed, 24 insertions, 7 deletions
diff --git a/lib/ProcessUtils.hs b/lib/ProcessUtils.hs index 492d666..b89edb9 100644 --- a/lib/ProcessUtils.hs +++ b/lib/ProcessUtils.hs | |||
@@ -5,6 +5,7 @@ module ProcessUtils | |||
5 | , systemEnv | 5 | , systemEnv |
6 | , readPipe | 6 | , readPipe |
7 | , readProcessWithErrorH | 7 | , readProcessWithErrorH |
8 | , runExternal | ||
8 | ) where | 9 | ) where |
9 | 10 | ||
10 | import GHC.IO.Exception ( ioException, IOErrorType(..) ) | 11 | import GHC.IO.Exception ( ioException, IOErrorType(..) ) |
diff --git a/testkiki/testkiki.hs b/testkiki/testkiki.hs index ea6ad80..90b6635 100644 --- a/testkiki/testkiki.hs +++ b/testkiki/testkiki.hs | |||
@@ -28,6 +28,7 @@ import Crypto.Hash.SHA1 (hash) | |||
28 | import System.IO.Unsafe (unsafePerformIO) | 28 | import System.IO.Unsafe (unsafePerformIO) |
29 | import ProcessUtils | 29 | import ProcessUtils |
30 | import Data.Bool | 30 | import Data.Bool |
31 | import Data.Char | ||
31 | 32 | ||
32 | #if !MIN_VERSION_base(4,7,0) | 33 | #if !MIN_VERSION_base(4,7,0) |
33 | setEnv k v = System.Posix.Env.setEnv k v True | 34 | setEnv k v = System.Posix.Env.setEnv k v True |
@@ -264,7 +265,7 @@ doTests tkConfig = hspec $ do | |||
264 | it "modifies system ssh configuration to respect /var/cache/kiki/ssh_known_hosts." $ | 265 | it "modifies system ssh configuration to respect /var/cache/kiki/ssh_known_hosts." $ |
265 | onlyIf didInit3 $ do | 266 | onlyIf didInit3 $ do |
266 | let cfg' = appendpaths tkConfig "3" | 267 | let cfg' = appendpaths tkConfig "3" |
267 | home = chroot cfg' </> "root" | 268 | home = "root" -- chroot cfg' </> "root" |
268 | gnuhome = home </> ".gnupg" | 269 | gnuhome = home </> ".gnupg" |
269 | cfg = cfg' { gnupghome = gnuhome } | 270 | cfg = cfg' { gnupghome = gnuhome } |
270 | etcFile = chroot cfg </> "etc" </> "ssh" </> "ssh_config" | 271 | etcFile = chroot cfg </> "etc" </> "ssh" </> "ssh_config" |
@@ -280,18 +281,31 @@ doTests tkConfig = hspec $ do | |||
280 | let hasSubStr file x = | 281 | let hasSubStr file x = |
281 | doesFileExist file >>= | 282 | doesFileExist file >>= |
282 | (bool (return False) $ B.isPrefixOf x . snd . B.breakSubstring x <$> B.readFile file) | 283 | (bool (return False) $ B.isPrefixOf x . snd . B.breakSubstring x <$> B.readFile file) |
284 | let hasUnCommentedSubStr file x = | ||
285 | doesFileExist file >>= (bool (return False) $ do | ||
286 | let dropSp = B.dropWhile isSpace | ||
287 | nonComment x = not ("#" `B.isPrefixOf` x) | ||
288 | lines <- filter nonComment . map dropSp . B.lines <$> B.readFile file | ||
289 | return (any (x `B.isInfixOf`) lines) ) | ||
283 | -- does it already mention /var/cache/kiki/ssh_known_hosts? expect not | 290 | -- does it already mention /var/cache/kiki/ssh_known_hosts? expect not |
284 | subStr0 <- etcFile `hasSubStr` "/var/cache/kiki/ssh_known_hosts" | 291 | subStr0 <- etcFile `hasSubStr` "/var/cache/kiki/ssh_known_hosts" |
285 | cokiki cfg ["ssh-client"] myStdErr | 292 | bReplace <- etcFile `hasUnCommentedSubStr` "GlobalKnownHostsFile" |
293 | (code,(outs,ers)) <- runExternal (mkCokiki cfg ["ssh-client"]) Nothing | ||
294 | -- outs <- cokiki cfg ["ssh-client"] myStdErr | ||
295 | B.putStrLn outs | ||
296 | B.putStrLn ers | ||
286 | -- get counts of lines subtracted, and lines added, expect (1,1) | 297 | -- get counts of lines subtracted, and lines added, expect (1,1) |
287 | (lost,gained) <- linesSubtractedAndAdded etcFile | 298 | (lost,gained) <- linesSubtractedAndAdded etcFile |
288 | -- did Sha1 change? expect it did | 299 | -- did Sha1 change? expect it did |
289 | bChanged <- compareSha1 etcFile | 300 | bChanged <- isChangedSha1 etcFile |
290 | -- does it mention /var/cache/kiki/ssh_known_hosts now? expect it does | 301 | -- does it mention /var/cache/kiki/ssh_known_hosts now? expect it does |
291 | subStr <- etcFile `hasSubStr` "/var/cache/kiki/ssh_known_hosts" | 302 | subStr <- etcFile `hasSubStr` "/var/cache/kiki/ssh_known_hosts" |
292 | -- new mtime | 303 | -- new mtime |
293 | mtime <- getModificationTime etcFile | 304 | mtime <- getModificationTime etcFile |
294 | (lost,gained,bChanged,(subStr0,subStr),compare mtime mtime0) `shouldBe` (1,1,True,(False,True),GT) | 305 | if bReplace then |
306 | (lost,gained,bChanged,(subStr0,subStr)) `shouldBe` (1,1,True,(False,True)) | ||
307 | else | ||
308 | (lost,gained,bChanged,(subStr0,subStr)) `shouldBe` (0,1,True,(False,True)) | ||
295 | 309 | ||
296 | describe "cokiki ssh-server" $ do | 310 | describe "cokiki ssh-server" $ do |
297 | it "modifies system ssh config to use /var/cache/kiki/ssh_host_rsa_key." $ | 311 | it "modifies system ssh config to use /var/cache/kiki/ssh_host_rsa_key." $ |
@@ -375,6 +389,8 @@ doTests tkConfig = hspec $ do | |||
375 | unsetEnv "GNUPGHOME" | 389 | unsetEnv "GNUPGHOME" |
376 | return r | 390 | return r |
377 | 391 | ||
392 | mkCokiki config args = unwords ("./dist/build/cokiki/cokiki": args ++ ["--chroot=" ++ chroot config, "--homedir=" ++ gnupghome config]) | ||
393 | |||
378 | cokiki config args eH = do | 394 | cokiki config args eH = do |
379 | let args' = args ++ ["--chroot=" ++ chroot config, "--homedir=" ++ gnupghome config] | 395 | let args' = args ++ ["--chroot=" ++ chroot config, "--homedir=" ++ gnupghome config] |
380 | readProcessWithErrorH "./dist/build/kiki/kiki" args' "" eH | 396 | readProcessWithErrorH "./dist/build/kiki/kiki" args' "" eH |
@@ -397,13 +413,13 @@ saveFileInfo file = do | |||
397 | readProcess "cp" ["-aR",file,fileDotOld] "" | 413 | readProcess "cp" ["-aR",file,fileDotOld] "" |
398 | return (mtime,fileDotOld) | 414 | return (mtime,fileDotOld) |
399 | 415 | ||
400 | compareSha1 :: FilePath -> IO Bool | 416 | isChangedSha1 :: FilePath -> IO Bool |
401 | compareSha1 file = do | 417 | isChangedSha1 file = do |
402 | let folder = takeDirectory file | 418 | let folder = takeDirectory file |
403 | fileDotOld = file ++ ".old" | 419 | fileDotOld = file ++ ".old" |
404 | hash1 <- hash <$> B.readFile fileDotOld | 420 | hash1 <- hash <$> B.readFile fileDotOld |
405 | hash2 <- hash <$> B.readFile file | 421 | hash2 <- hash <$> B.readFile file |
406 | return (hash1 == hash2) | 422 | return (hash1 /= hash2) |
407 | 423 | ||
408 | getMTimes :: FilePath -> IO (UTCTime, UTCTime) | 424 | getMTimes :: FilePath -> IO (UTCTime, UTCTime) |
409 | getMTimes file = (,) <$> getModificationTime oldfile <*> getModificationTime file | 425 | getMTimes file = (,) <$> getModificationTime oldfile <*> getModificationTime file |