root/test/t/testconfig.pm

Revision 114e912f15bd7b350e099015cbd8597a021b773e, 20.3 kB (checked in by Theo Schlossnagle <jesus@omniti.com>, 6 years ago)

Overhaul the test suite to be more robust.

1) safer sleep mechanism handling interrupted syscalls and signals
2) The ability to env TRACE=truss (or strace) the noitd/stratcond
3) wait until the listener comes up before returning the pid, eliminates sleeps
4) more patient waiting shutdown of processes

  • Property mode set to 100644
Line 
1 package testconfig;
2 use Test::More;
3 use Fcntl;
4 use DBI;
5 use Cwd;
6 use Exporter 'import';
7 use Data::Dumper;
8 use IO::File;
9 use Time::HiRes qw/gettimeofday tv_interval usleep/;
10 use strict;
11 use vars qw/@EXPORT/;
12 sub mkL {
13   my $fd = $_[0];
14   return sub {} unless $ENV{DEBUG_TESTS};
15   return sub { print $fd "[$$] $_[0]\n"; }
16 };
17 sub childL {
18   open my $olderr, ">&STDERR";
19   { no warnings 'redefine'; *L = mkL($olderr); }
20 }
21 *L = mkL(\*STDERR);
22
23 my $noit_pid = 0;
24 my $noit_log = undef;
25 my $stratcon_pid = 0;
26 my $stratcon_log = undef;
27 my $killsig = 3;
28 my $boot_timeout = 5;
29
30
31 @EXPORT = qw($NOIT_TEST_DB $NOIT_TEST_DB_PORT
32              $NOIT_API_PORT $NOIT_CLI_PORT
33              $STRATCON_API_PORT $STRATCON_CLI_PORT
34              $STRATCON_WEB_PORT
35              pg make_noit_config start_noit stop_noit get_noit_log
36              make_stratcon_config start_stratcon stop_stratcon get_stratcon_log
37              $MODULES_DIR $LUA_DIR $all_noit_modules $all_stratcon_modules
38              safe_usleep);
39
40 sub safe_usleep {
41   my $micros = shift;
42   my $start = [gettimeofday];
43   while(1) {
44     my $elapsed = tv_interval($start, [gettimeofday]) * 1000000.0;
45     my $tosleep = $micros - $elapsed;
46     last if ($tosleep < 0);
47     usleep($tosleep);
48   }
49 }
50 our $default_filterset = {
51   allowall => [ { type => "allow" } ],
52 };
53 our $all_noit_modules = {
54   'selfcheck' => { 'image' => 'selfcheck' },
55   'ping_icmp' => { 'image' => 'ping_icmp' },
56   'snmp' => { 'image' => 'snmp' },
57   'ssh2' => { 'image' => 'ssh2' },
58   'mysql' => { 'image' => 'mysql' },
59   'postgres' => { 'image' => 'postgres' },
60   'test_abort' => { 'image' => 'test_abort' },
61   'varnish' => { 'loader' => 'lua', 'object' => 'noit.module.varnish' },
62   'http' => { 'loader' => 'lua', 'object' => 'noit.module.http' },
63   'resmon' => { 'loader' => 'lua', 'object' => 'noit.module.resmon' },
64   'smtp' => { 'loader' => 'lua', 'object' => 'noit.module.smtp' },
65   'tcp' => { 'loader' => 'lua', 'object' => 'noit.module.tcp' },
66 };
67
68 # Jitter the ports up (in blocks of 5 for 10k ports)
69 my $jitter = int(rand() * 10000 / 5) * 5;
70 our $NOIT_TEST_DB = "/tmp/noit-test-db-$>";
71 our $NOIT_TEST_DB_PORT = 23816;
72 our $NOIT_API_PORT = 42364 + $jitter;
73 our $NOIT_CLI_PORT = 42365 + $jitter;
74 our $STRATCON_API_PORT = 42366 + $jitter;
75 our $STRATCON_CLI_PORT = 42367 + $jitter;
76 our $STRATCON_WEB_PORT = 42368 + $jitter;
77
78 our ($MODULES_DIR, $LUA_DIR);
79
80 sub pg {
81   my $db = shift || 'postgres';
82   my $user = shift || $ENV{USER};
83   return DBI->connect(
84     "dbi:Pg:host=localhost;port=$NOIT_TEST_DB_PORT;database=$db", $user, '',
85     { 'PrintError' => 0 }
86   );
87 }
88
89 sub make_eventer_config {
90   my ($o, $opts) = @_;
91   my $cwd = $opts->{cwd};
92   $opts->{eventer_config}->{default_queue_threads} ||= 10;
93   $opts->{eventer_config}->{default_ca_chain} ||= "$cwd/../test-ca.crt";
94   print $o qq{
95   <eventer>
96     <config>
97       <default_queue_threads>$opts->{eventer_config}->{default_queue_threads}</default_queue_threads>
98       <default_ca_chain>$opts->{eventer_config}->{default_ca_chain}</default_ca_chain>
99     </config>
100   </eventer>
101 };
102 }
103 sub make_rest_acls {
104   my ($o, $opts) = @_;
105   my $acls = $opts->{rest_acls};
106   print $o qq{  <rest>\n};
107   foreach my $acl (@$acls) {
108     print $o qq^    <acl^;
109     print $o qq^ type="$acl->{type}"^ if exists($acl->{type});
110     print $o qq^ cn="$acl->{cn}"^ if exists($acl->{cn});
111     print $o qq^ url="$acl->{url}"^ if exists($acl->{url});
112     print $o qq^>\n^;
113     my $rules = $acl->{rules};
114     foreach my $rule (@$rules) {
115       print $o qq^      <rule^;
116       print $o qq^ type="$rule->{type}"^ if exists($rule->{type});
117       print $o qq^ cn="$rule->{cn}"^ if exists($rule->{cn});
118       print $o qq^ url="$rule->{url}"^ if exists($rule->{url});
119       print $o qq^/>\n^;
120     }
121     print $o qq^    </acl>\n^;
122   }
123   print $o qq{  </rest>\n};
124 }
125 sub make_log_section {
126   my ($o, $type, $dis) = @_;
127   print $o qq{      <$type>
128         <outlet name="error"/>
129 };
130   while (my ($t, $d) = each %$dis) {
131     next unless length($t);
132     print $o qq{        <log name="$type/$t" disabled="$d"/>\n};
133   }
134   print $o qq{      </$type>\n};
135 }
136 sub make_logs_config {
137   my ($o, $opts) = @_;
138   my $cwd = $opts->{cwd};
139   my @logtypes = qw/collectd dns eventer external lua mysql ping_icmp postgres
140                     selfcheck snmp ssh2 listener/;
141   # These are disabled attrs, so they look backwards
142   if(!exists($opts->{logs_error})) {
143     $opts->{logs_error}->{''} ||= 'false';
144   }
145   if(!exists($opts->{logs_debug})) {
146     $opts->{logs_debug}->{''} ||= 'true';
147   }
148   # Listener is special, we need that for boot availability detection
149   $opts->{logs_debug}->{listener} ||= 'false';
150   foreach(@logtypes) {
151     $opts->{logs_error}->{$_} ||= 'false';
152     $opts->{logs_debug}->{$_} ||= 'true';
153   }
154  
155   print $o qq{
156   <logs>
157     <console_output>
158       <outlet name="stderr"/>
159       <log name="error" disabled="$opts->{logs_error}->{''}" timestamps="true"/>
160       <log name="debug" disabled="$opts->{logs_debug}->{''}" timestamps="true"/>
161     </console_output>
162     <feeds>
163       <log name="feed" type="jlog" path="$cwd/logs/$opts->{name}.feed(*)"/>
164     </feeds>
165     <components>
166 };
167   make_log_section($o, 'error', $opts->{logs_error});
168   make_log_section($o, 'debug', $opts->{logs_debug});
169   print $o qq{
170     </components>
171     <feeds>
172       <config><extended_id>on</extended_id></config>
173       <outlet name="feed"/>
174       <log name="bundle"/>
175       <log name="check">
176         <outlet name="error"/>
177       </log>
178       <log name="status"/>
179       <log name="metrics"/>
180       <log name="config"/>
181     </feeds>
182   </logs>
183 };
184 }
185 sub make_modules_config {
186   my ($o, $opts) = @_;
187   my $cwd = $opts->{cwd};
188   print $o qq{
189   <modules directory="$cwd/../../src/modules">
190     <loader image="lua" name="lua">
191       <config><directory>$cwd/../../src/modules-lua/?.lua</directory></config>
192     </loader>
193 };
194   foreach(keys %{$opts->{generics}}) {
195     print $o qq{    <generic };
196     print $o qq{ image="$opts->{generics}->{$_}->{image}"}
197       if(exists($opts->{generics}->{$_}->{image}));
198     print $o qq{ name="$_"/>\n};
199   }
200   foreach(keys %{$opts->{modules}}) {
201     print $o qq{    <module };
202     print $o qq{ image="$opts->{modules}->{$_}->{image}"}
203       if(exists($opts->{modules}->{$_}->{image}));
204     print $o qq{ loader="$opts->{modules}->{$_}->{loader}"}
205       if(exists($opts->{modules}->{$_}->{loader}));
206     print $o qq{ object="$opts->{modules}->{$_}->{object}"}
207       if(exists($opts->{modules}->{$_}->{object}));
208     print $o qq{ name="$_"/>\n};
209   }
210   print $o qq{</modules>\n};
211 }
212 sub make_noit_listeners_config {
213   my ($o, $opts) = @_;
214   my $cwd = $opts->{cwd};
215   $opts->{noit_api_port} ||= $NOIT_API_PORT;
216   $opts->{noit_cli_port} ||= $NOIT_CLI_PORT;
217   print $o qq{
218   <listeners>
219     <sslconfig>
220       <optional_no_ca>false</optional_no_ca>
221       <certificate_file>$cwd/../test-noit.crt</certificate_file>
222       <key_file>$cwd/../test-noit.key</key_file>
223       <ca_chain>$cwd/../test-ca.crt</ca_chain>
224       <crl>$cwd/../test-ca.crl</crl>
225     </sslconfig>
226     <consoles type="noit_console">
227       <listener address="*" port="$opts->{noit_cli_port}">
228         <config>
229           <line_protocol>telnet</line_protocol>
230         </config>
231       </listener>
232     </consoles>
233     <listener type="control_dispatch" address="*" port="$opts->{noit_api_port}" ssl="on">
234       <config>
235         <log_transit_feed_name>feed</log_transit_feed_name>
236       </config>
237     </listener>
238   </listeners>
239 };
240 }
241 sub do_check_print {
242   my $o = shift;
243   my $list = shift;
244   return unless $list;
245   foreach my $node (@$list) {
246     print $o qq{<$node->[0]};
247     while(my ($k, $v) = each %{$node->[1]}) {
248       print $o qq{ $k="$v"};
249     }
250     if($node->[2]) {
251       print $o qq{>\n};
252       do_check_print($o, $node->[2]);
253       print $o qq{</check>\n};
254     }
255     else {
256       print $o qq{/>\n};
257     }
258   }
259 }
260 sub make_checks_config {
261   my ($o, $opts) = @_;
262   my $cwd = $opts->{cwd};
263   print $o qq{  <checks max_initial_stutter="10" filterset="default">\n};
264   do_check_print($o, $opts->{checks});
265   print $o qq{  </checks>\n};
266 }
267 sub make_filtersets_config {
268   my ($o, $opts) = @_;
269   my $cwd = $opts->{cwd};
270   print $o qq{<filtersets>\n};
271   while (my ($name, $set) = each %{$opts->{filtersets}}) {
272     print $o qq{  <filterset name="$name">\n};
273     foreach my $rule (@$set) {
274       print $o qq{    <rule };
275       while(my ($k,$v) = each %$rule) {
276         print $o qq{ $k="$v"};
277       }
278       print $o qq{/>\n};
279     }
280     print $o qq{  </filterset>\n};
281   }
282   print $o qq{</filtersets>\n};
283 }
284
285 sub make_noit_config {
286   my $name = shift;
287   my $options = shift;
288   $options->{cwd} ||= getcwd();
289   $options->{modules} = $all_noit_modules unless exists($options->{modules});
290   $options->{filtersets} = $default_filterset unless exists($options->{filtersets});
291   $options->{rest_acls} ||= [ { type => 'deny', rules => [ { type => 'allow' } ] } ];
292   my $cwd = $options->{cwd};
293   my $file = "$cwd/logs/${name}_noit.conf";
294   open (my $o, ">$file") || BAIL_OUT("can't write config: $file");
295   print $o qq{<?xml version="1.0" encoding="utf8" standalone="yes"?>\n};
296   print $o qq{<noit>};
297   make_eventer_config($o, $options);
298   make_rest_acls($o, $options);
299   make_logs_config($o, $options);
300   make_modules_config($o, $options);
301   make_noit_listeners_config($o, $options);
302   make_checks_config($o, $options);
303   make_filtersets_config($o, $options);
304   print $o qq{</noit>\n};
305   close($o);
306   return $file;
307 }
308
309 sub make_stratcon_noits_config {
310   my ($o, $opts) = @_;
311   my $cwd = $opts->{cwd};
312   $opts->{noit_api_port} ||= $NOIT_API_PORT;
313   print $o qq{
314   <noits>
315     <sslconfig>
316       <certificate_file>$cwd/../test-stratcon.crt</certificate_file>
317       <key_file>$cwd/../test-stratcon.key</key_file>
318       <ca_chain>$cwd/../test-ca.crt</ca_chain>
319     </sslconfig>
320     <config>
321       <reconnect_initial_interval>1000</reconnect_initial_interval>
322       <reconnect_maximum_interval>15000</reconnect_maximum_interval>
323     </config>
324 };
325   foreach my $n (@{$opts->{noits}}) {
326     print $o qq{    <noit};
327     while (my ($k,$v) = each %$n) {
328       print $o qq{ $k=\"$v\"};
329     }
330     print $o qq{/>\n};
331   }
332   print $o qq{</noits>\n};
333 }
334
335 sub make_stratcon_listeners_config {
336   my ($o, $opts) = @_;
337   my $cwd = $opts->{cwd};
338   $opts->{stratcon_api_port} ||= $STRATCON_API_PORT;
339   $opts->{stratcon_web_port} ||= $STRATCON_WEB_PORT;
340   print $o qq{
341   <listeners>
342     <sslconfig>
343       <certificate_file>$cwd/../test-stratcon.crt</certificate_file>
344       <key_file>$cwd/../test-stratcon.key</key_file>
345       <ca_chain>$cwd/../test-ca.crt</ca_chain>
346     </sslconfig>
347     <realtime type="http_rest_api">
348       <listener address="*" port="$opts->{stratcon_web_port}">
349         <config>
350           <hostname>stratcon.noit.example.com</hostname>
351           <document_domain>noit.example.com</document_domain>
352         </config>
353       </listener>
354     </realtime>
355     <listener type="control_dispatch" address="*" port="$opts->{stratcon_api_port}" ssl="on" />
356   </listeners>
357 };
358 }
359
360 sub make_iep_config {
361   my ($o, $opts) = @_;
362   my $cwd = $opts->{cwd};
363   $opts->{iep}->{disabled} ||= 'false';
364   mkdir("$cwd/logs/$opts->{name}_iep_root");
365   open(my $run, "<$cwd/../../src/java/run-iep.sh") ||
366     BAIL_OUT("cannot open source run-iep.sh");
367   sysopen(my $newrun, "$cwd/logs/$opts->{name}_iep_root/run-iep.sh", O_WRONLY|O_CREAT, 0755) ||
368     BAIL_OUT("cannot open target run-iep.sh");
369   while(<$run>) {
370     s%^DIRS="%DIRS="$cwd/../../src/java $cwd/../../src/java/lib %;
371     print $newrun $_;
372   }
373   close($run);
374   close($newrun);
375   print $o qq{
376   <iep disabled="$opts->{iep}->{disabled}">
377     <start directory="$cwd/logs/$opts->{name}_iep_root"
378            command="$cwd/logs/$opts->{name}_iep_root/run-iep.sh" />
379 };
380   foreach my $mqt (keys %{$opts->{iep}->{mq}}) {
381     print $o qq{    <mq type="$mqt">\n};
382     while (my ($k,$v) = each %{$opts->{iep}->{mq}->{mqt}}) {
383       print $o qq{      <$k>$v</$k>\n};
384     }
385     print $o qq{    </mq>\n};
386   }
387   foreach my $bt (keys %{$opts->{iep}->{broker}}) {
388     print $o qq{    <broker adapter="$bt">\n};
389     while (my ($k,$v) = each %{$opts->{iep}->{broker}->{bt}}) {
390       print $o qq{      <$k>$v</$k>\n};
391     }
392     print $o qq{    </broker>\n};
393   }
394   print $o qq{    <queries master="iep">\n};
395   foreach my $s (@{$opts->{iep}->{statements}}) {
396     print $o qq{        <statement id="$s->{id}" provides="$s->{id}">\n};
397     print $o qq{            <requires>$s->{requires}</requires>\n} if $s->{requires};
398     print $o qq{            <epl><![CDATA[$s->{epl}]]></epl>\n};
399     print $o qq{        </statement>\n};
400   }
401   foreach my $s (@{$opts->{iep}->{queries}}) {
402     print $o qq{        <query id="$s->{id}" topic="$s->{topic}">\n};
403     print $o qq{            <epl><![CDATA[$s->{epl}]]></epl>\n};
404     print $o qq{        </query>\n};
405   }
406   print $o qq{    </queries>\n};
407   print $o qq{</iep>\n};
408 }
409 sub make_database_config {
410   my ($o, $opts) = @_;
411   my $cwd = $opts->{cwd};
412   print $o qq{
413   <database>
414     <journal>
415       <path>$cwd/logs/$opts->{name}_stratcon.persist</path>
416     </journal>
417     <dbconfig>
418       <host>localhost</host>
419       <port>$NOIT_TEST_DB_PORT</port>
420       <dbname>reconnoiter</dbname>
421       <user>stratcon</user>
422       <password>stratcon</password>
423     </dbconfig>
424     <statements>
425       <allchecks><![CDATA[
426         SELECT remote_address, id, target, module, name
427           FROM check_currently
428       ]]></allchecks>
429       <findcheck><![CDATA[
430         SELECT remote_address, id, target, module, name
431           FROM check_currently
432          WHERE sid = \$1
433       ]]></findcheck>
434       <allstoragenodes><![CDATA[
435         SELECT storage_node_id, fqdn, dsn
436           FROM stratcon.storage_node
437       ]]></allstoragenodes>
438       <findstoragenode><![CDATA[
439         SELECT fqdn, dsn
440           FROM stratcon.storage_node
441          WHERE storage_node_id = \$1
442       ]]></findstoragenode>
443       <mapallchecks><![CDATA[
444         SELECT id, sid, noit as remote_cn, storage_node_id, fqdn, dsn
445           FROM stratcon.map_uuid_to_sid LEFT JOIN stratcon.storage_node USING (storage_node_id)
446       ]]></mapallchecks>
447       <mapchecktostoragenode><![CDATA[
448         SELECT o_storage_node_id as storage_node_id, o_sid as sid,
449                o_fqdn as fqdn, o_dsn as dsn
450           FROM stratcon.map_uuid_to_sid(\$1,\$2)
451       ]]></mapchecktostoragenode>
452       <check><![CDATA[
453         INSERT INTO check_archive_%Y%m%d
454                     (remote_address, whence, sid, id, target, module, name)
455              VALUES (\$1, 'epoch'::timestamptz + (\$2 || ' seconds')::interval,
456                      \$3, \$4, \$5, \$6, \$7)
457       ]]></check>
458       <status><![CDATA[
459         INSERT INTO check_status_archive_%Y%m%d
460                     (whence, sid, state, availability, duration, status)
461              VALUES ('epoch'::timestamptz + (\$1 || ' seconds')::interval,
462                      \$2, \$3, \$4, \$5, \$6)
463       ]]></status>
464       <metric_numeric><![CDATA[
465         INSERT INTO metric_numeric_archive_%Y%m%d
466                     (whence, sid, name, value)
467              VALUES ('epoch'::timestamptz + (\$1 || ' seconds')::interval,
468                      \$2, \$3, \$4)
469       ]]></metric_numeric>
470       <metric_text><![CDATA[
471         INSERT INTO metric_text_archive_%Y%m%d
472                     ( whence, sid, name,value)
473              VALUES ('epoch'::timestamptz + (\$1 || ' seconds')::interval,
474                      \$2, \$3, \$4)
475       ]]></metric_text>
476       <config><![CDATA[
477         SELECT stratcon.update_config
478                (\$1, \$2, \$3,
479                 'epoch'::timestamptz + (\$4 || ' seconds')::interval,
480                 \$5)
481       ]]></config>
482       <findconfig><![CDATA[
483         SELECT config FROM stratcon.current_node_config WHERE remote_cn = \$1
484       ]]></findconfig>
485     </statements>
486   </database>
487 };
488 }
489
490 sub make_stratcon_config {
491   my $name = shift;
492   my $options = shift;
493   L("make_stratcon_config");
494   $options->{cwd} ||= getcwd();
495   L("make_stratcon_config in $options->{cwd}");
496   $options->{generics} ||= { 'stomp_driver' => { image => 'stomp_driver' },
497                              'postgres_ingestor' => { image => 'postgres_ingestor' } };
498   $options->{rest_acls} ||= [ { type => 'deny', rules => [ { type => 'allow' } ] } ];
499   $options->{iep}->{mq} ||= { 'stomp' => {} };
500   my $cwd = $options->{cwd};
501   my $file = "$cwd/logs/${name}_stratcon.conf";
502   L("make_stratcon_config -> open($file)");
503   open (my $o, ">$file") || BAIL_OUT("can't write config: $file");
504   print $o qq{<?xml version="1.0" encoding="utf8" standalone="yes"?>\n};
505   print $o qq{<stratcon id="8325581c-1068-11e1-ac63-db8546d81c8b" metric_period="1000">};
506   make_eventer_config($o, $options);
507   make_rest_acls($o, $options);
508   make_stratcon_noits_config($o, $options);
509   make_logs_config($o, $options);
510   make_modules_config($o, $options);
511   make_stratcon_listeners_config($o, $options);
512   make_database_config($o, $options);
513   make_iep_config($o, $options);
514   print $o qq{</stratcon>\n};
515   L("make_stratcon_config -> close($file)");
516   close($o);
517   return $file;
518 }
519
520 $SIG{CHLD} = sub {
521   my $pid = wait;
522   $noit_pid = 0 if($pid == $noit_pid);
523   $stratcon_pid = 0 if($pid == $stratcon_pid);
524 };
525
526 sub find_in_log {
527   my $logfile = shift;
528   my $re = shift;
529   my $f = IO::File->new("<$logfile");
530   return 0 unless $f;
531   while(<$f>) {
532     chomp;
533     return $1 if($_ =~ $re);
534   }
535   return 0;
536 }
537
538 sub start_noit {
539   my $name = shift;
540   my $options = shift;
541   $options->{name} = $name;
542   return 0 if $noit_pid;
543   L("start_noit -> config");
544   my $conf = make_noit_config($name, $options);
545   $noit_pid = fork();
546   L("noit_pid -> $noit_pid") if ($noit_pid);
547   mkdir "logs";
548   $noit_log = "logs/${name}_noit.log";
549   unlink($noit_log);
550   if($noit_pid == 0) {
551     L("in child");
552     childL;
553     $noit_pid = $$;
554     L("in child -> closing stdin");
555     close(STDIN);
556     L("in child -> opening stdin");
557     open(STDIN, "</dev/null");
558     L("in child -> closing stdout");
559     close(STDOUT);
560     L("in child -> opening stdout");
561     open(STDOUT, ">/dev/null");
562     L("in child -> closing stderr");
563     close(STDERR);
564     L("in child -> opening err $noit_log");
565     open(STDERR, ">$noit_log");
566     my @args = ( 'noitd', '-D', '-c', $conf );
567     my $prog = '../../src/noitd';
568     if($ENV{TRACE}) {
569       shift @args;
570       unshift @args, $ENV{TRACE}, '-o', "logs/${name}_noit.trace", $prog;
571       $prog = $ENV{TRACE};
572     }
573     L("in child -> exec");
574     { exec { $prog } @args; }
575     print STDERR "ERROR: $!\n";
576     exit(-1);
577   }
578   L("in parent -> noitd($noit_pid)");
579   my $start = [gettimeofday];
580   while($noit_pid != 0 &&
581         tv_interval($start, [gettimeofday]) < $boot_timeout &&
582         !find_in_log($noit_log, qr/noit_listener\([^,]+,\s(\d+).*control_dispatch/)) {
583     usleep(100000);
584   }
585   my $pid = find_in_log($noit_log, qr/process starting: (\d+)/);
586   $noit_pid = $pid if($pid);
587   return $noit_pid;
588 }
589 sub get_noit_log {
590   return IO::File->new("<$noit_log");
591 }
592 sub stop_noit {
593   return 0 unless ($noit_pid && kill 0, $noit_pid);
594   kill 9, $noit_pid;
595   $noit_pid = 0;
596   return 1;
597 }
598
599 sub start_stratcon {
600   my $name = shift;
601   my $options = shift;
602   $options->{name} = $name;
603   return 0 if $stratcon_pid;
604   L("start_stratcon -> config");
605   my $conf = make_stratcon_config($name, $options);
606   L("start_stratcon -> config($conf)");
607   $stratcon_pid = fork();
608   L("stratcon_pid -> $stratcon_pid") if($stratcon_pid);
609   mkdir "logs";
610   $stratcon_log = "logs/${name}_stratcon.log";
611   unlink($stratcon_log);
612   if($stratcon_pid == 0) {
613     L("in child");
614     childL;
615     $stratcon_pid = $$;
616     close(STDIN);
617     open(STDIN, "</dev/null");
618     close(STDOUT);
619     open(STDOUT, ">/dev/null");
620     close(STDERR);
621     open(STDERR, ">$stratcon_log");
622     my @args = ( 'stratcond', '-D', '-c', $conf );
623     L("in child -> exec");
624     my $prog = '../../src/stratcond';
625     if($ENV{TRACE}) {
626       shift @args;
627       unshift @args, $ENV{TRACE}, '-o', "logs/${name}_stratcon.trace", $prog;
628       $killsig = 3;
629       $prog = $ENV{TRACE};
630     }
631     { exec { $prog } @args; }
632     print STDERR "ERROR: $!\n";
633     exit(-1);
634   }
635   my $start = [gettimeofday];
636   while($stratcon_pid != 0 &&
637         tv_interval($start, [gettimeofday]) < $boot_timeout &&
638         !find_in_log($stratcon_log, qr/noit_listener\([^,]+,\s(\d+).*control_dispatch/)) {
639     usleep(100000);
640   }
641   my $pid = find_in_log($stratcon_log, qr/process starting: (\d+)/);
642   $stratcon_pid = $pid if($pid);
643   return $stratcon_pid;
644 }
645 sub get_stratcon_log {
646   return IO::File->new("<$stratcon_log");
647 }
648 sub stop_stratcon {
649   my $tryfor = 5;
650   return 0 unless ($stratcon_pid && kill 0, $stratcon_pid);
651   if($killsig != 0) {
652     my $start = [gettimeofday];
653     kill $killsig, $stratcon_pid;
654     while(kill 0, $stratcon_pid &&
655           tv_interval($start, [gettimeofday]) < $tryfor) {
656       usleep(100000);
657     }
658   }
659   kill 9, $stratcon_pid;
660   $stratcon_pid = 0;
661   return 1;
662 }
663
664 END {
665   stop_noit();
666   stop_stratcon();
667 }
668 1;
Note: See TracBrowser for help on using the browser.