summaryrefslogtreecommitdiff
path: root/testkiki/testkiki.hs
blob: 839cebfdfd610caacfa1f22d8982c53522fc488d (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
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
{-# 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
    {- 
    -- 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 (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"]
            b <- doesFileExist (chroot tkConfig </> "root" </> ".gnupg" </> "secring.gpg")
            (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

        -- UTILS
        isInfixOf sub str = let (_,match) = B.breakSubstring (B.pack sub) (B.pack str)
                                in not (B.null match)