summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/ProcessUtils.hs1
-rw-r--r--testkiki/testkiki.hs30
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
10import GHC.IO.Exception ( ioException, IOErrorType(..) ) 11import 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)
28import System.IO.Unsafe (unsafePerformIO) 28import System.IO.Unsafe (unsafePerformIO)
29import ProcessUtils 29import ProcessUtils
30import Data.Bool 30import Data.Bool
31import Data.Char
31 32
32#if !MIN_VERSION_base(4,7,0) 33#if !MIN_VERSION_base(4,7,0)
33setEnv k v = System.Posix.Env.setEnv k v True 34setEnv 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
400compareSha1 :: FilePath -> IO Bool 416isChangedSha1 :: FilePath -> IO Bool
401compareSha1 file = do 417isChangedSha1 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
408getMTimes :: FilePath -> IO (UTCTime, UTCTime) 424getMTimes :: FilePath -> IO (UTCTime, UTCTime)
409getMTimes file = (,) <$> getModificationTime oldfile <*> getModificationTime file 425getMTimes file = (,) <$> getModificationTime oldfile <*> getModificationTime file