File Coverage

blib/lib/Apache/TestServer.pm
Criterion Covered Total %
statement 65 329 19.8
branch 4 92 4.3
condition 6 46 13.0
subroutine 17 41 41.5
pod 1 26 3.8
total 93 534 17.4


line stmt bran cond sub pod time code
1             # Licensed to the Apache Software Foundation (ASF) under one or more
2             # contributor license agreements. See the NOTICE file distributed with
3             # this work for additional information regarding copyright ownership.
4             # The ASF licenses this file to You under the Apache License, Version 2.0
5             # (the "License"); you may not use this file except in compliance with
6             # the License. You may obtain a copy of the License at
7             #
8             # http://www.apache.org/licenses/LICENSE-2.0
9             #
10             # Unless required by applicable law or agreed to in writing, software
11             # distributed under the License is distributed on an "AS IS" BASIS,
12             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13             # See the License for the specific language governing permissions and
14             # limitations under the License.
15             #
16             package Apache::TestServer;
17              
18 6     6   89 use strict;
  6         59  
  6         105  
19 6     6   92 use warnings FATAL => 'all';
  6         87  
  6         94  
20              
21 6     6   95 use Config;
  6         57  
  6         91  
22 6     6   126 use Socket ();
  6         55  
  6         60  
23 6     6   93 use File::Spec::Functions qw(catfile);
  6         56  
  6         115  
24              
25 6     6   96 use Apache::TestTrace;
  6         54  
  6         95  
26 6     6   1913 use Apache::TestRun;
  6         61  
  6         144  
27 6     6   158 use Apache::TestConfig ();
  6         55  
  6         118  
28 6     6   92 use Apache::TestRequest ();
  6         57  
  6         55  
29              
30 6     6   104 use constant COLOR => Apache::TestConfig::COLOR;
  6         53  
  6         483  
31 6     6   152 use constant WIN32 => Apache::TestConfig::WIN32;
  6         58  
  6         77  
32              
33             my $CTRL_M = COLOR ? "\r" : "\n";
34              
35             # some debuggers use the same syntax as others, so we reuse the same
36             # code by using the following mapping
37             my %debuggers = (
38                 gdb => 'gdb',
39                 ddd => 'gdb',
40                 valgrind => 'valgrind',
41                 strace => 'strace',
42             );
43              
44             sub new {
45 6     6 0 66     my $class = shift;
46 6         56     my $config = shift;
47              
48 6   33     99     my $self = bless {
49                     config => $config || Apache::TestConfig->thaw,
50                 }, $class;
51              
52 12         170     $self->{name} = join ':',
53 6         64       map { $self->{config}->{vars}->{$_} } qw(servername port);
54              
55 6         71     $self->{port_counter} = $self->{config}->{vars}->{port};
56              
57 6         156     $self;
58             }
59              
60             # call this when you already know where httpd is
61             sub post_config {
62 6     6 0 116     my($self) = @_;
63              
64 6   50     235     $self->{version} = $self->{config}->httpd_version || '';
65 6   50     1272     $self->{mpm} = $self->{config}->httpd_mpm || '';
66              
67             # try to get the revision number from the standard Apache version
68             # string and various variations made by distributions which mangle
69             # that string
70              
71             # Foo-Apache-Bar/x.y.z
72 6         500     ($self->{rev}) = $self->{version} =~ m|/(\d)\.|;
73              
74 6 50       184     if ($self->{rev}) {
75 6         1196         debug "Matched Apache revision $self->{version} $self->{rev}";
76                 }
77                 else {
78             # guessing is not good as it'll only mislead users
79             # and we can't die since a config object is required
80             # during Makefile.PL's write_perlscript when path to httpd may
81             # be unknown yet. so default to non-existing version 0 for now.
82             # and let TestRun.pm figure out the required pieces
83 0         0         debug "can't figure out Apache revision, from string: " .
84                         "'$self->{version}', using a non-existing revision 0";
85 0         0         $self->{rev} = 0; # unknown
86                 }
87              
88 6         360     $self;
89             }
90              
91             sub version_of {
92 0     0 0 0     my($self, $thing) = @_;
93 0 0       0     die "Can't figure out what Apache server generation we are running"
94                     unless $self->{rev};
95              
96 0         0     $thing->{$self->{rev}};
97             }
98              
99             my @apache_logs = qw(
100             error_log access_log httpd.pid
101             apache_runtime_status rewrite_log
102             ssl_engine_log ssl_request_log
103             cgisock
104             );
105              
106             sub clean {
107 0     0 0 0     my $self = shift;
108              
109 0         0     my $dir = $self->{config}->{vars}->{t_logs};
110              
111 0         0     for (@apache_logs) {
112 0         0         my $file = catfile $dir, $_;
113 0 0       0         if (unlink $file) {
114 0         0             debug "unlink $file";
115                     }
116                 }
117             }
118              
119             sub pid_file {
120 1     1 0 10     my $self = shift;
121              
122 1         12     my $vars = $self->{config}->{vars};
123              
124 1   33     17     return $vars->{t_pid_file} || catfile $vars->{t_logs}, 'httpd.pid';
125             }
126              
127             sub dversion {
128 0     0 0 0     my $self = shift;
129 0         0     "-D APACHE$self->{rev}";
130             }
131              
132             sub config_defines {
133 0     0 0 0     my $self = shift;
134              
135 0         0     my @defines = ();
136              
137 0         0     for my $item (qw(useithreads)) {
138 0 0 0     0         next unless $Config{$item} and $Config{$item} eq 'define';
139 0         0         push @defines, "-D PERL_\U$item";
140                 }
141              
142 0 0       0     if (my $defines = $self->{config}->{vars}->{defines}) {
143 0         0         push @defines, map { "-D $_" } split " ", $defines;
  0         0  
144                 }
145              
146 0         0     "@defines";
147             }
148              
149             sub args {
150 0     0 0 0     my $self = shift;
151 0         0     my $vars = $self->{config}->{vars};
152 0         0     my $dversion = $self->dversion; #for .conf version conditionals
153 0         0     my $defines = $self->config_defines;
154              
155 0         0     "-d $vars->{serverroot} -f $vars->{t_conf_file} $dversion $defines";
156             }
157              
158             my %one_process = (1 => '-X', 2 => '-D ONE_PROCESS');
159              
160             sub start_cmd {
161 0     0 0 0     my $self = shift;
162              
163 0         0     my $args = $self->args;
164 0         0     my $config = $self->{config};
165 0         0     my $vars = $config->{vars};
166 0         0     my $httpd = $vars->{httpd};
167              
168 0 0       0     my $one_process = $self->{run}->{opts}->{'one-process'}
169                     ? $self->version_of(\%one_process)
170                     : '';
171              
172             #XXX: threaded mpm does not respond to SIGTERM with -D ONE_PROCESS
173              
174 0         0     return "$httpd $one_process $args";
175             }
176              
177             sub default_gdbinit {
178 0     0 0 0     my $gdbinit = "";
179 0         0     my @sigs = qw(PIPE);
180              
181 0         0     for my $sig (@sigs) {
182 0         0         for my $flag (qw(pass nostop)) {
183 0         0             $gdbinit .= "handle SIG$sig $flag\n";
184                     }
185                 }
186              
187 0         0     $gdbinit;
188             }
189              
190             sub strace_cmd {
191 0     0 0 0     my($self, $strace, $file) = @_;
192             #XXX truss, ktrace, etc.
193 0         0     "$strace -f -o $file -s1024";
194             }
195              
196             sub valgrind_cmd {
197 0     0 0 0     my($self, $valgrind) = @_;
198 0         0     "$valgrind -v --leak-check=yes --show-reachable=yes --error-limit=no";
199             }
200              
201             sub start_valgrind {
202 0     0 0 0     my $self = shift;
203 0         0     my $opts = shift;
204              
205 0         0     my $config = $self->{config};
206 0         0     my $args = $self->args;
207 0         0     my $one_process = $self->version_of(\%one_process);
208 0         0     my $valgrind_cmd = $self->valgrind_cmd($opts->{debugger});
209 0         0     my $httpd = $config->{vars}->{httpd};
210              
211 0         0     my $command = "$valgrind_cmd $httpd $one_process $args";
212              
213 0         0     debug $command;
214 0         0     system $command;
215             }
216              
217             sub start_strace {
218 0     0 0 0     my $self = shift;
219 0         0     my $opts = shift;
220              
221 0         0     my $config = $self->{config};
222 0         0     my $args = $self->args;
223 0         0     my $one_process = $self->version_of(\%one_process);
224 0         0     my $file = catfile $config->{vars}->{t_logs}, 'strace.log';
225 0         0     my $strace_cmd = $self->strace_cmd($opts->{debugger}, $file);
226 0         0     my $httpd = $config->{vars}->{httpd};
227              
228 0         0     $config->genfile($file); #just mark for cleanup
229              
230 0         0     my $command = "$strace_cmd $httpd $one_process $args";
231              
232 0         0     debug $command;
233 0         0     system $command;
234             }
235              
236             sub start_gdb {
237 0     0 0 0     my $self = shift;
238 0         0     my $opts = shift;
239              
240 0         0     my $debugger = $opts->{debugger};
241 0 0       0     my @breakpoints = @{ $opts->{breakpoint} || [] };
  0         0  
242 0         0     my $config = $self->{config};
243 0         0     my $args = $self->args;
244 0         0     my $one_process = $self->version_of(\%one_process);
245              
246 0         0     my $file = catfile $config->{vars}->{serverroot}, '.gdb-test-start';
247 0         0     my $fh = $config->genfile($file);
248              
249 0         0     print $fh default_gdbinit();
250              
251 0 0       0     if (@breakpoints) {
252 0         0         print $fh "b ap_run_pre_config\n";
253 0         0         print $fh "run $one_process $args\n";
254 0         0         print $fh "finish\n";
255 0         0         for (@breakpoints) {
256 0         0             print $fh "b $_\n"
257                     }
258 0         0         print $fh "continue\n";
259                 }
260                 else {
261 0         0         print $fh "run $one_process $args\n";
262                 }
263 0         0     close $fh;
264              
265 0         0     my $command;
266 0         0     my $httpd = $config->{vars}->{httpd};
267              
268 0 0       0     if ($debugger eq 'ddd') {
269 0         0         $command = qq{ddd --gdb --debugger "gdb -command $file" $httpd};
270                 }
271                 else {
272             ## defaults to gdb if not set in %ENV or via -debug
273 0         0         $command = "$debugger $httpd -command $file";
274                 }
275              
276 0         0     $self->note_debugging;
277 0         0     debug $command;
278 0         0     system $command;
279              
280 0         0     unlink $file;
281             }
282              
283             sub debugger_file {
284 0     0 0 0     my $self = shift;
285 0         0     catfile $self->{config}->{vars}->{serverroot}, '.debugging';
286             }
287              
288             #make a note that the server is running under the debugger
289             #remove note when this process exits via END
290              
291             sub note_debugging {
292 0     0 0 0     my $self = shift;
293 0         0     my $file = $self->debugger_file;
294 0         0     my $fh = $self->{config}->genfile($file);
295 0         0     eval qq(END { unlink "$file" });
296             }
297              
298             sub start_debugger {
299 0     0 0 0     my $self = shift;
300 0         0     my $opts = shift;
301              
302 0   0     0     $opts->{debugger} ||= $ENV{MP_DEBUGGER} || 'gdb';
      0        
303              
304             # XXX: FreeBSD 5.2+
305             # gdb 6.1 and before segfaults when trying to
306             # debug httpd startup code. 6.5 has been proven
307             # to work. FreeBSD typically installs this as
308             # gdb65.
309             # Is it worth it to check the debugger and os version
310             # and die ?
311              
312 0 0       0     unless (grep { /^$opts->{debugger}/ } keys %debuggers) {
  0         0  
313 0         0         error "$opts->{debugger} is not a supported debugger",
314                           "These are the supported debuggers: ".
315                           join ", ", sort keys %debuggers;
316 0         0         die("\n");
317                 }
318              
319 0         0     my $debugger = $opts->{debugger};
320 0         0     $debugger =~ s/\d+$//;
321              
322 0         0     my $method = "start_" . $debuggers{$debugger};
323              
324             ## $opts->{debugger} is passed through unchanged
325             ## so when we try to run it next, its found.
326 0         0     $self->$method($opts);
327             }
328              
329             sub pid {
330 1     1 0 12     my $self = shift;
331 1         38     my $file = $self->pid_file;
332 1         69     my $fh = Symbol::gensym();
333 1 50       228     open $fh, $file or do {
334 0         0         return 0;
335                 };
336              
337             # try to avoid the race condition when the pid file was created
338             # but not yet written to
339 1         28     for (1..8) {
340 1 50       66         last if -s $file > 0;
341 0         0         select undef, undef, undef, 0.25;
342                 }
343              
344 1   50     88     chomp(my $pid = <$fh> || '');
345 1         14     $pid;
346             }
347              
348             sub select_next_port {
349 0     0 0 0     my $self = shift;
350              
351 0         0     my $max_tries = 100; #XXX
352 0         0     while ($max_tries-- > 0) {
353 0 0       0         return $self->{port_counter}
354                         if $self->port_available(++$self->{port_counter});
355                 }
356              
357 0         0     return 0;
358             }
359              
360             sub port_available {
361 0     0 0 0     my $self = shift;
362 0   0     0     my $port = shift || $self->{config}->{vars}->{port};
363 0         0     local *S;
364              
365 0         0     my $proto = getprotobyname('tcp');
366              
367 0 0       0     socket(S, Socket::PF_INET(),
368                        Socket::SOCK_STREAM(), $proto) || die "socket: $!";
369 0 0       0     setsockopt(S, Socket::SOL_SOCKET(),
370                            Socket::SO_REUSEADDR(),
371                            pack("l", 1)) || die "setsockopt: $!";
372              
373 0 0       0     if (bind(S, Socket::sockaddr_in($port, Socket::INADDR_ANY()))) {
374 0         0         close S;
375 0         0         return 1;
376                 }
377                 else {
378 0         0         return 0;
379                 }
380             }
381              
382             =head2 stop()
383            
384             attempt to stop the server.
385            
386             returns:
387            
388             on success: $pid of the server
389             on failure: -1
390            
391             =cut
392              
393             sub stop {
394 0     0 1 0     my $self = shift;
395 0         0     my $aborted = shift;
396              
397 0         0     if (WIN32) {
398                     require Win32::Process;
399                     my $obj = $self->{config}->{win32obj};
400                     my $pid = -1;
401                     if ($pid = $obj ? $obj->GetProcessID : $self->pid) {
402                         if (kill(0, $pid)) {
403                             Win32::Process::KillProcess($pid, 0);
404                             warning "server $self->{name} shutdown";
405                         }
406                     }
407                     unlink $self->pid_file if -e $self->pid_file;
408                     return $pid;
409                 }
410              
411 0         0     my $pid = 0;
412 0         0     my $tries = 3;
413 0         0     my $tried_kill = 0;
414              
415 0         0     my $port = $self->{config}->{vars}->{port};
416              
417 0         0     while ($self->ping) {
418             #my $state = $tried_kill ? "still" : "already";
419             #print "Port $port $state in use\n";
420              
421 0 0 0     0         if ($pid = $self->pid and !$tried_kill++) {
422 0 0       0             if (kill TERM => $pid) {
423 0         0                 warning "server $self->{name} shutdown";
424 0         0                 sleep 1;
425              
426 0         0                 for (1..6) {
427 0 0       0                     if (! $self->ping) {
428 0 0       0                         if ($_ == 1) {
429 0 0       0                             unlink $self->pid_file if -e $self->pid_file;
430 0         0                             return $pid;
431                                     }
432 0         0                         last;
433                                 }
434 0 0       0                     if ($_ == 1) {
435 0         0                         warning "port $port still in use...";
436                                 }
437                                 else {
438 0         0                         print "...";
439                                 }
440 0         0                     sleep $_;
441                             }
442              
443 0 0       0                 if ($self->ping) {
444 0         0                     error "\nserver was shutdown but port $port ".
445                                       "is still in use, please shutdown the service ".
446                                       "using this port or select another port ".
447                                       "for the tests";
448                             }
449                             else {
450 0         0                     print "done\n";
451                             }
452                         }
453                         else {
454 0         0                 error "kill $pid failed: $!";
455                         }
456                     }
457                     else {
458 0         0             error "port $port is in use, ".
459                               "cannot determine server pid to shutdown";
460 0         0             return -1;
461                     }
462              
463 0 0       0         if (--$tries <= 0) {
464 0         0             error "cannot shutdown server on Port $port, ".
465                               "please shutdown manually";
466 0 0       0             unlink $self->pid_file if -e $self->pid_file;
467 0         0             return -1;
468                     }
469                 }
470              
471 0 0       0     unlink $self->pid_file if -e $self->pid_file;
472 0         0     return $pid;
473             }
474              
475             sub ping {
476 1     1 0 11     my $self = shift;
477 1         35     my $pid = $self->pid;
478              
479 1 50 33     120     if ($pid and kill 0, $pid) {
    0          
480 1         25         return $pid;
481                 }
482                 elsif (! $self->port_available) {
483 0                   return -1;
484                 }
485              
486 0               return 0;
487             }
488              
489             sub failed_msg {
490 0     0 0       my $self = shift;
491 0               my($log, $rlog) = $self->{config}->error_log;
492 0 0             my $log_file_info = -e $log ?
493                     "please examine $rlog" :
494                     "$rlog wasn't created, start the server in the debug mode";
495 0               error "@_ ($log_file_info)";
496             }
497              
498             #this doesn't work well on solaris or hpux at the moment
499 6     6   116 use constant USE_SIGCHLD => $^O eq 'linux';
  6         57  
  6         130  
500              
501             sub start {
502 0     0 0       my $self = shift;
503              
504 0               my $old_pid = -1;
505 0               if (WIN32) {
506             # Stale PID files (e.g. left behind from a previous test run
507             # that crashed) cannot be trusted on Windows because PID's are
508             # re-used too frequently, so just remove it. If there is an old
509             # server still running then the attempt to start a new one below
510             # will simply fail because the port will be unavailable.
511                     if (-f $self->pid_file) {
512                         error "Removing old PID file -- " .
513                             "Unclean shutdown of previous test run?\n";
514                         unlink $self->pid_file;
515                     }
516                     $old_pid = 0;
517                 }
518                 else {
519 0                   $old_pid = $self->stop;
520                 }
521 0               my $cmd = $self->start_cmd;
522 0               my $config = $self->{config};
523 0               my $vars = $config->{vars};
524 0   0           my $httpd = $vars->{httpd} || 'unknown';
525              
526 0 0             if ($old_pid == -1) {
527 0                   return 0;
528                 }
529              
530 0               local $| = 1;
531              
532 0 0             unless (-x $httpd) {
533 0 0                 my $why = -e $httpd ? "is not executable" : "does not exist";
534 0                   error "cannot start server: httpd ($httpd) $why";
535 0                   return 0;
536                 }
537              
538 0               print "$cmd\n";
539 0               my $old_sig;
540              
541 0               if (WIN32) {
542             #make sure only 1 process is started for win32
543             #else Kill will only shutdown the parent
544                     my $one_process = $self->version_of(\%one_process);
545                     require Win32::Process;
546                     my $obj;
547             # We need the "1" below to inherit the calling processes
548             # handles when running Apache::TestSmoke so as to properly
549             # dup STDOUT/STDERR
550                     Win32::Process::Create($obj,
551                                            $httpd,
552                                            "$cmd $one_process",
553                                            1,
554                                            Win32::Process::NORMAL_PRIORITY_CLASS(),
555                                            '.');
556                     unless ($obj) {
557                         die "Could not start the server: " .
558                             Win32::FormatMessage(Win32::GetLastError());
559                     }
560                     $config->{win32obj} = $obj;
561                 }
562                 else {
563 0                   $old_sig = $SIG{CHLD};
564              
565 0                   if (USE_SIGCHLD) {
566             # XXX: try not to be POSIX dependent
567 0                       require POSIX;
568              
569             #XXX: this is not working well on solaris or hpux
570                         $SIG{CHLD} = sub {
571 0     0                     while ((my $child = waitpid(-1, POSIX::WNOHANG())) > 0) {
572 0                               my $status = $? >> 8;
573             #error "got child exit $status";
574 0 0                             if ($status) {
575 0                                   my $msg = "server has died with status $status";
576 0                                   $self->failed_msg("\n$msg");
577 0                                   Apache::TestRun->new(test_config => $config)->scan_core;
578 0                                   kill SIGTERM => $$;
579                                 }
580                             }
581 0                       };
582                     }
583              
584 0 0                 defined(my $pid = fork) or die "Can't fork: $!";
585 0 0                 unless ($pid) { # child
586 0                       my $status = system "$cmd";
587 0 0                     if ($status) {
588 0                           $status = $? >> 8;
589             #error "httpd didn't start! $status";
590                         }
591 0                       CORE::exit $status;
592                     }
593                 }
594              
595 0   0           while ($old_pid and $old_pid == $self->pid) {
596 0                   warning "old pid file ($old_pid) still exists";
597 0                   sleep 1;
598                 }
599              
600 0               my $version = $self->{version};
601 0   0           my $mpm = $config->{mpm} || "";
602 0 0             $mpm = "($mpm MPM)" if $mpm;
603 0               print "using $version $mpm\n";
604              
605 0   0           my $timeout = $vars->{startup_timeout} ||
      0        
606                               $ENV{APACHE_TEST_STARTUP_TIMEOUT} ||
607                               60;
608              
609 0               my $start_time = time;
610 0               my $preamble = "${CTRL_M}waiting $timeout seconds for server to start: ";
611 0               print $preamble unless COLOR;
612 0               while (1) {
613 0                   my $delta = time - $start_time;
614 0                   print COLOR
615                         ? ($preamble, sprintf "%02d:%02d", (gmtime $delta)[1,0])
616                         : '.';
617 0                   sleep 1;
618 0 0                 if ($self->pid) {
    0          
619 0                       print $preamble, "ok (waited $delta secs)\n";
620 0                       last;
621                     }
622                     elsif ($delta > $timeout) {
623 0                       my $suggestion = $timeout + 300;
624 0                       print $preamble, "not ok\n";
625 0                       error <<EOI;
626             giving up after $delta secs. If you think that your system
627             is slow or overloaded try again with a longer timeout value.
628             by setting the environment variable APACHE_TEST_STARTUP_TIMEOUT
629             to a high value (e.g. $suggestion) and repeat the last command.
630             EOI
631 0                       last;
632                     }
633                 }
634              
635             # now that the server has started don't abort the test run if it
636             # dies
637 0   0           $SIG{CHLD} = $old_sig || 'DEFAULT';
638              
639 0 0             if (my $pid = $self->pid) {
640 0                   print "server $self->{name} started\n";
641              
642 0                   my $vh = $config->{vhosts};
643 0     0             my $by_port = sub { $vh->{$a}->{port} <=> $vh->{$b}->{port} };
  0            
644              
645 0                   for my $module (sort $by_port keys %$vh) {
646 0                       print "server $vh->{$module}->{name} listening ($module)\n",
647                     }
648              
649 0 0                 if ($config->configure_proxy) {
650 0                       print "tests will be proxied through $vars->{proxy}\n";
651                     }
652                 }
653                 else {
654 0                   $self->failed_msg("server failed to start!");
655 0                   return 0;
656                 }
657              
658 0 0             return 1 if $self->wait_till_is_up($timeout);
659              
660 0               $self->failed_msg("failed to start server!");
661 0               return 0;
662             }
663              
664              
665             # wait till the server is up and return 1
666             # if the waiting times out returns 0
667             sub wait_till_is_up {
668 0     0 0       my($self, $timeout) = @_;
669 0               my $config = $self->{config};
670 0               my $sleep_interval = 1; # secs
671              
672                 my $server_up = sub {
673 0     0             local $SIG{__WARN__} = sub {}; #avoid "cannot connect ..." warnings
  0            
674             # avoid fatal errors when LWP is not available
675 0                   my $r = eval { Apache::TestRequest::GET('/index.html') };
  0            
676 0 0 0               return !$@ && defined $r ? $r->code : 0;
677 0               };
678              
679 0 0             if ($server_up->()) {
680 0                   return 1;
681                 }
682              
683 0               my $start_time = time;
684 0               my $preamble = "${CTRL_M}still waiting for server to warm up: ";
685 0               print $preamble unless COLOR;
686 0               while (1) {
687 0                   my $delta = time - $start_time;
688 0                   print COLOR
689                         ? ($preamble, sprintf "%02d:%02d", (gmtime $delta)[1,0])
690                         : '.';
691 0                   sleep $sleep_interval;
692 0 0                 if ($server_up->()) {
    0          
693 0                       print "${CTRL_M}the server is up (waited $delta secs) \n";
694 0                       return 1;
695                     }
696                     elsif ($delta > $timeout) {
697 0                       print "${CTRL_M}the server is down, giving up after $delta secs\n";
698 0                       return 0;
699                     }
700                     else {
701             # continue
702                     }
703                 }
704             }
705              
706             1;
707