tests/support/server.tcl

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