1set ::global_overrides {}
2set ::tags {}
3set ::valgrind_errors {}
4
5proc start_server_error {config_file error} {
6    set err {}
7    append err "Can't start the Redis server\n"
8    append err "CONFIGURATION:"
9    append err [exec cat $config_file]
10    append err "\nERROR:"
11    append err [string trim $error]
12    send_data_packet $::test_server_fd err $err
13}
14
15proc check_valgrind_errors stderr {
16    set res [find_valgrind_errors $stderr]
17    if {$res != ""} {
18        send_data_packet $::test_server_fd err "Valgrind error: $res\n"
19    }
20}
21
22proc clean_persistence config {
23    # we may wanna keep the logs for later, but let's clean the persistence
24    # files right away, since they can accumulate and take up a lot of space
25    set config [dict get $config "config"]
26    set rdb [format "%s/%s" [dict get $config "dir"] "dump.rdb"]
27    set aof [format "%s/%s" [dict get $config "dir"] "appendonly.aof"]
28    catch {exec rm -rf $rdb}
29    catch {exec rm -rf $aof}
30}
31
32proc kill_server config {
33    # nothing to kill when running against external server
34    if {$::external} return
35
36    # nevermind if its already dead
37    if {![is_alive $config]} {
38        # Check valgrind errors if needed
39        if {$::valgrind} {
40            check_valgrind_errors [dict get $config stderr]
41        }
42        return
43    }
44    set pid [dict get $config pid]
45
46    # check for leaks
47    if {![dict exists $config "skipleaks"]} {
48        catch {
49            if {[string match {*Darwin*} [exec uname -a]]} {
50                tags {"leaks"} {
51                    test "Check for memory leaks (pid $pid)" {
52                        set output {0 leaks}
53                        catch {exec leaks $pid} output
54                        if {[string match {*process does not exist*} $output] ||
55                            [string match {*cannot examine*} $output]} {
56                            # In a few tests we kill the server process.
57                            set output "0 leaks"
58                        }
59                        set output
60                    } {*0 leaks*}
61                }
62            }
63        }
64    }
65
66    # kill server and wait for the process to be totally exited
67    send_data_packet $::test_server_fd server-killing $pid
68    catch {exec kill $pid}
69    if {$::valgrind} {
70        set max_wait 60000
71    } else {
72        set max_wait 10000
73    }
74    while {[is_alive $config]} {
75        incr wait 10
76
77        if {$wait >= $max_wait} {
78            puts "Forcing process $pid to exit..."
79            catch {exec kill -KILL $pid}
80        } elseif {$wait % 1000 == 0} {
81            puts "Waiting for process $pid to exit..."
82        }
83        after 10
84    }
85
86    # Check valgrind errors if needed
87    if {$::valgrind} {
88        check_valgrind_errors [dict get $config stderr]
89    }
90
91    # Remove this pid from the set of active pids in the test server.
92    send_data_packet $::test_server_fd server-killed $pid
93}
94
95proc is_alive config {
96    set pid [dict get $config pid]
97    if {[catch {exec kill -0 $pid} err]} {
98        return 0
99    } else {
100        return 1
101    }
102}
103
104proc ping_server {host port} {
105    set retval 0
106    if {[catch {
107        if {$::tls} {
108            set fd [::tls::socket $host $port]
109        } else {
110            set fd [socket $host $port]
111        }
112        fconfigure $fd -translation binary
113        puts $fd "PING\r\n"
114        flush $fd
115        set reply [gets $fd]
116        if {[string range $reply 0 0] eq {+} ||
117            [string range $reply 0 0] eq {-}} {
118            set retval 1
119        }
120        close $fd
121    } e]} {
122        if {$::verbose} {
123            puts -nonewline "."
124        }
125    } else {
126        if {$::verbose} {
127            puts -nonewline "ok"
128        }
129    }
130    return $retval
131}
132
133# Return 1 if the server at the specified addr is reachable by PING, otherwise
134# returns 0. Performs a try every 50 milliseconds for the specified number
135# of retries.
136proc server_is_up {host port retrynum} {
137    after 10 ;# Use a small delay to make likely a first-try success.
138    set retval 0
139    while {[incr retrynum -1]} {
140        if {[catch {ping_server $host $port} ping]} {
141            set ping 0
142        }
143        if {$ping} {return 1}
144        after 50
145    }
146    return 0
147}
148
149# doesn't really belong here, but highly coupled to code in start_server
150proc tags {tags code} {
151    # If we 'tags' contain multiple tags, quoted and seperated by spaces,
152    # we want to get rid of the quotes in order to have a proper list
153    set tags [string map { \" "" } $tags]
154    set ::tags [concat $::tags $tags]
155    # We skip unwanted tags
156    foreach tag $::denytags {
157        if {[lsearch $::tags $tag] >= 0} {
158            incr ::num_aborted
159            send_data_packet $::test_server_fd ignore "Tag: $tag"
160            set ::tags [lrange $::tags 0 end-[llength $tags]]
161            return
162        }
163    }
164    uplevel 1 $code
165    set ::tags [lrange $::tags 0 end-[llength $tags]]
166}
167
168# Write the configuration in the dictionary 'config' in the specified
169# file name.
170proc create_server_config_file {filename config} {
171    set fp [open $filename w+]
172    foreach directive [dict keys $config] {
173        puts -nonewline $fp "$directive "
174        puts $fp [dict get $config $directive]
175    }
176    close $fp
177}
178
179proc spawn_server {config_file stdout stderr} {
180    if {$::valgrind} {
181        set pid [exec valgrind --track-origins=yes --trace-children=yes --suppressions=[pwd]/src/valgrind.sup --show-reachable=no --show-possibly-lost=no --leak-check=full src/redis-server $config_file >> $stdout 2>> $stderr &]
182    } elseif ($::stack_logging) {
183        set pid [exec /usr/bin/env MallocStackLogging=1 MallocLogFile=/tmp/malloc_log.txt src/redis-server $config_file >> $stdout 2>> $stderr &]
184    } else {
185        set pid [exec src/redis-server $config_file >> $stdout 2>> $stderr &]
186    }
187
188    if {$::wait_server} {
189        set msg "server started PID: $pid. press any key to continue..."
190        puts $msg
191        read stdin 1
192    }
193
194    # Tell the test server about this new instance.
195    send_data_packet $::test_server_fd server-spawned $pid
196    return $pid
197}
198
199# Wait for actual startup, return 1 if port is busy, 0 otherwise
200proc wait_server_started {config_file stdout pid} {
201    set checkperiod 100; # Milliseconds
202    set maxiter [expr {120*1000/$checkperiod}] ; # Wait up to 2 minutes.
203    set port_busy 0
204    while 1 {
205        if {[regexp -- " PID: $pid" [exec cat $stdout]]} {
206            break
207        }
208        after $checkperiod
209        incr maxiter -1
210        if {$maxiter == 0} {
211            start_server_error $config_file "No PID detected in log $stdout"
212            puts "--- LOG CONTENT ---"
213            puts [exec cat $stdout]
214            puts "-------------------"
215            break
216        }
217
218        # Check if the port is actually busy and the server failed
219        # for this reason.
220        if {[regexp {Could not create server TCP} [exec cat $stdout]]} {
221            set port_busy 1
222            break
223        }
224    }
225    return $port_busy
226}
227
228proc start_server {options {code undefined}} {
229    # setup defaults
230    set baseconfig "default.conf"
231    set overrides {}
232    set tags {}
233    set keep_persistence false
234
235    # parse options
236    foreach {option value} $options {
237        switch $option {
238            "config" {
239                set baseconfig $value
240            }
241            "overrides" {
242                set overrides $value
243            }
244            "tags" {
245                # If we 'tags' contain multiple tags, quoted and seperated by spaces,
246                # we want to get rid of the quotes in order to have a proper list
247                set tags [string map { \" "" } $value]
248                set ::tags [concat $::tags $tags]
249            }
250            "keep_persistence" {
251                set keep_persistence $value
252            }
253            default {
254                error "Unknown option $option"
255            }
256        }
257    }
258
259    # We skip unwanted tags
260    foreach tag $::denytags {
261        if {[lsearch $::tags $tag] >= 0} {
262            incr ::num_aborted
263            send_data_packet $::test_server_fd ignore "Tag: $tag"
264            set ::tags [lrange $::tags 0 end-[llength $tags]]
265            return
266        }
267    }
268
269    # If we are running against an external server, we just push the
270    # host/port pair in the stack the first time
271    if {$::external} {
272        if {[llength $::servers] == 0} {
273            set srv {}
274            dict set srv "host" $::host
275            dict set srv "port" $::port
276            set client [redis $::host $::port 0 $::tls]
277            dict set srv "client" $client
278            $client select 9
279
280            set config {}
281            dict set config "port" $::port
282            dict set srv "config" $config
283
284            # append the server to the stack
285            lappend ::servers $srv
286        }
287        r flushall
288        if {[catch {set retval [uplevel 1 $code]} error]} {
289            if {$::durable} {
290                set msg [string range $error 10 end]
291                lappend details $msg
292                lappend details $::errorInfo
293                lappend ::tests_failed $details
294
295                incr ::num_failed
296                send_data_packet $::test_server_fd err [join $details "\n"]
297            } else {
298                # Re-raise, let handler up the stack take care of this.
299                error $error $::errorInfo
300            }
301        }
302        set ::tags [lrange $::tags 0 end-[llength $tags]]
303        return
304    }
305
306    set data [split [exec cat "tests/assets/$baseconfig"] "\n"]
307    set config {}
308    if {$::tls} {
309        dict set config "tls-cert-file" [format "%s/tests/tls/redis.crt" [pwd]]
310        dict set config "tls-key-file" [format "%s/tests/tls/redis.key" [pwd]]
311        dict set config "tls-dh-params-file" [format "%s/tests/tls/redis.dh" [pwd]]
312        dict set config "tls-ca-cert-file" [format "%s/tests/tls/ca.crt" [pwd]]
313        dict set config "loglevel" "debug"
314    }
315    foreach line $data {
316        if {[string length $line] > 0 && [string index $line 0] ne "#"} {
317            set elements [split $line " "]
318            set directive [lrange $elements 0 0]
319            set arguments [lrange $elements 1 end]
320            dict set config $directive $arguments
321        }
322    }
323
324    # use a different directory every time a server is started
325    dict set config dir [tmpdir server]
326
327    # start every server on a different port
328    set port [find_available_port $::baseport $::portcount]
329    if {$::tls} {
330        dict set config "port" 0
331        dict set config "tls-port" $port
332        dict set config "tls-cluster" "yes"
333        dict set config "tls-replication" "yes"
334    } else {
335        dict set config port $port
336    }
337
338    set unixsocket [file normalize [format "%s/%s" [dict get $config "dir"] "socket"]]
339    dict set config "unixsocket" $unixsocket
340
341    # apply overrides from global space and arguments
342    foreach {directive arguments} [concat $::global_overrides $overrides] {
343        dict set config $directive $arguments
344    }
345
346    # write new configuration to temporary file
347    set config_file [tmpfile redis.conf]
348    create_server_config_file $config_file $config
349
350    set stdout [format "%s/%s" [dict get $config "dir"] "stdout"]
351    set stderr [format "%s/%s" [dict get $config "dir"] "stderr"]
352
353    # if we're inside a test, write the test name to the server log file
354    if {[info exists ::cur_test]} {
355        set fd [open $stdout "a+"]
356        puts $fd "### Starting server for test $::cur_test"
357        close $fd
358    }
359
360    # We need a loop here to retry with different ports.
361    set server_started 0
362    while {$server_started == 0} {
363        if {$::verbose} {
364            puts -nonewline "=== ($tags) Starting server ${::host}:${port} "
365        }
366
367        send_data_packet $::test_server_fd "server-spawning" "port $port"
368
369        set pid [spawn_server $config_file $stdout $stderr]
370
371        # check that the server actually started
372        set port_busy [wait_server_started $config_file $stdout $pid]
373
374        # Sometimes we have to try a different port, even if we checked
375        # for availability. Other test clients may grab the port before we
376        # are able to do it for example.
377        if {$port_busy} {
378            puts "Port $port was already busy, trying another port..."
379            set port [find_available_port $::baseport $::portcount]
380            if {$::tls} {
381                dict set config "tls-port" $port
382            } else {
383                dict set config port $port
384            }
385            create_server_config_file $config_file $config
386
387            # Truncate log so wait_server_started will not be looking at
388            # output of the failed server.
389            close [open $stdout "w"]
390
391            continue; # Try again
392        }
393
394        if {$::valgrind} {set retrynum 1000} else {set retrynum 100}
395        if {$code ne "undefined"} {
396            set serverisup [server_is_up $::host $port $retrynum]
397        } else {
398            set serverisup 1
399        }
400
401        if {$::verbose} {
402            puts ""
403        }
404
405        if {!$serverisup} {
406            set err {}
407            append err [exec cat $stdout] "\n" [exec cat $stderr]
408            start_server_error $config_file $err
409            return
410        }
411        set server_started 1
412    }
413
414    # setup properties to be able to initialize a client object
415    set port_param [expr $::tls ? {"tls-port"} : {"port"}]
416    set host $::host
417    if {[dict exists $config bind]} { set host [dict get $config bind] }
418    if {[dict exists $config $port_param]} { set port [dict get $config $port_param] }
419
420    # setup config dict
421    dict set srv "config_file" $config_file
422    dict set srv "config" $config
423    dict set srv "pid" $pid
424    dict set srv "host" $host
425    dict set srv "port" $port
426    dict set srv "stdout" $stdout
427    dict set srv "stderr" $stderr
428    dict set srv "unixsocket" $unixsocket
429
430    # if a block of code is supplied, we wait for the server to become
431    # available, create a client object and kill the server afterwards
432    if {$code ne "undefined"} {
433        set line [exec head -n1 $stdout]
434        if {[string match {*already in use*} $line]} {
435            error_and_quit $config_file $line
436        }
437
438        while 1 {
439            # check that the server actually started and is ready for connections
440            if {[exec grep -i "Ready to accept" | wc -l < $stdout] > 0} {
441                break
442            }
443            after 10
444        }
445
446        # append the server to the stack
447        lappend ::servers $srv
448
449        # connect client (after server dict is put on the stack)
450        reconnect
451
452        # execute provided block
453        set num_tests $::num_tests
454        if {[catch { uplevel 1 $code } error]} {
455            set backtrace $::errorInfo
456
457            # fetch srv back from the server list, in case it was restarted by restart_server (new PID)
458            set srv [lindex $::servers end]
459
460            # pop the server object
461            set ::servers [lrange $::servers 0 end-1]
462
463            # Kill the server without checking for leaks
464            dict set srv "skipleaks" 1
465            kill_server $srv
466
467            # Print warnings from log
468            puts [format "\nLogged warnings (pid %d):" [dict get $srv "pid"]]
469            set warnings [warnings_from_file [dict get $srv "stdout"]]
470            if {[string length $warnings] > 0} {
471                puts "$warnings"
472            } else {
473                puts "(none)"
474            }
475            puts ""
476
477            if {$::durable} {
478                set msg [string range $error 10 end]
479                lappend details $msg
480                lappend details $backtrace
481                lappend ::tests_failed $details
482
483                incr ::num_failed
484                send_data_packet $::test_server_fd err [join $details "\n"]
485            } else {
486                # Re-raise, let handler up the stack take care of this.
487                error $error $backtrace
488            }
489        }
490
491        # fetch srv back from the server list, in case it was restarted by restart_server (new PID)
492        set srv [lindex $::servers end]
493
494        # Don't do the leak check when no tests were run
495        if {$num_tests == $::num_tests} {
496            dict set srv "skipleaks" 1
497        }
498
499        # pop the server object
500        set ::servers [lrange $::servers 0 end-1]
501
502        set ::tags [lrange $::tags 0 end-[llength $tags]]
503        kill_server $srv
504        if {!$keep_persistence} {
505            clean_persistence $srv
506        }
507        set _ ""
508    } else {
509        set ::tags [lrange $::tags 0 end-[llength $tags]]
510        set _ $srv
511    }
512}
513
514proc restart_server {level wait_ready} {
515    set srv [lindex $::servers end+$level]
516    kill_server $srv
517
518    set stdout [dict get $srv "stdout"]
519    set stderr [dict get $srv "stderr"]
520    set config_file [dict get $srv "config_file"]
521
522    # if we're inside a test, write the test name to the server log file
523    if {[info exists ::cur_test]} {
524        set fd [open $stdout "a+"]
525        puts $fd "### Restarting server for test $::cur_test"
526        close $fd
527    }
528
529    set prev_ready_count [exec grep -i "Ready to accept" | wc -l < $stdout]
530
531    set pid [spawn_server $config_file $stdout $stderr]
532
533    # check that the server actually started
534    wait_server_started $config_file $stdout $pid
535
536    # update the pid in the servers list
537    dict set srv "pid" $pid
538    # re-set $srv in the servers list
539    lset ::servers end+$level $srv
540
541    if {$wait_ready} {
542        while 1 {
543            # check that the server actually started and is ready for connections
544            if {[exec grep -i "Ready to accept" | wc -l < $stdout] > $prev_ready_count + 1} {
545                break
546            }
547            after 10
548        }
549    }
550    reconnect $level
551}
552