tests/support/server.tcl

   1 proc error_and_quit {config_file error} {
   2     puts "!!COULD NOT START REDIS-SERVER\n"
   3     puts "CONFIGURATION:"
   4     puts [exec cat $config_file]
   5     puts "\nERROR:"
   6     puts [string trim $error]
   7     exit 1
   8 }
   9
  10 proc check_valgrind_errors stderr {
  11     set fd [open $stderr]
  12     set buf [read $fd]
  13     close $fd
  14
  15     if {![regexp -- {ERROR SUMMARY: 0 errors} $buf] ||
  16         ![regexp -- {definitely lost: 0 bytes} $buf]} {
  17         puts "*** VALGRIND ERRORS ***"
  18         puts $buf
  19         puts "--- press enter to continue ---"
  20         gets stdin
  21     }
  22 }
  23
  24 proc kill_server config {
  25     # nevermind if its already dead
  26     if {![is_alive $config]} { return }
  27     set pid [dict get $config pid]
  28
  29     # check for leaks
  30     if {![dict exists $config "skipleaks"]} {
  31         catch {
  32             if {[string match {*Darwin*} [exec uname -a]]} {
  33                 test "Check for memory leaks (pid $pid)" {
  34                     exec leaks $pid
  35                 } {*0 leaks*}
  36             }
  37         }
  38     }
  39
  40     # kill server and wait for the process to be totally exited
  41     while {[is_alive $config]} {
  42         if {[incr wait 10] % 1000 == 0} {
  43             puts "Waiting for process $pid to exit..."
  44         }
  45         catch {exec kill $pid}
  46         after 10
  47     }
  48
  49     # Check valgrind errors if needed
  50     if {$::valgrind} {
  51         check_valgrind_errors [dict get $config stderr]
  52     }
  53 }
  54
  55 proc is_alive config {
  56     set pid [dict get $config pid]
  57     if {[catch {exec ps -p $pid} err]} {
  58         return 0
  59     } else {
  60         return 1
  61     }
  62 }
  63
  64 proc ping_server {host port} {
  65     set retval 0
  66     if {[catch {
  67         set fd [socket $::host $::port]
  68         fconfigure $fd -translation binary
  69         puts $fd "PING\r\n"
  70         flush $fd
  71         set reply [gets $fd]
  72         if {[string range $reply 0 4] eq {+PONG} ||
  73             [string range $reply 0 3] eq {-ERR}} {
  74             set retval 1
  75         }
  76         close $fd
  77     } e]} {
  78         puts "Can't PING server at $host:$port... $e"
  79     }
  80     return $retval
  81 }
  82
  83 set ::global_overrides {}
  84 proc start_server {options {code undefined}} {
  85     # setup defaults
  86     set baseconfig "default.conf"
  87     set overrides {}
  88
  89     # parse options
  90     foreach {option value} $options {
  91         switch $option {
  92             "config" { set baseconfig $value }
  93             "overrides" { set overrides $value }
  94             default { error "Unknown option $option" }
  95         }
  96     }
  97
  98     set data [split [exec cat "tests/assets/$baseconfig"] "\n"]
  99     set config {}
 100     foreach line $data {
 101         if {[string length $line] > 0 && [string index $line 0] ne "#"} {
 102             set elements [split $line " "]
 103             set directive [lrange $elements 0 0]
 104             set arguments [lrange $elements 1 end]
 105             dict set config $directive $arguments
 106         }
 107     }
 108
 109     # use a different directory every time a server is started
 110     dict set config dir [tmpdir server]
 111
 112     # start every server on a different port
 113     dict set config port [incr ::port]
 114
 115     # apply overrides from global space and arguments
 116     foreach {directive arguments} [concat $::global_overrides $overrides] {
 117         dict set config $directive $arguments
 118     }
 119
 120     # write new configuration to temporary file
 121     set config_file [tmpfile redis.conf]
 122     set fp [open $config_file w+]
 123     foreach directive [dict keys $config] {
 124         puts -nonewline $fp "$directive "
 125         puts $fp [dict get $config $directive]
 126     }
 127     close $fp
 128
 129     set stdout [format "%s/%s" [dict get $config "dir"] "stdout"]
 130     set stderr [format "%s/%s" [dict get $config "dir"] "stderr"]
 131
 132     if {$::valgrind} {
 133         exec valgrind ./redis-server $config_file > $stdout 2> $stderr &
 134         after 2000
 135     } else {
 136         exec ./redis-server $config_file > $stdout 2> $stderr &
 137         after 500
 138     }
 139
 140     # check that the server actually started
 141     if {$code ne "undefined" && ![ping_server $::host $::port]} {
 142         error_and_quit $config_file [exec cat $stderr]
 143     }
 144
 145     # find out the pid
 146     while {![info exists pid]} {
 147         regexp {^\[(\d+)\]} [exec head -n1 $stdout] _ pid
 148         after 100
 149     }
 150
 151     # setup properties to be able to initialize a client object
 152     set host $::host
 153     set port $::port
 154     if {[dict exists $config bind]} { set host [dict get $config bind] }
 155     if {[dict exists $config port]} { set port [dict get $config port] }
 156
 157     # setup config dict
 158     dict set srv "config" $config_file
 159     dict set srv "pid" $pid
 160     dict set srv "host" $host
 161     dict set srv "port" $port
 162     dict set srv "stdout" $stdout
 163     dict set srv "stderr" $stderr
 164
 165     # if a block of code is supplied, we wait for the server to become
 166     # available, create a client object and kill the server afterwards
 167     if {$code ne "undefined"} {
 168         set line [exec head -n1 $stdout]
 169         if {[string match {*already in use*} $line]} {
 170             error_and_quit $config_file $line
 171         }
 172
 173         while 1 {
 174             # check that the server actually started and is ready for connections
 175             if {[exec cat $stdout | grep "ready to accept" | wc -l] > 0} {
 176                 break
 177             }
 178             after 10
 179         }
 180
 181         set client [redis $host $port]
 182         dict set srv "client" $client
 183
 184         # select the right db when we don't have to authenticate
 185         if {![dict exists $config requirepass]} {
 186             $client select 9
 187         }
 188
 189         # append the server to the stack
 190         lappend ::servers $srv
 191
 192         # execute provided block
 193         catch { uplevel 1 $code } err
 194
 195         # pop the server object
 196         set ::servers [lrange $::servers 0 end-1]
 197
 198         # allow an exception to bubble up the call chain but still kill this
 199         # server, because we want to reuse the ports when the tests are re-run
 200         if {$err eq "exception"} {
 201             puts [format "Logged warnings (pid %d):" [dict get $srv "pid"]]
 202             set warnings [warnings_from_file [dict get $srv "stdout"]]
 203             if {[string length $warnings] > 0} {
 204                 puts "$warnings"
 205             } else {
 206                 puts "(none)"
 207             }
 208             # kill this server without checking for leaks
 209             dict set srv "skipleaks" 1
 210             kill_server $srv
 211             error "exception"
 212         } elseif {[string length $err] > 0} {
 213             puts "Error executing the suite, aborting..."
 214             puts $err
 215             exit 1
 216         }
 217
 218         kill_server $srv
 219     } else {
 220         set _ $srv
 221     }
 222 }