FS/FS/part_export/snmp.pm

   1 package FS::part_export::snmp;
   2
   3 =head1 FS::part_export::snmp
   4
   5 This export sends SNMP SETs to a router using the Net::SNMP package.  It requires the following custom fields to be defined on a router.  If any of the required custom fields are not present, then the export will exit quietly.
   6
   7 =head1 Required custom fields
   8
   9 =over 4
  10
  11 =item snmp_address - IP address (or hostname) of the router/agent
  12
  13 =item snmp_comm - R/W SNMP community of the router/agent
  14
  15 =item snmp_version - SNMP version of the router/agent
  16
  17 =back
  18
  19 =head1 Optional custom fields
  20
  21 =over 4
  22
  23 =item snmp_cmd_insert - SNMP SETs to perform on insert.  See L</Formatting>
  24
  25 =item snmp_cmd_replace - SNMP SETs to perform on replace.  See L</Formatting>
  26
  27 =item snmp_cmd_delete - SNMP SETs to perform on delete.  See L</Formatting>
  28
  29 =item snmp_cmd_suspend - SNMP SETs to perform on suspend.  See L</Formatting>
  30
  31 =item snmp_cmd_unsuspend - SNMP SETs to perform on unsuspend.  See L</Formatting>
  32
  33 =back
  34
  35 =head1 Formatting
  36
  37 The values for the snmp_cmd_* fields should be formatted as follows:
  38
  39 <OID>|<Data Type>|<expr>[||<OID>|<Data Type>|<expr>[...]]
  40
  41 =over 4
  42
  43 =item OID - SNMP object ID (ex. 1.3.6.1.4.1.1.20).  If the OID string starts with a '.', then the Private Enterprise OID (1.3.6.1.4.1) is prepended.
  44
  45 =item Data Type - SNMP data types understood by L<Net::SNMP>, as well as HEX_STRING for convenience.  ex. INTEGER, OCTET_STRING, IPADDRESS, ...
  46
  47 =item expr - Expression to be eval'd by freeside.  By default, the expression is double quoted and eval'd with all FS::svc_broadband fields available as scalars (ex. $svcnum, $ip_addr, $speed_up).  However, if the expression contains a non-escaped double quote, the expression is eval'd without being double quoted.  In this case, the expression must be a block of valid perl code that returns the desired value.
  48
  49 You must escape non-delimiter pipes ("|") with a backslash.
  50
  51 =back
  52
  53 =head1 Examples
  54
  55 This is an example for exporting to a Trango Access5830 AP.  Newlines inserted for clarity.
  56
  57 =over 4
  58
  59 =item snmp_cmd_delete -
  60
  61 1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50||
  62 1.3.6.1.4.1.5454.1.20.3.5.8|INTEGER|1|
  63
  64 =item snmp_cmd_insert -
  65
  66 1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50||
  67 1.3.6.1.4.1.5454.1.20.3.5.2|HEX_STRING|join("",$radio_addr =~ /[0-9a-fA-F]{2}/g)||
  68 1.3.6.1.4.1.5454.1.20.3.5.7|INTEGER|1|
  69
  70 =item snmp_cmd_replace -
  71
  72 1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50||
  73 1.3.6.1.4.1.5454.1.20.3.5.8|INTEGER|1||1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50||
  74 1.3.6.1.4.1.5454.1.20.3.5.2|HEX_STRING|join("",$new_radio_addr =~ /[0-9a-fA-F]{2}/g)||
  75 1.3.6.1.4.1.5454.1.20.3.5.7|INTEGER|1|
  76
  77 =back
  78
  79 =cut
  80
  81
  82 use strict;
  83 use vars qw(@ISA %info $me $DEBUG);
  84 use Tie::IxHash;
  85 use FS::Record qw(qsearch qsearchs);
  86 use FS::part_export;
  87 use FS::part_export::router;
  88
  89 @ISA = qw(FS::part_export::router);
  90
  91 tie my %options, 'Tie::IxHash', ();
  92
  93 %info = (
  94   'svc'     => 'svc_broadband',
  95   'desc'    => 'Sends SNMP SETs to an SNMP agent.',
  96   'options' => \%options,
  97   'notes'   => 'Requires Net::SNMP.  See the documentation for FS::part_export::snmp for required virtual fields and usage information.',
  98 );
  99
 100 $me= '[' .  __PACKAGE__ . ']';
 101 $DEBUG = 1;
 102
 103
 104 sub _field_prefix { 'snmp'; }
 105
 106 sub _req_router_fields {
 107   map {
 108     $_[0]->_field_prefix . '_' . $_
 109   } (qw(address comm version));
 110 }
 111
 112 sub _get_cmd_sub {
 113
 114   my ($self, $svc_broadband, $router) = (shift, shift, shift);
 115
 116   return(ref($self) . '::snmp_cmd');
 117
 118 }
 119
 120 sub _prepare_args {
 121
 122   my ($self, $action, $router) = (shift, shift, shift);
 123   my ($svc_broadband) = shift;
 124   my $old;
 125   my $field_prefix = $self->_field_prefix;
 126
 127   if ($action eq 'replace') { $old = shift; }
 128
 129   my $raw_cmd = $router->getfield("${field_prefix}_cmd_${action}");
 130   unless ($raw_cmd) {
 131     warn "[debug]$me router custom field '${field_prefix}_cmd_$action' "
 132       . "is not defined." if $DEBUG;
 133     return '';
 134   }
 135
 136   my $args = [
 137     '-hostname' => $router->getfield($field_prefix.'_address'),
 138     '-version' => $router->getfield($field_prefix.'_version'),
 139     '-community' => $router->getfield($field_prefix.'_comm'),
 140   ];
 141
 142   my @varbindlist = ();
 143
 144   foreach my $snmp_cmd ($raw_cmd =~ m/(.*?[^\\])(?:\|\||$)/g) {
 145
 146     warn "[debug]$me snmp_cmd is '$snmp_cmd'" if $DEBUG;
 147
 148     my ($oid, $type, $expr) = $snmp_cmd =~ m/(.*?[^\\])(?:\||$)/g;
 149
 150     if ($oid =~ /^([\d\.]+)$/) {
 151       $oid = $1;
 152       $oid = ($oid =~ /^\./) ? '1.3.6.1.4.1' . $oid : $oid;
 153     } else {
 154       return "Invalid SNMP OID '$oid'";
 155     }
 156
 157     if ($type =~ /^([A-Z_\d]+)$/) {
 158       $type = $1;
 159     } else {
 160       return "Invalid SNMP ASN.1 type '$type'";
 161     }
 162
 163     if ($expr =~ /^(.*)$/) {
 164       $expr = $1;
 165     } else {
 166       return "Invalid expression '$expr'";
 167     }
 168
 169     {
 170       no strict 'vars';
 171       no strict 'refs';
 172
 173       if ($action eq 'replace') {
 174         ${"old_$_"} = $old->getfield($_) foreach $old->fields;
 175         ${"new_$_"} = $svc_broadband->getfield($_) foreach $svc_broadband->fields;
 176         $expr = ($expr =~/[^\\]"/) ? eval($expr) : eval(qq("$expr"));
 177       } else {
 178         ${$_} = $svc_broadband->getfield($_) foreach $svc_broadband->fields;
 179         $expr = ($expr =~/[^\\]"/) ? eval($expr) : eval(qq("$expr"));
 180       }
 181       return $@ if $@;
 182     }
 183
 184     push @varbindlist, ($oid, $type, $expr);
 185
 186   }
 187
 188   push @$args, ('-varbindlist', @varbindlist);
 189
 190   return('', $args);
 191
 192 }
 193
 194 sub snmp_cmd {
 195   eval "use Net::SNMP;";
 196   die $@ if $@;
 197
 198   my %args = ();
 199   my @varbindlist = ();
 200   while (scalar(@_)) {
 201     my $key = shift;
 202     if ($key eq '-varbindlist') {
 203       push @varbindlist, @_;
 204       last;
 205     } else {
 206       $args{$key} = shift;
 207     }
 208   }
 209
 210   my $i = 0;
 211   while ($i*3 < scalar(@varbindlist)) {
 212     my $type_index = ($i*3)+1;
 213     my $type_name = $varbindlist[$type_index];
 214
 215     # Implementing HEX_STRING outselves since Net::SNMP doesn't.  Ewwww!
 216     if ($type_name eq 'HEX_STRING') {
 217       my $value_index = $type_index + 1;
 218       $type_name = 'OCTET_STRING';
 219       $varbindlist[$value_index] = pack('H*', $varbindlist[$value_index]);
 220     }
 221
 222     my $type = eval "Net::SNMP::$type_name";
 223     if ($@ or not defined $type) {
 224       warn $@ if $DEBUG;
 225       die "snmp_cmd error: Unable to lookup type '$type_name'";
 226     }
 227
 228     $varbindlist[$type_index] = $type;
 229   } continue {
 230     $i++;
 231   }
 232
 233   my ($snmp, $error) = Net::SNMP->session(%args);
 234   die "snmp_cmd error: $error" unless($snmp);
 235
 236   my $res = $snmp->set_request('-varbindlist' => \@varbindlist);
 237   unless($res) {
 238     $error = $snmp->error;
 239     $snmp->close;
 240     die "snmp_cmd error: " . $error;
 241   }
 242
 243   $snmp->close;
 244
 245   return '';
 246
 247 }
 248
 249
 250 =head1 BUGS
 251
 252 Plenty, I'm sure.
 253
 254 =cut
 255
 256 1;