summaryrefslogtreecommitdiff
path: root/tests/support/server.tcl
blob: ead81e9eeabf804b5897f6bb51b55c2280c664d0 (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
proc error_and_quit {config_file error} {
    puts "!!COULD NOT START REDIS-SERVER\n"
    puts "CONFIGURATION:"
    puts [exec cat $config_file]
    puts "\nERROR:"
    puts [string trim $error]
    exit 1
}

proc kill_server config {
    set pid [dict get $config pid]

    # check for leaks
    catch {
        if {[string match {*Darwin*} [exec uname -a]]} {
            test {Check for memory leaks} {
                exec leaks $pid
            } {*0 leaks*}
        }
    }

    # kill server and wait for the process to be totally exited
    exec kill $pid
    while 1 {
        # with a non-zero exit status, the process is gone
        if {[catch {exec ps -p $pid | grep redis-server} result]} {
            break
        }
        after 10
    }
}

proc start_server {filename overrides {code undefined}} {
    set data [split [exec cat "tests/assets/$filename"] "\n"]
    set config {}
    foreach line $data {
        if {[string length $line] > 0 && [string index $line 0] ne "#"} {
            set elements [split $line " "]
            set directive [lrange $elements 0 0]
            set arguments [lrange $elements 1 end]
            dict set config $directive $arguments
        }
    }
    
    # use a different directory every time a server is started
    dict set config dir [tmpdir server]
    
    # start every server on a different port
    dict set config port [incr ::port]

    # apply overrides from arguments
    foreach override $overrides {
        set directive [lrange $override 0 0]
        set arguments [lrange $override 1 end]
        dict set config $directive $arguments
    }
    
    # write new configuration to temporary file
    set config_file [tmpfile redis.conf]
    set fp [open $config_file w+]
    foreach directive [dict keys $config] {
        puts -nonewline $fp "$directive "
        puts $fp [dict get $config $directive]
    }
    close $fp

    set stdout [format "%s/%s" [dict get $config "dir"] "stdout"]
    set stderr [format "%s/%s" [dict get $config "dir"] "stderr"]
    exec ./redis-server $config_file > $stdout 2> $stderr &
    after 500
    
    # check that the server actually started
    if {[file size $stderr] > 0} {
        error_and_quit $config_file [exec cat $stderr]
    }
    
    set line [exec head -n1 $stdout]
    if {[string match {*already in use*} $line]} {
        error_and_quit $config_file $line
    }

    while 1 {
        # check that the server actually started and is ready for connections
        if {[exec cat $stdout | grep "ready to accept" | wc -l] > 0} {
            break
        }
        after 10
    }

    # find out the pid
    regexp {^\[(\d+)\]} [exec head -n1 $stdout] _ pid

    # create the client object
    set host $::host
    set port $::port
    if {[dict exists $config bind]} { set host [dict get $config bind] }
    if {[dict exists $config port]} { set port [dict get $config port] }
    set client [redis $host $port]

    # select the right db when we don't have to authenticate
    if {![dict exists $config requirepass]} {
        $client select 9
    }

    # setup config dict
    dict set ret "config" $config_file
    dict set ret "pid" $pid
    dict set ret "stdout" $stdout
    dict set ret "stderr" $stderr
    dict set ret "client" $client

    if {$code ne "undefined"} {
        # append the client to the client stack
        lappend ::clients $client
        
        # execute provided block
        catch { uplevel 1 $code } err

        # pop the client object
        set ::clients [lrange $::clients 0 end-1]
        
        kill_server $ret

        if {[string length $err] > 0} {
            puts "Error executing the suite, aborting..."
            puts $err
            exit 1
        }
    } else {
        set _ $ret
    }
}