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 kill_server config {
  11     # nevermind if its already dead
  12     if {![is_alive $config]} { return }
  13     set pid [dict get $config pid]
  14
  15     # check for leaks
  16     catch {
  17         if {[string match {*Darwin*} [exec uname -a]]} {
  18             test "Check for memory leaks (pid $pid)" {
  19                 exec leaks $pid
  20             } {*0 leaks*}
  21         }
  22     }
  23
  24     # kill server and wait for the process to be totally exited
  25     while {[is_alive $config]} {
  26         if {[incr wait 10] % 1000 == 0} {
  27             puts "Waiting for process $pid to exit..."
  28         }
  29         catch {exec kill $pid}
  30         after 10
  31     }
  32 }
  33
  34 proc is_alive config {
  35     set pid [dict get $config pid]
  36     if {[catch {exec ps -p $pid} err]} {
  37         return 0
  38     } else {
  39         return 1
  40     }
  41 }
  42
  43 set ::global_overrides {}
  44 proc start_server {filename overrides {code undefined}} {
  45     set data [split [exec cat "tests/assets/$filename"] "\n"]
  46     set config {}
  47     foreach line $data {
  48         if {[string length $line] > 0 && [string index $line 0] ne "#"} {
  49             set elements [split $line " "]
  50             set directive [lrange $elements 0 0]
  51             set arguments [lrange $elements 1 end]
  52             dict set config $directive $arguments
  53         }
  54     }
  55
  56     # use a different directory every time a server is started
  57     dict set config dir [tmpdir server]
  58
  59     # start every server on a different port
  60     dict set config port [incr ::port]
  61
  62     # apply overrides from global space and arguments
  63     foreach override [concat $::global_overrides $overrides] {
  64         set directive [lrange $override 0 0]
  65         set arguments [lrange $override 1 end]
  66         dict set config $directive $arguments
  67     }
  68
  69     # write new configuration to temporary file
  70     set config_file [tmpfile redis.conf]
  71     set fp [open $config_file w+]
  72     foreach directive [dict keys $config] {
  73         puts -nonewline $fp "$directive "
  74         puts $fp [dict get $config $directive]
  75     }
  76     close $fp
  77
  78     set stdout [format "%s/%s" [dict get $config "dir"] "stdout"]
  79     set stderr [format "%s/%s" [dict get $config "dir"] "stderr"]
  80     exec ./redis-server $config_file > $stdout 2> $stderr &
  81     after 500
  82
  83     # check that the server actually started
  84     if {[file size $stderr] > 0} {
  85         error_and_quit $config_file [exec cat $stderr]
  86     }
  87
  88     # find out the pid
  89     regexp {^\[(\d+)\]} [exec head -n1 $stdout] _ pid
  90
  91     # setup properties to be able to initialize a client object
  92     set host $::host
  93     set port $::port
  94     if {[dict exists $config bind]} { set host [dict get $config bind] }
  95     if {[dict exists $config port]} { set port [dict get $config port] }
  96
  97     # setup config dict
  98     dict set srv "config" $config_file
  99     dict set srv "pid" $pid
 100     dict set srv "host" $host
 101     dict set srv "port" $port
 102     dict set srv "stdout" $stdout
 103     dict set srv "stderr" $stderr
 104
 105     # if a block of code is supplied, we wait for the server to become
 106     # available, create a client object and kill the server afterwards
 107     if {$code ne "undefined"} {
 108         set line [exec head -n1 $stdout]
 109         if {[string match {*already in use*} $line]} {
 110             error_and_quit $config_file $line
 111         }
 112
 113         while 1 {
 114             # check that the server actually started and is ready for connections
 115             if {[exec cat $stdout | grep "ready to accept" | wc -l] > 0} {
 116                 break
 117             }
 118             after 10
 119         }
 120
 121         set client [redis $host $port]
 122         dict set srv "client" $client
 123
 124         # select the right db when we don't have to authenticate
 125         if {![dict exists $config requirepass]} {
 126             $client select 9
 127         }
 128
 129         # append the server to the stack
 130         lappend ::servers $srv
 131
 132         # execute provided block
 133         catch { uplevel 1 $code } err
 134
 135         # pop the server object
 136         set ::servers [lrange $::servers 0 end-1]
 137
 138         kill_server $srv
 139
 140         if {[string length $err] > 0} {
 141             puts "Error executing the suite, aborting..."
 142             puts $err
 143             exit 1
 144         }
 145     } else {
 146         set _ $srv
 147     }
 148 }