comparison proxy_upgrade.t @ 279:c754b1c79efe

Tests: better timeout handling in proxy_upgrade.t. Now it uses nonblocking IO instead of eval + alarm model, and properly handles write timeouts as well as read ones.
author Maxim Dounin <mdounin@mdounin.ru>
date Mon, 15 Apr 2013 22:43:51 +0000
parents 8a41f7d38cc3
children 3dd8c7acf3ad
comparison
equal deleted inserted replaced
278:b6f0537afa01 279:c754b1c79efe
145 $buf .= $opts{message} . CRLF if defined $opts{message}; 145 $buf .= $opts{message} . CRLF if defined $opts{message};
146 146
147 local $SIG{PIPE} = 'IGNORE'; 147 local $SIG{PIPE} = 'IGNORE';
148 148
149 log_out($buf); 149 log_out($buf);
150 $s->print($buf); 150 $s->syswrite($buf);
151 151
152 # read response 152 # read response
153 153
154 my $got = ''; 154 my $got = '';
155 $buf = ''; 155 $buf = '';
172 return $s; 172 return $s;
173 } 173 }
174 174
175 sub upgrade_getline { 175 sub upgrade_getline {
176 my ($s) = @_; 176 my ($s) = @_;
177 my $buf; 177 my ($h, $buf, $line);
178 178
179 eval { 179 ${*$s}->{_upgrade_private} ||= { b => ''};
180 local $SIG{ALRM} = sub { die "timeout\n"; }; 180 $h = ${*$s}->{_upgrade_private};
181 alarm(2); 181
182 $buf = $s->getline(); 182 if ($h->{b} =~ /^(.*?\x0a)(.*)/ms) {
183 alarm(0); 183 $h->{b} = $2;
184 return $1;
185 }
186
187 $s->blocking(0);
188 while (IO::Select->new($s)->can_read(1.5)) {
189 my $n = $s->sysread($buf, 1024);
190 last unless $n;
191
192 $h->{b} .= $buf;
193
194 if ($h->{b} =~ /^(.*?\x0a)(.*)/ms) {
195 $h->{b} = $2;
196 return $1;
197 }
184 }; 198 };
185 alarm(0);
186
187 if ($@) {
188 log_in("died: $@");
189 return undef;
190 }
191
192 return $buf;
193 } 199 }
194 200
195 sub upgrade_write { 201 sub upgrade_write {
196 my ($s, $message) = @_; 202 my ($s, $message) = @_;
197 $s->print($message . CRLF); 203
204 $message = $message . CRLF;
205
206 local $SIG{PIPE} = 'IGNORE';
207
208 $s->blocking(0);
209 while (IO::Select->new($s)->can_write(1.5)) {
210 my $n = $s->syswrite($message);
211 last unless $n;
212 $message = substr($message, $n);
213 last unless length $message;
214 }
215
216 if (length $message) {
217 $s->close();
218 }
198 } 219 }
199 220
200 sub upgrade_read { 221 sub upgrade_read {
201 my ($s) = @_; 222 my ($s) = @_;
202 my $m = upgrade_getline($s); 223 my $m = upgrade_getline($s);