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