blob: 2f249945ef6b682afa3542cab4dcc4a47e50b2d6 (
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
|
{-# LANGUAGE RecordWildCards #-}
module Main where
import Control.Exception
import Control.Monad
import Data.Functor
import Data.Maybe
import System.Directory
import System.Exit
import System.Environment
import System.FilePath
import System.Process
import Text.Printf
import Test.Hspec
import Config
import Spec
type Command = String
type Descr = (ClientName, ClientOpts -> FilePath -> Command)
torrents :: [FilePath]
torrents =
[ "dapper-dvd-amd64-iso.torrent"
, "pkg.torrent"
, "testfile.torrent"
]
rtorrentSessionDir :: String
rtorrentSessionDir = "rtorrent-sessiondir"
sessionName :: String -- screen session name
sessionName = "bittorrent-testsuite"
tmpDir :: FilePath
tmpDir = "res"
clients :: [Descr]
clients =
[ ("rtorrent"
, \ ClientOpts {..} tfile -> printf
"rtorrent -p %i-%i -O dht=on -O dht_port=%i -O session=%s %s"
(fromEnum peerPort) (fromEnum peerPort) (fromEnum nodePort)
rtorrentSessionDir tfile
)
]
setupEnv :: EnvOpts -> IO (Maybe ())
setupEnv EnvOpts {..}
| Just client <- testClient
, Just mkCmd <- lookup client clients = do
_ <- printf "Setting up %s\n" client
let torrentPath = "testfile.torrent"
let runner = printf "screen -dm -S %s %s" sessionName
(mkCmd remoteOpts torrentPath)
wd <- getCurrentDirectory
createDirectoryIfMissing True (wd </> tmpDir </> rtorrentSessionDir)
_ <- createProcess (shell runner) { cwd = Just (wd </> tmpDir) }
return (Just ())
| Just client <- testClient = do
_ <- printf "Bad client `%s`, use one of %s\n" client (show (fst <$> clients))
return Nothing
| otherwise = do
_ <- printf "Running without remote client\n"
return (Just ())
terminateEnv :: IO ()
terminateEnv = do
wd <- getCurrentDirectory
removeDirectoryRecursive (wd </> tmpDir </> rtorrentSessionDir)
_ <- printf "closing screen session: %s\n" sessionName
_ <- system (printf "screen -S %s -X quit" sessionName)
return ()
runTestSuite :: [String] -> IO ExitCode
runTestSuite args = do
_ <- printf "running hspec test suite with args: %s\n" (show args)
catch (withArgs args (hspec spec) >> return ExitSuccess) return
withEnv :: EnvOpts -> IO a -> IO a
withEnv opts action = bracket (setupEnv opts) terminate (const action)
where
terminate running = do
when (isJust running) $ do
terminateEnv
main :: IO ()
main = do
(envOpts, suiteArgs) <- getOpts
withEnv envOpts $ do
code <- runTestSuite suiteArgs
exitWith code
|
