should fix intermittant slowness, RT#18719
[freeside.git] / FS / FS / part_export / broadband_snmp.pm
1 package FS::part_export::broadband_snmp;
2
3 use strict;
4 use vars qw(%info $DEBUG);
5 use base 'FS::part_export';
6 use Net::SNMP qw(:asn1 :snmp);
7 use Tie::IxHash;
8
9 $DEBUG = 0;
10
11 my $me = '['.__PACKAGE__.']';
12
13 tie my %snmp_version, 'Tie::IxHash',
14   v1  => 'snmpv1',
15   v2c => 'snmpv2c',
16   # 3 => 'v3' not implemented
17 ;
18
19 tie my %snmp_type, 'Tie::IxHash',
20   i => INTEGER,
21   u => UNSIGNED32,
22   s => OCTET_STRING,
23   n => NULL,
24   o => OBJECT_IDENTIFIER,
25   t => TIMETICKS,
26   a => IPADDRESS,
27   # others not implemented yet
28 ;
29
30 tie my %options, 'Tie::IxHash',
31   'version' => { label=>'SNMP version', 
32     type => 'select',
33     options => [ keys %snmp_version ],
34    },
35   'community' => { label=>'Community', default=>'public' },
36   (
37     map { $_.'_command', 
38           { label => ucfirst($_) . ' commands',
39             type  => 'textarea',
40             default => '',
41           }
42     } qw( insert delete replace suspend unsuspend )
43   ),
44   'ip_addr_change_to_new' => { 
45     label=>'Send IP address changes to new address',
46     type=>'checkbox'
47   },
48   'timeout' => { label=>'Timeout (seconds)' },
49 ;
50
51 %info = (
52   'svc'     => 'svc_broadband',
53   'desc'    => 'Send SNMP requests to the service IP address',
54   'options' => \%options,
55   'weight'  => 10,
56   'notes'   => <<'END'
57 Send one or more SNMP SET requests to the IP address registered to the service.
58 Enter one command per line.  Each command is a target OID, data type flag,
59 and value, separated by spaces.
60 The data type flag is one of the following:
61 <font size="-1"><ul>
62 <li><i>i</i> = INTEGER</li>
63 <li><i>u</i> = UNSIGNED32</li>
64 <li><i>s</i> = OCTET-STRING (as ASCII)</li>
65 <li><i>a</i> = IPADDRESS</li>
66 <li><i>n</i> = NULL</li></ul>
67 The value may interpolate fields from svc_broadband by prefixing the field 
68 name with <b>$</b>, or <b>$new_</b> and <b>$old_</b> for replace operations.
69 The value may contain whitespace; quotes are not necessary.<br>
70 <br>
71 For example, to set the SNMPv2-MIB "sysName.0" object to the string 
72 "svc_broadband" followed by the service number, use the following 
73 command:<br>
74 <pre>1.3.6.1.2.1.1.5.0 s svc_broadband$svcnum</pre><br>
75 END
76 );
77
78 sub export_insert {
79   my $self = shift;
80   $self->export_command('insert', @_);
81 }
82
83 sub export_delete {
84   my $self = shift;
85   $self->export_command('delete', @_);
86 }
87
88 sub export_replace {
89   my $self = shift;
90   $self->export_command('replace', @_);
91 }
92
93 sub export_suspend {
94   my $self = shift;
95   $self->export_command('suspend', @_);
96 }
97
98 sub export_unsuspend {
99   my $self = shift;
100   $self->export_command('unsuspend', @_);
101 }
102
103 sub export_command {
104   my $self = shift;
105   my ($action, $svc_new, $svc_old) = @_;
106
107   my $command_text = $self->option($action.'_command');
108   return if !length($command_text);
109
110   warn "$me parsing ${action}_command:\n" if $DEBUG;
111   my @commands;
112   foreach (split /\n/, $command_text) {
113     my ($oid, $type, $value) = split /\s/, $_, 3;
114     $oid =~ /^(\d+\.)*\d+$/ or die "invalid OID '$oid'\n";
115     my $typenum = $snmp_type{$type} or die "unknown data type '$type'\n";
116     $value = '' if !defined($value); # allow sending an empty string
117     $value = $self->substitute($value, $svc_new, $svc_old);
118     warn "$me     $oid $type $value\n" if $DEBUG;
119     push @commands, $oid, $typenum, $value;
120   }
121
122   my $ip_addr = $svc_new->ip_addr;
123   # ip address change: send to old address unless told otherwise
124   if ( defined $svc_old and ! $self->option('ip_addr_change_to_new') ) {
125     $ip_addr = $svc_old->ip_addr;
126   }
127   warn "$me opening session to $ip_addr\n" if $DEBUG;
128
129   my %opt = (
130     -hostname => $ip_addr,
131     -community => $self->option('community'),
132     -timeout => $self->option('timeout') || 20,
133   );
134   my $version = $self->option('version');
135   $opt{-version} = $snmp_version{$version} or die 'invalid version';
136   $opt{-varbindlist} = \@commands; # just for now
137
138   $self->snmp_queue( $svc_new->svcnum, %opt );
139 }
140
141 sub snmp_queue {
142   my $self = shift;
143   my $svcnum = shift;
144   my $queue = new FS::queue {
145     'svcnum'  => $svcnum,
146     'job'     => 'FS::part_export::broadband_snmp::snmp_request',
147   };
148   $queue->insert(@_);
149 }
150
151 sub snmp_request {
152   my %opt = @_;
153   my $varbindlist = delete $opt{-varbindlist};
154   my ($session, $error) = Net::SNMP->session(%opt);
155   die "Couldn't create SNMP session: $error" if !$session;
156
157   warn "$me sending SET request\n" if $DEBUG;
158   my $result = $session->set_request( -varbindlist => $varbindlist );
159   $error = $session->error();
160   $session->close();
161
162   if (!defined $result) {
163     die "SNMP request failed: $error\n";
164   }
165 }
166
167 sub substitute {
168   # double-quote-ish interpolation of service fields
169   # accepts old_ and new_ for replace actions, like shellcommands
170   my $self = shift;
171   my ($value, $svc_new, $svc_old) = @_;
172   foreach my $field ( $svc_new->fields ) {
173     my $new_val = $svc_new->$field;
174     $value =~ s/\$(new_)?$field/$new_val/g;
175     if ( $svc_old ) { # replace only
176       my $old_val = $svc_old->$field;
177       $value =~ s/\$old_$field/$old_val/g;
178     }
179   }
180   $value;
181 }
182
183 1;