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