blob: 0eb49f069849c95ae9d2ae200a9106e7a6c54d93 (
plain)
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
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DoAndIfThenElse #-}
import System.Environment
--import System.Posix.Env.ByteString (getEnv)
import System.Posix.Files
import Test.Hspec
import System.Process
import Control.Exception
import System.Directory
import System.FilePath
import System.Exit
import System.IO
--import System.Posix.ByteString.FilePath
import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
data TestKikiSettings = TKS
{ gnupghome :: FilePath
, chroot :: FilePath
}
deriving (Show,Eq)
main = do
args <- getArgs
cwd <- getCurrentDirectory
let chomp x = takeWhile (/='\n') x
date <- maybe (return "")
(\x -> chomp <$> readProcess x ["+%Y-%m-%d-%H%M"] "") =<< findExecutable "date"
let tdir = cwd </> "TESTS" </> date
{- -- Remove old TESTS, clean up directory
- -- XXX: get this to work right with HSpec
-
- when (args == ["clean"]) $ do
- removeDirectoryRecursive (cwd </> "TESTS")
-}
existsAlready <- or <$> (sequence $ map ($ tdir) [doesDirectoryExist,doesFileExist])
if existsAlready then do
hPutStrLn stderr ("Path " ++ show tdir ++ " already exists, remove or change working folder to run clean tests.")
exitFailure
else do
let chrootdir = cwd </> tdir </> "chroot"
gnupghomedir = cwd </> tdir </> "gnupghome"
createDirectoryIfMissing True chrootdir
createDirectoryIfMissing True gnupghomedir
let config = TKS { chroot = chrootdir , gnupghome = gnupghomedir }
print config
putStrLn "==="
doTests config
doTests :: TestKikiSettings -> IO ()
doTests tkConfig = hspec $ do
describe "TODO: error" $
it "throws an exception" $
evaluate (error "TODO:testsuite") `shouldThrow` anyException
describe "export-public" $ do
it "does not modify mtime of GNUPGHOME keyrings" $ do
pending
it "creates external pem files which do not exist" $ do
pending
it "does not leak secret data from GNUPGHOME keyrings" $ do
pending
describe "export-secret" $ do
it "fails when public keys in existing PEM files do not match" $ do
pending
it "updates public pem files to private ones when told to" $ do
pending
it "creates external pem files which do not exist" $ do
pending
describe "init" $ do
it "honors GNUPGHOME environment variable" $ do
let kiki = kiki'Env tkConfig
(isInfixOf "New packet" <$> kiki ["init"]) `shouldReturn` True
it "creates parent directories with --gnupghome" $ do
let kiki = kiki'Env'And'HomeArg tkConfig
{ gnupghome = chroot tkConfig </> "home" </> "tester" }
output <- kiki ["init"]
b <- doesDirectoryExist (gnupghome tkConfig)
(isInfixOf "New packet" output && b ) `shouldBe` True
it "creates new secring honoring GNUPGHOME" $ do
let kiki = kiki'Env'And'HomeArg tkConfig
output <- kiki ["init"]
b <- doesFileExist (gnupghome tkConfig </> "secring.gpg")
(isInfixOf "New packet" output && b ) `shouldBe` True
it "creates new secring in /root/.gnupg" $ do
let kiki = kiki'No'Env'No'Home tkConfig
output <- kiki ["init"]
b <- doesFileExist (chroot tkConfig </> "root" </> "secring.gpg")
(isInfixOf "New packet" output && b ) `shouldBe` True
where
kiki'Env config args = do
setEnv "GNUPGHOME" (gnupghome config)
let args' = args ++ ["--chroot=" ++ chroot config]
readProcess "./dist/build/kiki/kiki" args' ""
kiki'No'Env'No'Home config args = do
let args' = args ++ ["--chroot=" ++ chroot config]
readProcess "./dist/build/kiki/kiki" args' ""
kiki'No'Env config args = do
let args' = args ++ ["--chroot=" ++ chroot config,"--home=" ++ gnupghome config]
readProcess "./dist/build/kiki/kiki" args' ""
kiki'Env'And'HomeArg config args = do
setEnv "GNUPGHOME" (gnupghome config)
let args' = args ++ ["--chroot=" ++ chroot config,"--home=" ++ gnupghome config]
readProcess "./dist/build/kiki/kiki" args' ""
-- UTILS
isInfixOf sub str = let (_,match) = B.breakSubstring (B.pack sub) (B.pack str)
in not (B.null match)
|
