1#!/usr/local/bin/perl -w
2
3# This is snmptrapd handler script to alert Platform Event Traps (PET).
4# I wrote it because traptoemail distributed with net-snmp-5.3.2.2 is
5# incapable of handling multi-line hexstrings and restricted to email alert.
6#
7# This script operates in two modes, traphandle or embperl.  When in
8# traphandle mode, it concatenates the quoted hex string into one long line,
9# then builds structures to resemble embperl mode. Both modes then invokes
10# helper decoder, ipmi-pet(8) from FreeIPMI, parses the output and alerts
11# in given way like email, nagios external command, etc. See README for
12# a simple tutorial.
13#
14# This script is tested on Dell PowerEdge 1950 and PowerEdge R610 servers.
15# Feel free to adjust to meet your need. It's BSD-licensed.
16#
17# ChangeLog
18#
19# * Fri 16 Dec 2011 kaiwang.chen@gmail.com
20# - Re-add nsca support.
21# - Protect against hex string for traphandle missing ending whitespace.
22#
23# * Wed 14 Dec 2011 kaiwang.chen@gmail.com
24# - Add performance logging support with 'perf' token
25#
26# * Mon 12 Dec 2011 kaiwang.chen@gmail.com
27# - Remove nsca support because snmptrapd is meant to run on the Nagios host
28# - Fix nagios external command file support
29# - Map FreeIPMI Nominal state to Nagios OK
30# - Fix Net::SMTP typos and options handling
31# - Remove USAGE section, please refer to README
32#
33# * Sun 11 Dec 2011 kaiwang.chen@gmail.com
34# - Add -W to pass workaround flags to ipmi-pet
35#
36# * Wed 7  Dec 2011 kaiwang.chen@gmail.com
37# - Add --ack support
38# - capture exit code of helper
39#
40# * Mon 14 Nov 2011 kaiwang.chen@gmail.com
41# - complete rewritten, supports embperl mode and additional alert methods
42#
43# * Sat 12 Nov 2011 kaiwang.chen@gmail.com
44# - support sdr cache file mapping with -c option
45# - add debug log
46# - in case of no PTR, fallback to ip
47#
48# * Sun 06 Nov 2011 kaiwang.chen@gmail.com
49# - Inital version
50
51package IpmiPET::Perf;
52use Time::HiRes qw(tv_interval gettimeofday);
53sub new {
54  bless {
55    _elapsed => 0,
56  }, __PACKAGE__;
57}
58sub start { shift->{_start} = [gettimeofday] }
59sub stop {
60  my ($obj,$name) = @_;
61  my $t1 = [gettimeofday];
62  my $t = tv_interval($obj->{_start}, $t1);
63  $obj->{_elapsed} += $t;
64  if ($name) {
65    $obj->{_laps}{$name} = $t;
66  }
67  return $t;
68}
69sub reset {
70  my ($obj) = @_;
71  $obj->{_elapsed} = 0;
72  if ($obj->{_start}) { delete $obj->{_start} }
73  if ($obj->{_laps}) { delete $obj->{_laps} }
74}
75sub elapsed { shift->{_elapsed} }
76sub laps { shift->{_laps} }
771;
78
79
80package IpmiPET;
81
82use strict;
83use Getopt::Long;
84
85# mapping IPMI nodes to preinitialized sdr caches
86my %cache_mapping=();
87
88# options
89my %opts = ();
90
91# options and args pass to specific alert mechanisms
92my %alert_opts = (); # when use builtin features to alert
93my $alert_prog = ""; # when use external program to alert
94
95# logger
96my $log_filename = "/var/log/petalert.log";
97my %logger_token = ('warn' => 1); # always warn
98
99# performance ticker
100my $perf;
101
102
103sub usage {
104    print <<"EOF";
105USAGE
106
107$0 [OPTIONS] -- [ALERT_SPECIFIC_OPTIONS] ALERT_SPECIFIC_ARGS
108
109  OPTIONS
110    -m
111    --mode  {traphandle|embperl}
112                Specify mode of execution. Required.
113    --ack
114                Acknowledge the trap before alert.
115    -W
116    --workaround
117                Sets workaround flags for ipmi-pet to acknowledge the trap.
118    -o
119    --trapoid  OID
120                Sets trapoid in embperl mode, or defaults to "all".
121    -c
122    --sdrcache  sdr_cache_config
123                Specify the sdr cache configuration file.
124    -f
125    --log  log_file
126                Specify logging file
127    -n
128    --alert  {mail|nagios|nsca|noop|MODULE}
129                Specify alert method. Defaults to "noop".
130
131  ALERT SPECIFIC OPTIONS AND ARGS
132  email
133    --prog  mailer
134                Sets mailer. If not specified, falls back to Net::SMTP.
135    mailer_options_and_args
136
137    --server smtp_server
138                Sets the smtpserver for Net::SMTP to send the mail through.
139                Defaults to "localhost".
140    --from from_address
141                Sets the email for Net:SNMP to be used on the From: line.
142                Defaults to "root".
143    to_addresses
144                Sets where you want Net::SMTP to send the email to. Required.
145
146  nagios
147    --host  {fqdn|short}
148                Sets host in nagios external commands. Defaults to short (first component).
149    --service
150                Sets service in nagios external commands. Defaults to PET.
151    command_file
152                Sets Nagios external command file, a named pipe (FIFO).
153                Required.
154  nsca
155    --prog  send_nsca
156                Sets path to send_nsca binary, required.
157    --host  {fqdn|short}
158                Sets host for the passive check. Defaults to short (first component).
159    --service
160                Sets service for the passive check. Defaults to PET.
161    -- send_nsca_options_and_args
162                Pass options and args through to send_nsca binary.
163
164  noop          Yes, it is a no-op.
165
166  MODULE <not implemented>
167    --prog plugin
168                Path to plugin script, which must provides..
169    plugin_options_and_args
170                Additional arguments passed to plugin as \@ARGV.
171EOF
172
173  exit;
174}
175
176sub logger {
177  my ($token, $msg, $variable) = @_;
178  $token ||= "";
179
180  if (open my $fh, ">>", $log_filename) {
181    if ($logger_token{":all"} || $logger_token{$token}) {
182      if ($variable) {
183        use Data::Dumper;
184        my $t = $Data::Dumper::Terse;
185        $Data::Dumper::Terse = 1;
186        print $fh "[".localtime()."] $token $msg " . Dumper($variable);
187        $Data::Dumper::Terse = $t;
188      }
189      else {
190        print $fh "[".localtime()."] $token $msg\n";
191      }
192    }
193    close $fh;
194  }
195}
196
197# extract ip from value like "UDP: [172.23.252.107]:32768"
198sub extract_ip {
199  my ($ip) = ($_[0] =~ /\[([\d.]+)\]:/);
200  return $ip || "0.0.0.0";
201}
202
203# decode specified event hexstring into hash like
204#   'Time' => '13:16:24',
205#   'Event' => 'General Chassis Intrusion ; Intrusion while system On',
206#   'System_ID' => '256',
207#   'State' => 'Critical',
208#   'GUID' => '44454c4c-5000-1059-8043-b2c04f333358',
209#   'Date' => 'Oct-15-2011',
210#   'Manufacturer_ID' => 'Dell Inc.',
211#   'Name' => 'Sensor #115',
212#   'Severity' => 'N/A',
213#   'Event_Direction' => 'Assertion Event',
214#   'Type' => 'Physical_Security'
215#
216sub decode_pet {
217  my ($specific, $event_hexstring, $sdrcache) = @_;
218
219  my $ipmi_pet = "/usr/sbin/ipmi-pet";
220  my @o = qw(-v -v --output-event-severity --output-event-state --interpret-oem-data --comma-separated-output);
221  if ($sdrcache) { push @o, "--sdr-cache-file", $sdrcache }
222  push @o, $specific;
223  $event_hexstring =~ tr/0-9a-fA-F/ /cs; # sanity check
224  $event_hexstring =~ s/^\s+//; # in case of (split/\s+/)[0] being ""
225  push @o, split /\s+/, $event_hexstring;
226
227  my @x = ();
228  logger("decode", "command line ", [$ipmi_pet, \@o]);
229  if (open my $fh, "-|", $ipmi_pet, @o) {
230    @x = <$fh>;
231    close $fh;
232    if ($? >> 8) {
233      logger("warn", "decode failure with CHILD_ERROR: $?");
234      return;
235    }
236  }
237  else {
238    logger("warn", "decoder failure: $!");
239    return;
240  }
241  chomp(@x);
242
243  logger("decode", "output ", \@x);
244  my @headers = split /,/, $x[0];
245  my @values = split /,/, $x[1];  # TODO support doubly quoted value
246  if (@headers != @values) {
247    logger("warn", "Spot malicious comma separated value", \@x);
248  }
249  my %event = ();
250  for my $i (0..$#headers) {
251    my $h = $headers[$i];
252    $h =~ s/ /_/g;
253    $event{$h} = $values[$i];
254  }
255  logger("decode", "event ", \%event);
256  return \%event;
257}
258
259sub ack_pet {
260  my ($specific, $event_hexstring, $host, $workaround) = @_;
261
262  my $ipmi_pet = "/usr/sbin/ipmi-pet";
263  my @o = qw(--pet-acknowledge);
264  if ($workaround) {
265    push @o, "-W", $workaround;
266  }
267  push @o, "-h", $host;
268  push @o, $specific;
269  $event_hexstring =~ tr/0-9a-fA-F/ /cs; # sanity check
270  $event_hexstring =~ s/^\s+//; # in case of (split/\s+/)[0] being ""
271  push @o, split /\s+/, $event_hexstring;
272
273  my @x = ();
274  logger("ack", "command line ", [$ipmi_pet, \@o]);
275  if (open my $fh, "-|", $ipmi_pet, @o) {
276    @x = <$fh>;
277    close $fh;
278    if ($? >> 8) {
279      logger("warn", "ackhelper failure with CHILD_ERROR: $?");
280    }
281  }
282  else {
283    logger("warn", "ackhelper failure: $!");
284  }
285}
286
287# ipmi-pet localtime to calendar time
288sub pettime {
289  my ($event) = @_;
290  require POSIX;
291  my ($hour,$min,$sec) = split /:/, $event->{Time};
292  my ($mon,$mday,$year) = split /-/, $event->{Date};
293  $year -= 1900;
294  my %m = (
295    Jan => 0, Feb =>  1, Mar =>  2, Apr => 3, May =>  4, Jun =>  5,
296    Jul => 6, Aug =>  7, Sep =>  8, Oct => 9, Nov => 10, Dec => 11,
297  );
298  if (exists $m{$mon}) { $mon = $m{$mon} }
299  else {
300    logger("warn", "pettime month $mon will map to 0, please check ipmi-pet");
301    $mon = 0;
302  }
303  return POSIX::mktime($sec, $min, $hour, $mday, $mon, $year);
304}
305
306# convert event to nagios plugin output
307# See http://nagios.sourceforge.net/docs/3_0/pluginapi.html
308sub nagios_check {
309  my ($event) = @_;
310  my ($code, $state);
311
312  $state = uc($event->{State});
313  if    ($state eq "WARNING")  {$code = 1}
314  elsif ($state eq "CRITICAL") {$code = 2}
315  elsif ($state eq "OK")       {$code = 0}
316  elsif ($state eq "NOMINAL")  {$code = 0; $state = "OK"}
317  else                         {$code = 3; $state = "UNKNOWN"}
318
319  my $plugin_output = join(" ", $state, "-", map { defined $_ ? $_ : "" } @{%{$event}}{qw(Name Type Event_Direction Event)});
320  $plugin_output =~ tr/\n\t;|/@:/;
321
322  return ($code, $plugin_output);
323}
324sub nagios_host {
325  my ($pdu_info, $opt) = @_;
326  my $h = $pdu_info->{hostname};
327  if ($opt eq 'short') {
328    ($h) = ($pdu_info->{hostname} =~ m/([^.]+)/);
329  }
330  return $h;
331}
332
333# assemble SMTP DATA, http://cr.yp.to/smtp/mail.html
334# TODO return encoded data
335sub mail_data {
336  my ($from, $to, $pdu_info, $uptime, $event) = @_;
337
338  local $" = ", "; # " balance
339  my $data = <<"DATA";
340To: @{$to}
341From: $from
342Subject: PET from $pdu_info->{hostname}: $event->{State} - $event->{Event}
343
344Host: $pdu_info->{hostname} ($pdu_info->{receivedfrom}) uptime $uptime
345DATA
346
347  for my $k (qw(Date Time Name Type Event Event_Direction State Severity GUID Manufacturer_ID System_ID)) {
348    $data .= "$k: $event->{$k}\n";
349  }
350
351  return $data;
352}
353
354# embperl NetSNMP::TrapReceiver trap receiver
355sub my_receiver {
356  my ($pdu_info, $varbindings) = @_;
357
358  #use Data::Dumper;print Dumper($pdu_info); print Dumper($varbindings);
359  logger("embperl", "original input is ", \@_);
360
361  # inject hostname
362  unless (exists $pdu_info->{hostname}) {
363    use Socket;
364    my $ip = extract_ip($pdu_info->{receivedfrom});
365    $perf->start;
366    $pdu_info->{hostname} = gethostbyaddr(inet_aton($ip), AF_INET) || $ip;
367    $perf->stop("resolv");
368  }
369
370  # do cleanup before processing; values are untouched if -OQ, see snmpcmd(1)
371  for (@$varbindings) {
372    $_->[1] =~ s/^OID: //;
373    $_->[1] =~ s/^IpAddress: //;
374    $_->[1] =~ s/^STRING: //;
375    $_->[1] =~ s/^Hex-STRING: //;
376    if ($_->[1] =~ s/^Timeticks: //) {
377      $_->[1] =~ s/^\(\d+\) //;
378      $_->[1] =~ s/ days, /:/;
379    }
380  }
381  logger("embperl", "input after cleanup is ", \@_);
382
383  process($pdu_info, $varbindings);
384  my $laps = $perf->laps;
385  logger("perf", join(", ", map { $_ . "=" . $laps->{$_} } keys %{$laps}));
386  $perf->reset;
387}
388
389# you got it..
390sub process {
391  my ($pdu_info, $varbindings) = @_;
392  my ($event_oid, $specific, $uptime, $event);
393
394  # locate the PET event hex string, and extract specific trap number
395  for my $v (@{$varbindings}) {
396    if ($v->[0] =~ /^\Q.1.3.6.1.6.3.1.1.4.3.0\E$/) {
397      $event_oid = $v->[1];
398    }
399    if ($v->[0]=~ /^\Q.1.3.6.1.6.3.1.1.4.1.0\E$/) {
400      ($specific)=($v->[1]=~/(\d+)$/);
401    }
402    if ($v->[0] =~ /^\Q.1.3.6.1.2.1.1.3.0\E$/) {
403      $uptime = $v->[1];
404    }
405  }
406  $event_oid .= ".1";
407
408  $uptime ||= "00:00:00:00.00";
409  if (my ($d,$H,$M,$S,$x) = ($uptime =~ /(\d+):(\d+):(\d+):(\d+)\.(\d+)/)) {
410    if ($d > 0)    { $uptime = "${d}d${H}h" }
411    elsif ($H > 0) { $uptime = "${H}h${M}m" }
412    elsif ($M > 0) { $uptime = "${M}m${S}s" }
413    else           { $uptime = "${S}.${x}s" }
414  }
415
416  # convert event string to human readable form
417  for my $v (@{$varbindings}) {
418    if ($v->[0] =~ /^\Q$event_oid\E$/) {
419      my $ip = extract_ip($pdu_info->{receivedfrom});
420      if ($opts{ack}) {
421        $perf->start;
422        ack_pet($specific, $v->[1], $ip, $opts{workaround});
423        $perf->stop("ack");
424      }
425
426      my $sdrcache = resolve_sdrcache($ip);
427
428      # decode octet hex string
429      $event = decode_pet($specific, $v->[1], $sdrcache);
430    }
431  }
432
433  # invalid events cease here
434  return unless $event;
435
436  alert($pdu_info, $uptime, $event);
437  return;
438}
439
440# build NetSNMP::TrapReceiver style structures from standard input
441#  See NOTIFICATION PROCESSING snmptrapd.conf(5)
442sub get_from_stdin {
443  my ($stdin) = @_;
444  my $hostname = shift @{$stdin};
445  my $ipaddress = shift @{$stdin};
446
447  chomp($hostname);
448  chomp($ipaddress);
449
450  # in case of no PTR records available for the IPMI node
451  if($hostname eq "<UNKNOWN>" && (my $ip = extract_ip($ipaddress))) {
452    $hostname = $ip;
453  }
454
455  # some defaults, blindly.. to resemble those by NetSNMP::TrapReceiver
456  my %pdu_info = (
457    notificationtype   =>  "TRAP",
458    hostname           =>  $hostname,
459    receivedfrom       =>  $ipaddress,
460    version            =>  0,
461    errorstatus        =>  0,
462    messageid          =>  0,
463    transactionid      =>  1,
464    errorindex         =>  0,
465    requestid          =>  0,
466  );
467
468  my @varbindings= ();
469  my ($oid,$value);
470  my $more = 0;
471  my $line = "";
472  for (@{$stdin}) {
473      if ($more == 0 && $line) {
474          $line =~ s/\n\Z//s;
475          ($oid, $value) = ($line =~ /([^\s]+)\s+(.*)/s);
476          $line = "";
477          push @varbindings, [$oid, $value, "="];
478      }
479
480      # recognize doubly quoted context
481      my $count = 0;
482      my $x = -1;
483      $x=index($_, q{"});
484      while ($x >= 0) {
485         unless ($x > 0 && substr($_, $x-1, 1) eq "\\") {
486             $count++;
487         }
488         $x += 1;
489         $x=index($_, q{"}, $x);
490      }
491      if ($count % 2 == 1) {
492          $more = $more == 1 ? 0 : 1;
493      }
494
495      $line .= "$_\n";
496  }
497  if ($line) {
498      $line =~ s/\n\Z//s;
499      ($oid, $value) = ($line =~ /([^\s]+)\s+(.*)/s);
500      $line = "";
501      push @varbindings, [$oid, $value];
502  }
503
504  # Notice the assembled varbindings slightly differs from that in embperl.
505  # For instance, hex string is surrounded by doubly quote, and never
506  # prefixed by "Hex-STRING: ".
507  return (\%pdu_info, \@varbindings);
508}
509
510# traphandle handler
511sub handle_trap {
512  chomp(my @stdin = <STDIN>);
513  logger("traphandle", "input text is ", \@stdin);
514  my ($pdu_info, $varbindings) = get_from_stdin(\@stdin);
515  logger("traphandle", "got pdu_info and varbindings ", [$pdu_info,$varbindings]);
516  process($pdu_info, $varbindings);
517
518  my $laps = $perf->laps;
519  logger("perf", join(", ", map { sprintf '%s=%f', $_,$laps->{$_} } keys %{$laps}));
520  $perf->reset;
521}
522
523# alert dispatcher
524sub alert {
525  my ($pdu_info, $uptime, $event) = @_;
526
527  if ($opts{'alert'} eq 'email') {
528    my $data = mail_data($alert_opts{'from'}, \@ARGV, $pdu_info, $uptime, $event);
529    logger("alert", "mail data is", [\$data]);
530
531    if ($alert_prog) {
532      logger("alert", "mailer invoked with ", [$alert_prog,\@ARGV]);
533      $perf->start;
534      if (open MAILER, "|-", $alert_prog, @ARGV) {
535        print MAILER $data;
536        close MAILER;
537      }
538      else {
539        logger("warn", "Unable to alert through mailer[$alert_prog @ARGV]: $!");
540      }
541      $perf->stop("mailer");
542    }
543    else {
544      logger("alert", "mail by Net::SMTP ", [$alert_opts{'server'},$alert_opts{'from'}, \@ARGV]);
545      $perf->start;
546      eval {
547        my $message = Net::SMTP->new($alert_opts{'server'}) || die "ERROR: can't talk to server $alert_opts{'server'}\n";
548        $message->mail($alert_opts{'from'});
549        $message->to(@ARGV) || die "ERROR: failed to send to the recepients ",join(",",@ARGV),": $!";
550        $message->data();
551        $message->datasend($data);
552        $message->dataend();
553        $message->quit;
554      };
555      $perf->stop("netsmtp");
556      if ($@) {
557        logger("warn", "alert mail failure ", $@);
558      }
559    }
560  }
561  elsif ($opts{'alert'} eq 'nagios') {
562    my $command_file = $ARGV[0];
563    logger("alert", "nagios external command file is $command_file");
564
565    my $t = pettime($event);
566    my ($code,$plugin_output) = nagios_check($event);
567    my $nagios_host = nagios_host($pdu_info, $alert_opts{host});
568    my $nagios_service = $alert_opts{service};
569
570    # http://nagios.sourceforge.net/docs/3_0/extcommands.html
571    my $cmd = "[$t] PROCESS_SERVICE_CHECK_RESULT;$nagios_host;$nagios_service;$code;$plugin_output";
572    logger("alert", "nagios command is", $cmd);
573
574    $perf->start;
575    if (open NAGIOS, ">>", $command_file) {
576      print NAGIOS "$cmd\n";
577      close NAGIOS;
578    }
579    else {
580      logger("warn", "nagios failure with $command_file: $!");
581    }
582    $perf->stop("nagios");
583  }
584  elsif ($opts{'alert'} eq 'nsca') {
585    logger("alert", "send_nsca invoked as ", [$alert_prog, \@ARGV]);
586
587    my ($code,$plugin_output) = nagios_check($event);
588    my $nagios_host = nagios_host($pdu_info, $alert_opts{host});
589    my $nagios_service = $alert_opts{service};
590
591    # http://nagios.sourceforge.net/download/contrib/documentation/misc/NSCA_Setup.pdf
592    my $cmd= "$nagios_host\t$nagios_service\t$code\t$plugin_output";
593    logger("alert", "nsca command is", $cmd);
594
595    $perf->start;
596    if (open NSCA, "|-", $alert_prog, @ARGV) {
597      print NSCA "$cmd\n";
598      close NSCA;
599      if ($? >> 8) {
600        logger("warn", "nsca failure with CHILD_ERROR: $?");
601      }
602    }
603    else {
604      logger("warn", "nsca failure: $!");
605    }
606    $perf->stop("nsca");
607  }
608  elsif ($opts{'alert'} eq 'noop') {
609    logger('alert', 'noop alert selected');
610  }
611  else {
612    logger("alert", "alert module");
613    # TODO module
614    die "alert module is not implemented!";
615  }
616}
617
618# load sdr cache config into global mapping hash
619sub load_sdrcache_config {
620  my ($conf) = @_;
621
622  my $cache_file = "";
623  my $nl = 0;
624  for (@{$conf}) {
625    $nl++;
626    chomp;
627    s/#.*$//; # trim comment
628    s/\s+$//; # trim trailing whitespaces
629    next if /^$/;
630    if (/^\S/) {
631      if (-e $_) {
632        $cache_file = $_;
633      }
634      else {
635        return "ERROR: no such sdr cache file[$_] at line #$nl";
636      }
637    }
638    if (/^\s/) {
639      s/^\s+//; # trim leading whitespaces
640      if ($cache_file) {
641        for (split /\s+/) {
642          $cache_mapping{$_} = $cache_file;
643        }
644      }
645      else {
646        return "ERROR: missing sdr cache file for host[$_] at line #$nl";
647      }
648    }
649  }
650
651  return;
652}
653
654# given an ipv4 address, resolve to related sdr cache
655sub resolve_sdrcache {
656  my ($ipmi_node) = @_;
657  my $sdrcache = "";
658  if (exists $cache_mapping{$ipmi_node}) {
659     $sdrcache = $cache_mapping{$ipmi_node};
660     logger("sdrcache", "$ipmi_node resolved to $sdrcache");
661  }
662  else {
663     my $re = qr/^(.*)\[([-\d,]+)\](.*)$/;  # to match against eg. 10.2.3.[4-7]
664     for my $k (keys %cache_mapping) {
665        if (my ($prefix,$range,$suffix) = ($k =~ m/$re/)) {
666           if (my ($item) = ($ipmi_node =~ /^\Q$prefix\E(.+)\Q$suffix\E$/)) {
667              for (split /,+/, $range) {
668                 my ($f,$t);
669                 if (
670                      ((($f,$t) = m/^(\d+)-(\d+)$/) && $f <= $item && $item <= $t)
671                      || $item == $_
672                    ) {
673                    # got it
674                    $sdrcache = $cache_mapping{$k};
675                    logger("sdrcache", "$ipmi_node resolved to ", [$k => $sdrcache]);
676                 }
677              }
678           }
679        }
680     }
681  }
682
683  $sdrcache || logger("sdrcache", "$ipmi_node will use default cache");
684
685  return $sdrcache;
686}
687
688# process and verify args
689sub process_args {
690  # parse global ARGV for this package
691  GetOptions(\%opts, 'help!', 'quiet!', 'mode|m=s', 'ack!', 'workaround|W=s',
692    'trapoid|o=s', 'sdrcache|c=s', 'log|f=s', 'Debug|D=s', 'alert|n=s');
693
694  if ($opts{'help'}) {
695    usage();
696  }
697
698  # log file
699  if ($opts{'log'}) {
700    if (-w $opts{'log'}) {
701      $log_filename = $opts{'log'};
702    }
703    else {
704      die "log file $opts{'log'} is not writable";
705    }
706  }
707  unless ($opts{'quiet'}) {
708    print STDERR "petalert.pl is logging to $log_filename, use -q to suppress this tip\n";
709  }
710
711  # comma-separated debug tokens
712  if ($opts{'Debug'}) {
713    $logger_token{$_} = 1 for split /,+/, $opts{'Debug'};
714  }
715  # logging now ready
716  logger("argv", "parsed options is ", \%opts);
717
718  if ($opts{'sdrcache'}) {
719    my $conf = $opts{'sdrcache'};
720    logger("sdrcache", "config is [$conf]");
721
722    open CONF, "<", $conf || logger("warn", "assumes default cache because failed to config file[$conf]: $!");
723    chomp(my @lines = <CONF>);
724    close CONF;
725
726    load_sdrcache_config(\@lines);
727    logger("sdrcache", "cache_mapping is ", \%cache_mapping);
728
729    if ($opts{'syntax-only'}) {
730      exit;
731    }
732  }
733
734  if ($opts{'mode'} eq 'embperl') {
735    unless (exists $opts{trapoid}) {
736      $opts{trapoid} = "all";
737      logger("argv", "no trapoid specified, defaults to all");
738    }
739    require NetSNMP::TrapReceiver;
740  }
741  elsif ($opts{'mode'} eq 'traphandle') {
742  }
743  else {
744    print STDERR "Unknown operation mode: $opts{mode}\n";
745    usage();
746  }
747
748  # alert method defaults to no-op
749  unless (exists $opts{'alert'}) {
750    $opts{'alert'} = 'noop';
751    logger("argv", "no alert method specified, defaults to noop");
752  }
753
754  # alert methods
755  if ($opts{'alert'} eq 'email') {
756    # use external mail program
757    if ($ARGV[0] && $ARGV[0] eq "--prog") {
758      shift @ARGV;
759      $alert_prog = shift @ARGV;
760      unless (-x $alert_prog) {
761        die "mailer[$alert_prog] is not executable\n";
762      }
763    }
764    # or use perl module
765    else {
766      GetOptions(\%alert_opts, "server=s", "from=s");
767      require Net::SMTP;
768    }
769  }
770  elsif ($opts{'alert'} eq 'nagios' || $opts{'alert'} eq 'nsca') {
771    GetOptions(\%alert_opts, "prog=s", "host|H=s", "service|S=s");
772    $alert_opts{host} ||= "short";
773    $alert_opts{service} ||= "PET";
774    if ($alert_opts{host} ne "fqdn" && $alert_opts{host} ne "short") { # TODO
775      die "Unknown host mapping $alert_opts{host}\n";
776    }
777    if ($opts{'alert'} eq 'nagios' && !($ARGV[0] && -w $ARGV[0])) {
778      die "nagios external command file[$ARGV[0]] is not writable\n";
779    }
780    if ($opts{'alert'} eq 'nsca' && ! $alert_opts{prog}) {
781      die "send_nsca binary is not set\n";
782    }
783    $alert_prog = $alert_opts{prog} || "";
784  }
785  elsif ($opts{'alert'} eq 'noop') {
786  }
787  else {
788    my $module = $opts{'alert'};
789    if (-r $module) {
790      require "$module";
791      # TODO
792      die "<not implemenented yet>";
793    }
794    else {
795      die "Unknown alert module to load: $module\n";
796    }
797    # invokes handler
798  }
799
800  # @ARGV now holds alert specific arguments
801}
802
803sub main {
804  @ARGV = @_;  # set global ARGV for this package
805  process_args();
806  $perf = IpmiPET::Perf->new;
807  if ($opts{'mode'} eq 'traphandle') {
808    logger("main", "running as traphandle");
809    handle_trap();
810  }
811  elsif ($opts{'mode'} eq 'embperl') {
812    logger("main", "running as embperl");
813    NetSNMP::TrapReceiver::register($opts{trapoid}, \&my_receiver) ||
814           warn "failed to register our perl trap handler\n";
815  }
816  else {
817    die "Should never reach here!\n";
818  }
819
820  return 0;
821}
822
823
824# run the program
825if ( !caller ) { exit main(@ARGV); }
826
8271;
828