test/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 start_server {filename overrides {code undefined}} {
  11     set data [split [exec cat "test/assets/$filename"] "\n"]
  12     set config {}
  13     foreach line $data {
  14         if {[string length $line] > 0 && [string index $line 0] ne "#"} {
  15             set elements [split $line " "]
  16             set directive [lrange $elements 0 0]
  17             set arguments [lrange $elements 1 end]
  18             dict set config $directive $arguments
  19         }
  20     }
  21
  22     # use a different directory every time a server is started
  23     dict set config dir [tmpdir server]
  24
  25     # start every server on a different port
  26     dict set config port [incr ::port]
  27
  28     # apply overrides from arguments
  29     foreach override $overrides {
  30         set directive [lrange $override 0 0]
  31         set arguments [lrange $override 1 end]
  32         dict set config $directive $arguments
  33     }
  34
  35     # write new configuration to temporary file
  36     set config_file [tmpfile redis.conf]
  37     set fp [open $config_file w+]
  38     foreach directive [dict keys $config] {
  39         puts -nonewline $fp "$directive "
  40         puts $fp [dict get $config $directive]
  41     }
  42     close $fp
  43
  44     set stdout [format "%s/%s" [dict get $config "dir"] "stdout"]
  45     set stderr [format "%s/%s" [dict get $config "dir"] "stderr"]
  46     exec ./redis-server $config_file > $stdout 2> $stderr &
  47     after 10
  48
  49     # check that the server actually started
  50     if {[file size $stderr] > 0} {
  51         error_and_quit $config_file [exec cat $stderr]
  52     }
  53
  54     set line [exec head -n1 $stdout]
  55     if {[string match {*already in use*} $line]} {
  56         error_and_quit $config_file $line
  57     }
  58
  59     # find out the pid
  60     regexp {^\[(\d+)\]} [exec head -n1 $stdout] _ pid
  61
  62     # create the client object
  63     set host $::host
  64     set port $::port
  65     if {[dict exists $config bind]} { set host [dict get $config bind] }
  66     if {[dict exists $config port]} { set port [dict get $config port] }
  67     set client [redis $host $port]
  68
  69     # select the right db when we don't have to authenticate
  70     if {![dict exists $config requirepass]} {
  71         $client select 9
  72     }
  73
  74     if {$code ne "undefined"} {
  75         # append the client to the client stack
  76         lappend ::clients $client
  77
  78         # execute provided block
  79         catch { uplevel 1 $code } err
  80
  81         # pop the client object
  82         set ::clients [lrange $::clients 0 end-1]
  83
  84         # kill server and wait for the process to be totally exited
  85         exec kill $pid
  86         while 1 {
  87             if {[catch {exec ps -p $pid | grep redis-server} result]} {
  88                 # non-zero exis status, process is gone
  89                 break;
  90             }
  91             after 10
  92         }
  93
  94         if {[string length $err] > 0} {
  95             puts "Error executing the suite, aborting..."
  96             puts $err
  97             exit 1
  98         }
  99     } else {
 100         dict set ret "config" $config_file
 101         dict set ret "pid" $pid
 102         dict set ret "stdout" $stdout
 103         dict set ret "stderr" $stderr
 104         dict set ret "client" $client
 105         set _ $ret
 106     }
 107 }
 108
 109 proc kill_server config {
 110     set pid [dict get $config pid]
 111     exec kill $pid
 112 }