tests/support/server.tcl

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