File Coverage

blib/lib/NSNMP/Agent.pm
Criterion Covered Total %
statement 80 90 88.8
branch 17 26 65.3
condition 11 17 64.7
subroutine 14 15 93.3
pod 0 9 0.0
total 122 157 77.7


line stmt bran cond sub pod time code
1 2     2   48958 use strict;
  2         5  
  2         107  
2             package NSNMP::Agent;
3             # Copyright (c) 2003-2004 AirWave Wireless, Inc.
4              
5             # Redistribution and use in source and binary forms, with or without
6             # modification, are permitted provided that the following conditions
7             # are met:
8              
9             # 1. Redistributions of source code must retain the above
10             # copyright notice, this list of conditions and the following
11             # disclaimer.
12             # 2. Redistributions in binary form must reproduce the above
13             # copyright notice, this list of conditions and the following
14             # disclaimer in the documentation and/or other materials provided
15             # with the distribution.
16             # 3. The name of the author may not be used to endorse or
17             # promote products derived from this software without specific
18             # prior written permission.
19              
20             # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
21             # OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
22             # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23             # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
24             # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25             # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
26             # GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
27             # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
28             # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
29             # NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
30             # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 2     2   12 use NSNMP;
  2         4  
  2         33  
32 2     2   785 use POSIX;
  2         7750  
  2         18  
33 2     2   6848 use NSNMP::Mapper;
  2         6  
  2         2558  
34              
35             # on my 500MHz machine, it handled 2800 requests per second when it
36             # peremptorily returned an error message
37              
38             # adding the ability to actually return values slowed the error
39             # messages to 2300 per second; returning messages with values in them
40             # was roughly as fast
41              
42             # adding SNMP SET handling cut it down to 2200 messages per second or
43             # so.
44              
45             # Adding community string handling cut it down to 2100 messages per
46             # second or so.
47              
48             # Adding error handling and get-next handling cut it down to 2000
49             # get-requests or 1900 get-next requests per second. On a very small
50             # dataset, though; it was down around 1300 for a slightly larger one.
51              
52             sub new {
53 22     22 0 15730 my ($class, %args) = @_;
54 22         89 my $self = bless \%args, $class;
55 22         40 $self->{typemapper} = NSNMP::Mapper->new(%{$self->{types}});
  22         364  
56 2147         10154 $self->{_values} = {
57 22         43 map { NSNMP->encode_oid($_) => $self->{values}{$_} } keys %{$self->{values}}
  22         282  
58             };
59 22         649 $self->{_oids} = [sort keys %{$self->{_values}}]; # yay BER oids
  22         1856  
60 22         141 $self->{lastoid_idx} = 0;
61 22   100     250 $self->{community} ||= 'public';
62 22         372 return $self;
63             }
64              
65             sub _noSuchName {
66 5     5   6 my ($dr) = @_;
67 5         14 return NSNMP->encode(
68             request_id => $dr->request_id,
69             error_status => NSNMP::noSuchName,
70             error_index => 1, # XXX
71             type => NSNMP::GET_RESPONSE,
72             varbindlist => [$dr->varbindlist], # XXX?
73             );
74             }
75              
76             sub _badValue {
77 1     1   3 my ($dr) = @_;
78 1         4 return NSNMP->encode(
79             request_id => $dr->request_id,
80             error_status => NSNMP::badValue,
81             error_index => 1, # XXX
82             type => NSNMP::GET_RESPONSE,
83             varbindlist => [$dr->varbindlist], # XXX??
84             );
85             }
86              
87             sub next_oid_after {
88 5     5 0 8 my ($self, $oid) = @_;
89 5         13 my $oids = $self->{_oids};
90 5         8 my $lastindex = $self->{lastoid_idx};
91 5         7 my $lastoid = $oids->[$lastindex];
92 5 100 66     47 return $oids->[++$self->{lastoid_idx}] || NSNMP->encode_oid('.1.3')
      66        
93             if $lastoid and $oid eq $lastoid;
94 1         10 for my $ii (0..$#$oids) {
95 1 50       6 if ($oids->[$ii] gt $oid) {
96 1         2 $self->{lastoid_idx} = $ii;
97 1         4 return $oids->[$ii];
98             }
99             }
100 0         0 return NSNMP->encode_oid('.1.3'); # hope nobody tries to attach a value here
101             }
102              
103             sub handle_get_request {
104 15     15 0 23 my ($self, $dr, $reqtype) = @_;
105 15         15 my @rvbl;
106 15         44 for my $varbind ($dr->varbindlist) {
107 15         23 my ($oid, $type, $value) = @{$varbind};
  15         26  
108 15 100       43 $oid = $self->next_oid_after($oid) if $reqtype eq NSNMP::GET_NEXT_REQUEST;
109             # XXX damn, I thought I could avoid decoding this OID:
110 15         49 my ($otype, $instance) = $self->{typemapper}->map(NSNMP->decode_oid($oid));
111 15         42 my $ovalue = $self->{_values}{$oid};
112 15 100 66     56 return _noSuchName($dr) if not defined $otype or not defined $ovalue;
113 10         45 push @rvbl, [$oid, $otype, $ovalue];
114             }
115 10         32 return NSNMP->encode(
116             request_id => $dr->request_id,
117             type => NSNMP::GET_RESPONSE,
118             varbindlist => \@rvbl,
119             );
120             }
121              
122             sub handle_set_request {
123 4     4 0 5 my ($self, $dr) = @_;
124 4         13 for my $varbind ($dr->varbindlist) {
125 4         6 my ($oid, $type, $value) = @{$varbind};
  4         9  
126 4         23 my ($otype, $instance) = $self->{typemapper}->map(NSNMP->decode_oid($oid));
127 4         11 my $ovalue = $self->{_values}{$oid};
128 4 50 33     25 return _noSuchName($dr) if not defined $otype or not defined $ovalue;
129 4 100       11 return _badValue($dr) if $type ne $otype;
130 3         11 $self->{_values}{$oid} = $value;
131             }
132 3         12 return NSNMP->encode(
133             request_id => $dr->request_id,
134             type => NSNMP::GET_RESPONSE,
135             varbindlist => [$dr->varbindlist],
136             );
137             }
138              
139             sub handle_request {
140 21     21 0 78 my ($self, $request) = @_;
141 21         56 my $dr = NSNMP->decode($request);
142 21 100 66     89 return undef unless $dr and $dr->community eq $self->{community};
143 19         50 my $type = $dr->type;
144 19 100       69 return(($type eq NSNMP::SET_REQUEST) ? handle_set_request($self, $dr) :
145             handle_get_request($self, $dr, $type));
146             }
147              
148             sub run {
149 0     0 0 0 my ($self, $socket) = @_;
150 0         0 my ($request, $requestor);
151 0         0 for (;;) {
152 0 0       0 if ($requestor = recv $socket, $request, 65536, 0) {
153 0         0 my $response = $self->handle_request($request, $requestor);
154 0 0       0 send $socket, $response, 0, $requestor if $response;
155             } else {
156 0         0 warn "Error on receive: $!";
157             }
158             }
159             }
160              
161             # for testing purposes only
162             # non-testing would require specifying host and returning errors sensibly
163             sub spawn {
164 15     15 0 38 my ($self, $port) = @_;
165             # note we bind socket before forking, which has two advantages:
166             # - packets never get lost because they got sent before the child
167             # binds the port
168             # - errors kill the main process, not the child.
169 15         1228 my $listensocket = IO::Socket::INET->new(
170             Proto => 'udp',
171             LocalAddr => "127.0.0.1:$port",
172             ReuseAddr => 1,
173             );
174 15 50       10072 die "Can't bind port $port: $!" unless $listensocket;
175 15         21566 my $pid = fork();
176 15 50       464 die "Can't fork: $!" if not defined $pid;
177 15 50       80 if (not $pid) {
178 0         0 $self->run($listensocket);
179 0         0 POSIX::_exit(0);
180             }
181 15         2035 $listensocket->close(); # in parent
182 15         3999 return $pid;
183             }
184              
185             # temp_agent --- test utility function for reaping agents later
186             {
187             my $port = 16165;
188             my @pids;
189             sub temp_agent {
190 13     13 0 30 my ($self) = @_;
191 13         25 $port++;
192 13         114 my $pid = $self->spawn($port);
193 13         205 push @pids, $pid;
194 13         679 return "127.0.0.1:$port";
195             }
196             sub kill_temp_agents {
197 2     2 0 3583 for (@pids) { kill 9, $_; wait() }
  13         13002  
  13         48159  
198 2         738 @pids = ();
199             }
200             }
201              
202             1;