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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE CPP #-}
#if !MIN_VERSION_base(4,7,0)
import qualified System.Posix.Env
#endif
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
#if !MIN_VERSION_base(4,7,0)
setEnv k v = System.Posix.Env.setEnv k v True
unsetEnv = System.Posix.Env.unsetEnv
#endif
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 = "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
{-
-- Example of shouldThrow
describe "TODO: error" $
it "throws an exception" $
evaluate (error "TODO:testsuite") `shouldThrow` anyException
-}
-- **** kiki tests *****
describe "kiki 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 (chroot tkConfig </> 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
unsetEnv "GNUPGHOME"
createDirectoryIfMissing True (chroot tkConfig </> "root" </> ".gnupg")
output <- kiki ["init"]
let p = (chroot tkConfig </> "root" </> ".gnupg" </> "secring.gpg")
putStrLn $ "Does exist? " ++ show p
b <- doesFileExist p
(isInfixOf "New packet" output && b ) `shouldBe` True
describe "kiki 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 "kiki 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
-- **** cokiki tests *****
describe "cokiki ssh-client" $ do
it "modifies system ssh configuration to respect /var/cache/kiki/ssh_known_hosts" $ do
pending
it "sets kiki ssh-server key to /etc/ssh/ssh_host_rsa_key" $ do
pending
it "replaces existing ssh-server key with /etc/ssh/ssh_hosts_rsa_key" $ do
pending
it "refreshes /var/cache/kiki/*" $ do
pending
describe "cokiki ssh-server" $ do
it "does something" $
pending
describe "cokiki strongswan" $ do
it "does something" $
pending
where
kiki'Env config args = do
setEnv "GNUPGHOME" (gnupghome config)
let args' = args ++ ["--chroot=" ++ chroot config]
r <- readProcess "./dist/build/kiki/kiki" args' ""
unsetEnv "GNUPGHOME"
return r
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,"--homedir=" ++ 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,"--homedir=" ++ gnupghome config]
r <- readProcess "./dist/build/kiki/kiki" args' ""
unsetEnv "GNUPGHOME"
return r
cokiki config args = do
let args' = args ++ ["--chroot=" ++ chroot config, "--homedir=" ++ 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)
|