tests/support/server.tcl

   1 set ::global_overrides {}
   2 set ::tags {}
   3 set ::valgrind_errors {}
   4
   5 proc start_server_error {config_file error} {
   6     set err {}
   7     append err "Cant' 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
  15 proc check_valgrind_errors stderr {
  16     set fd [open $stderr]
  17     set buf [read $fd]
  18     close $fd
  19
  20     if {[regexp -- { at 0x} $buf] ||
  21         (![regexp -- {definitely lost: 0 bytes} $buf] &&
  22          ![regexp -- {no leaks are possible} $buf])} {
  23         send_data_packet $::test_server_fd err "Valgrind error: $buf\n"
  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     catch {exec kill $pid}
  50     while {[is_alive $config]} {
  51         incr wait 10
  52
  53         if {$wait >= 5000} {
  54             puts "Forcing process $pid to exit..."
  55             catch {exec kill -KILL $pid}
  56         } elseif {$wait % 1000 == 0} {
  57             puts "Waiting for process $pid to exit..."
  58         }
  59         after 10
  60     }
  61
  62     # Check valgrind errors if needed
  63     if {$::valgrind} {
  64         check_valgrind_errors [dict get $config stderr]
  65     }
  66 }
  67
  68 proc is_alive config {
  69     set pid [dict get $config pid]
  70     if {[catch {exec ps -p $pid} err]} {
  71         return 0
  72     } else {
  73         return 1
  74     }
  75 }
  76
  77 proc ping_server {host port} {
  78     set retval 0
  79     if {[catch {
  80         set fd [socket $::host $::port]
  81         fconfigure $fd -translation binary
  82         puts $fd "PING\r\n"
  83         flush $fd
  84         set reply [gets $fd]
  85         if {[string range $reply 0 4] eq {+PONG} ||
  86             [string range $reply 0 3] eq {-ERR}} {
  87             set retval 1
  88         }
  89         close $fd
  90     } e]} {
  91         if {$::verbose} {
  92             puts -nonewline "."
  93         }
  94     } else {
  95         if {$::verbose} {
  96             puts -nonewline "ok"
  97         }
  98     }
  99     return $retval
 100 }
 101
 102 # doesn't really belong here, but highly coupled to code in start_server
 103 proc tags {tags code} {
 104     set ::tags [concat $::tags $tags]
 105     uplevel 1 $code
 106     set ::tags [lrange $::tags 0 end-[llength $tags]]
 107 }
 108
 109 proc start_server {options {code undefined}} {
 110     # If we are runnign against an external server, we just push the
 111     # host/port pair in the stack the first time
 112     if {$::external} {
 113         if {[llength $::servers] == 0} {
 114             set srv {}
 115             dict set srv "host" $::host
 116             dict set srv "port" $::port
 117             set client [redis $::host $::port]
 118             dict set srv "client" $client
 119             $client select 9
 120
 121             # append the server to the stack
 122             lappend ::servers $srv
 123         }
 124         uplevel 1 $code
 125         return
 126     }
 127
 128     # setup defaults
 129     set baseconfig "default.conf"
 130     set overrides {}
 131     set tags {}
 132
 133     # parse options
 134     foreach {option value} $options {
 135         switch $option {
 136             "config" {
 137                 set baseconfig $value }
 138             "overrides" {
 139                 set overrides $value }
 140             "tags" {
 141                 set tags $value
 142                 set ::tags [concat $::tags $value] }
 143             default {
 144                 error "Unknown option $option" }
 145         }
 146     }
 147
 148     set data [split [exec cat "tests/assets/$baseconfig"] "\n"]
 149     set config {}
 150     foreach line $data {
 151         if {[string length $line] > 0 && [string index $line 0] ne "#"} {
 152             set elements [split $line " "]
 153             set directive [lrange $elements 0 0]
 154             set arguments [lrange $elements 1 end]
 155             dict set config $directive $arguments
 156         }
 157     }
 158
 159     # use a different directory every time a server is started
 160     dict set config dir [tmpdir server]
 161
 162     # start every server on a different port
 163     set ::port [find_available_port [expr {$::port+1}]]
 164     dict set config port $::port
 165
 166     # apply overrides from global space and arguments
 167     foreach {directive arguments} [concat $::global_overrides $overrides] {
 168         dict set config $directive $arguments
 169     }
 170
 171     # write new configuration to temporary file
 172     set config_file [tmpfile redis.conf]
 173     set fp [open $config_file w+]
 174     foreach directive [dict keys $config] {
 175         puts -nonewline $fp "$directive "
 176         puts $fp [dict get $config $directive]
 177     }
 178     close $fp
 179
 180     set stdout [format "%s/%s" [dict get $config "dir"] "stdout"]
 181     set stderr [format "%s/%s" [dict get $config "dir"] "stderr"]
 182
 183     if {$::valgrind} {
 184         exec valgrind --suppressions=src/valgrind.sup --show-reachable=no --show-possibly-lost=no --leak-check=full src/redis-server $config_file > $stdout 2> $stderr &
 185     } else {
 186         exec src/redis-server $config_file > $stdout 2> $stderr &
 187     }
 188
 189     # check that the server actually started
 190     # ugly but tries to be as fast as possible...
 191     if {$::valgrind} {set retrynum 1000} else {set retrynum 100}
 192     set serverisup 0
 193
 194     if {$::verbose} {
 195         puts -nonewline "=== ($tags) Starting server ${::host}:${::port} "
 196     }
 197
 198     after 10
 199     if {$code ne "undefined"} {
 200         while {[incr retrynum -1]} {
 201             catch {
 202                 if {[ping_server $::host $::port]} {
 203                     set serverisup 1
 204                 }
 205             }
 206             if {$serverisup} break
 207             after 50
 208         }
 209     } else {
 210         set serverisup 1
 211     }
 212
 213     if {$::verbose} {
 214         puts ""
 215     }
 216
 217     if {!$serverisup} {
 218         set err {}
 219         append err [exec cat $stdout] "\n" [exec cat $stderr]
 220         start_server_error $config_file $err
 221         return
 222     }
 223
 224     # find out the pid
 225     while {![info exists pid]} {
 226         regexp {\[(\d+)\]} [exec cat $stdout] _ pid
 227         after 100
 228     }
 229
 230     # setup properties to be able to initialize a client object
 231     set host $::host
 232     set port $::port
 233     if {[dict exists $config bind]} { set host [dict get $config bind] }
 234     if {[dict exists $config port]} { set port [dict get $config port] }
 235
 236     # setup config dict
 237     dict set srv "config_file" $config_file
 238     dict set srv "config" $config
 239     dict set srv "pid" $pid
 240     dict set srv "host" $host
 241     dict set srv "port" $port
 242     dict set srv "stdout" $stdout
 243     dict set srv "stderr" $stderr
 244
 245     # if a block of code is supplied, we wait for the server to become
 246     # available, create a client object and kill the server afterwards
 247     if {$code ne "undefined"} {
 248         set line [exec head -n1 $stdout]
 249         if {[string match {*already in use*} $line]} {
 250             error_and_quit $config_file $line
 251         }
 252
 253         while 1 {
 254             # check that the server actually started and is ready for connections
 255             if {[exec grep "ready to accept" | wc -l < $stdout] > 0} {
 256                 break
 257             }
 258             after 10
 259         }
 260
 261         # append the server to the stack
 262         lappend ::servers $srv
 263
 264         # connect client (after server dict is put on the stack)
 265         reconnect
 266
 267         # execute provided block
 268         set num_tests $::num_tests
 269         if {[catch { uplevel 1 $code } error]} {
 270             set backtrace $::errorInfo
 271
 272             # Kill the server without checking for leaks
 273             dict set srv "skipleaks" 1
 274             kill_server $srv
 275
 276             # Print warnings from log
 277             puts [format "\nLogged warnings (pid %d):" [dict get $srv "pid"]]
 278             set warnings [warnings_from_file [dict get $srv "stdout"]]
 279             if {[string length $warnings] > 0} {
 280                 puts "$warnings"
 281             } else {
 282                 puts "(none)"
 283             }
 284             puts ""
 285
 286             error $error $backtrace
 287         }
 288
 289         # Don't do the leak check when no tests were run
 290         if {$num_tests == $::num_tests} {
 291             dict set srv "skipleaks" 1
 292         }
 293
 294         # pop the server object
 295         set ::servers [lrange $::servers 0 end-1]
 296
 297         set ::tags [lrange $::tags 0 end-[llength $tags]]
 298         kill_server $srv
 299     } else {
 300         set ::tags [lrange $::tags 0 end-[llength $tags]]
 301         set _ $srv
 302     }
 303 }