File Coverage

blib/lib/Net/SNMP/PDU.pm
Criterion Covered Total %
statement 98 366 26.7
branch 45 228 19.7
condition 5 54 9.2
subroutine 15 48 31.2
pod 0 33 0.0
total 163 729 22.3


line stmt bran cond sub pod time code
1             # -*- mode: perl -*-
2             # ============================================================================
3              
4             package Net::SNMP::PDU;
5              
6             # $Id: PDU.pm,v 3.1 2010/09/10 00:01:22 dtown Rel $
7              
8             # Object used to represent a SNMP PDU.
9              
10             # Copyright (c) 2001-2010 David M. Town
11             # All rights reserved.
12              
13             # This program is free software; you may redistribute it and/or modify it
14             # under the same terms as the Perl 5 programming language system itself.
15              
16             # ============================================================================
17              
18 2     2   9 use strict;
  2         7  
  2         75  
19              
20 2         864 use Net::SNMP::Message qw(
21             :types :versions asn1_itoa ENTERPRISE_SPECIFIC TRUE FALSE DEBUG_INFO
22 2     2   1753 );
  2         7  
23              
24 2     2   1639 use Net::SNMP::Transport qw( DOMAIN_UDPIPV4 DOMAIN_TCPIPV4 );
  2         7  
  2         229  
25              
26             ## Version of the Net::SNMP::PDU module
27              
28             our $VERSION = v3.0.1;
29              
30             ## Handle importing/exporting of symbols
31              
32 2     2   15 use base qw( Net::SNMP::Message );
  2         3  
  2         14251  
33              
34             sub import
35             {
36 3     3   1426 return Net::SNMP::Message->export_to_level(1, @_);
37             }
38              
39             # [public methods] -----------------------------------------------------------
40              
41             sub new
42             {
43 2     2 0 12 my $class = shift;
44              
45             # We play some games here to allow us to "convert" a Message into a PDU.
46              
47 2 100       25 my $this = ref($_[0]) ? bless shift(@_), $class : $class->SUPER::new();
48              
49             # Override or initialize fields inherited from the base class
50              
51 2         13 $this->{_error_status} = 0;
52 2         3 $this->{_error_index} = 0;
53 2         6 $this->{_scoped} = FALSE;
54 2         5 $this->{_var_bind_list} = undef;
55 2         5 $this->{_var_bind_names} = [];
56 2         4 $this->{_var_bind_types} = undef;
57              
58 2         7 my (%argv) = @_;
59              
60             # Validate the passed arguments
61              
62 2         5 for (keys %argv) {
63              
64 3 50       52 if (/^-?callback$/i) {
    50          
    50          
    50          
    50          
    50          
    50          
    100          
    50          
    100          
    50          
65 0         0 $this->callback($argv{$_});
66             } elsif (/^-?contextengineid/i) {
67 0         0 $this->context_engine_id($argv{$_});
68             } elsif (/^-?contextname/i) {
69 0         0 $this->context_name($argv{$_});
70             } elsif (/^-?debug$/i) {
71 0         0 $this->debug($argv{$_});
72             } elsif (/^-?leadingdot$/i) {
73 0         0 $this->leading_dot($argv{$_});
74             } elsif (/^-?maxmsgsize$/i) {
75 0         0 $this->max_msg_size($argv{$_});
76             } elsif (/^-?requestid$/i) {
77 0         0 $this->request_id($argv{$_});
78             } elsif (/^-?security$/i) {
79 1         8 $this->security($argv{$_});
80             } elsif (/^-?translate$/i) {
81 0         0 $this->{_translate} = $argv{$_};
82             } elsif (/^-?transport$/i) {
83 1         9 $this->transport($argv{$_});
84             } elsif (/^-?version$/i) {
85 1         17 $this->version($argv{$_});
86             } else {
87 0         0 $this->_error('The argument "%s" is unknown', $_);
88             }
89              
90 3 50       10 if (defined $this->{_error}) {
91 0 0       0 return wantarray ? (undef, $this->{_error}) : undef;
92             }
93              
94             }
95              
96 2 50       8 if (!defined $this->{_transport}) {
97 0         0 $this->_error('The Transport Domain object is not defined');
98 0 0       0 return wantarray ? (undef, $this->{_error}) : undef;
99             }
100              
101 2 100       12 return wantarray ? ($this, q{}) : $this;
102             }
103              
104             sub prepare_get_request
105             {
106 0     0 0 0 my ($this, $oids) = @_;
107              
108 0         0 $this->_error_clear();
109              
110 0         0 return $this->prepare_pdu(GET_REQUEST,
111             $this->_create_oid_null_pairs($oids));
112             }
113              
114             sub prepare_get_next_request
115             {
116 0     0 0 0 my ($this, $oids) = @_;
117              
118 0         0 $this->_error_clear();
119              
120 0         0 return $this->prepare_pdu(GET_NEXT_REQUEST,
121             $this->_create_oid_null_pairs($oids));
122             }
123              
124             sub prepare_get_response
125             {
126 0     0 0 0 my ($this, $trios) = @_;
127              
128 0         0 $this->_error_clear();
129              
130 0         0 return $this->prepare_pdu(GET_RESPONSE,
131             $this->_create_oid_value_pairs($trios));
132             }
133              
134             sub prepare_set_request
135             {
136 1     1 0 2 my ($this, $trios) = @_;
137              
138 1         10 $this->_error_clear();
139              
140 1         4 return $this->prepare_pdu(SET_REQUEST,
141             $this->_create_oid_value_pairs($trios));
142             }
143              
144             sub prepare_trap
145             {
146 0     0 0 0 my ($this, $enterprise, $addr, $generic, $specific, $time, $trios) = @_;
147              
148 0         0 $this->_error_clear();
149              
150 0 0       0 return $this->_error('Insufficient arguments for a Trap-PDU') if (@_ < 6);
151              
152             # enterprise
153              
154 0 0       0 if (!defined $enterprise) {
    0          
155              
156             # Use iso(1).org(3).dod(6).internet(1).private(4).enterprises(1)
157             # for the default enterprise.
158              
159 0         0 $this->{_enterprise} = '1.3.6.1.4.1';
160              
161             } elsif ($enterprise !~ m/^\.?\d+(?:\.\d+)* *$/) {
162 0         0 return $this->_error(
163             'The enterprise OBJECT IDENTIFIER "%s" is expected in dotted ' .
164             'decimal notation', $enterprise
165             );
166             } else {
167 0         0 $this->{_enterprise} = $enterprise;
168             }
169              
170             # agent-addr
171              
172 0 0       0 if (!defined $addr) {
    0          
173              
174             # See if we can get the agent-addr from the Transport
175             # Layer. If not, we return an error.
176              
177 0 0       0 if (defined $this->{_transport}) {
178 0 0 0     0 if (($this->{_transport}->domain() ne DOMAIN_UDPIPV4) &&
179             ($this->{_transport}->domain() ne DOMAIN_TCPIPV4))
180             {
181 0         0 $this->{_agent_addr} = '0.0.0.0';
182             } else {
183 0         0 $this->{_agent_addr} = $this->{_transport}->agent_addr();
184 0 0       0 if ($this->{_agent_addr} eq '0.0.0.0') {
185 0         0 delete $this->{_agent_addr};
186             }
187             }
188             }
189 0 0       0 if (!exists $this->{_agent_addr}) {
190 0         0 return $this->_error('Unable to resolve the local agent-addr');
191             }
192              
193             } elsif ($addr !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) {
194 0         0 return $this->_error(
195             'The agent-addr "%s" is expected in dotted decimal notation', $addr
196             );
197             } else {
198 0         0 $this->{_agent_addr} = $addr;
199             }
200              
201             # generic-trap
202              
203 0 0       0 if (!defined $generic) {
    0          
204              
205             # Use enterpriseSpecific(6) for the generic-trap type.
206 0         0 $this->{_generic_trap} = ENTERPRISE_SPECIFIC;
207              
208             } elsif ($generic !~ /^\d+$/) {
209 0         0 return $this->_error(
210             'The generic-trap value "%s" is expected in positive numeric format',
211             $generic
212             );
213             } else {
214 0         0 $this->{_generic_trap} = $generic;
215             }
216              
217             # specific-trap
218              
219 0 0       0 if (!defined $specific) {
    0          
220 0         0 $this->{_specific_trap} = 0;
221             } elsif ($specific !~ /^\d+$/) {
222 0         0 return $this->_error(
223             'The specific-trap value "%s" is expected in positive numeric format',
224             $specific
225             );
226             } else {
227 0         0 $this->{_specific_trap} = $specific;
228             }
229              
230             # time-stamp
231              
232 0 0       0 if (!defined $time) {
    0          
233              
234             # Use the "uptime" of the script for the time-stamp.
235 0         0 $this->{_time_stamp} = ((time() - $^T) * 100);
236              
237             } elsif ($time !~ /^\d+$/) {
238 0         0 return $this->_error(
239             'The time-stamp value "%s" is expected in positive numeric format',
240             $time
241             );
242             } else {
243 0         0 $this->{_time_stamp} = $time;
244             }
245              
246 0         0 return $this->prepare_pdu(TRAP, $this->_create_oid_value_pairs($trios));
247             }
248              
249             sub prepare_get_bulk_request
250             {
251 0     0 0 0 my ($this, $repeaters, $repetitions, $oids) = @_;
252              
253 0         0 $this->_error_clear();
254              
255 0 0       0 if (@_ < 3) {
256 0         0 return $this->_error('Insufficient arguments for a GetBulkRequest-PDU');
257             }
258              
259             # non-repeaters
260              
261 0 0       0 if (!defined $repeaters) {
    0          
    0          
262 0         0 $this->{_error_status} = 0;
263             } elsif ($repeaters !~ /^\d+$/) {
264 0         0 return $this->_error(
265             'The non-repeaters value "%s" is expected in positive numeric format',
266             $repeaters
267             );
268             } elsif ($repeaters > 2147483647) {
269 0         0 return $this->_error(
270             'The non-repeaters value %s is out of range (0..2147483647)',
271             $repeaters
272             );
273             } else {
274 0         0 $this->{_error_status} = $repeaters;
275             }
276              
277             # max-repetitions
278              
279 0 0       0 if (!defined $repetitions) {
    0          
    0          
280 0         0 $this->{_error_index} = 0;
281             } elsif ($repetitions !~ /^\d+$/) {
282 0         0 return $this->_error(
283             'The max-repetitions value "%s" is expected in positive numeric ' .
284             'format', $repetitions
285             );
286             } elsif ($repetitions > 2147483647) {
287 0         0 return $this->_error(
288             'The max-repetitions value %s is out of range (0..2147483647)',
289             $repetitions
290             );
291             } else {
292 0         0 $this->{_error_index} = $repetitions;
293             }
294              
295             # Some sanity checks
296              
297 0 0 0     0 if (defined($oids) && (ref($oids) eq 'ARRAY')) {
298              
299 0 0       0 if ($this->{_error_status} > @{$oids}) {
  0         0  
300 0         0 return $this->_error(
301             'The non-repeaters value %d is greater than the number of ' .
302 0         0 'variable-bindings %d', $this->{_error_status}, scalar @{$oids}
303             );
304             }
305              
306 0 0 0     0 if (($this->{_error_status} == @{$oids}) && ($this->{_error_index})) {
  0         0  
307 0         0 return $this->_error(
308             'The non-repeaters value %d equals the number of variable-' .
309             'bindings and max-repetitions is not equal to zero',
310             $this->{_error_status}
311             );
312             }
313             }
314              
315 0         0 return $this->prepare_pdu(GET_BULK_REQUEST,
316             $this->_create_oid_null_pairs($oids));
317             }
318              
319             sub prepare_inform_request
320             {
321 0     0 0 0 my ($this, $trios) = @_;
322              
323 0         0 $this->_error_clear();
324              
325 0         0 return $this->prepare_pdu(INFORM_REQUEST,
326             $this->_create_oid_value_pairs($trios));
327             }
328              
329             sub prepare_snmpv2_trap
330             {
331 0     0 0 0 my ($this, $trios) = @_;
332              
333 0         0 $this->_error_clear();
334              
335 0         0 return $this->prepare_pdu(SNMPV2_TRAP,
336             $this->_create_oid_value_pairs($trios));
337             }
338              
339             sub prepare_report
340             {
341 0     0 0 0 my ($this, $trios) = @_;
342              
343 0         0 $this->_error_clear();
344              
345 0         0 return $this->prepare_pdu(REPORT, $this->_create_oid_value_pairs($trios));
346             }
347              
348             sub prepare_pdu
349             {
350 1     1 0 12 my ($this, $type, $var_bind) = @_;
351              
352             # Clear the buffer
353 1         7 $this->clear();
354              
355             # Clear the "scoped" indication
356 1         4 $this->{_scoped} = FALSE;
357              
358             # VarBindList::=SEQUENCE OF VarBind
359 1 50 50     7 if (!defined $this->_prepare_var_bind_list($var_bind || [])) {
360 0         0 return $this->_error();
361             }
362              
363             # PDU::=SEQUENCE
364 1 50       5 if (!defined $this->_prepare_pdu_sequence($type)) {
365 0         0 return $this->_error();
366             }
367              
368 1         3 return TRUE;
369             }
370              
371             sub prepare_var_bind_list
372             {
373 0     0 0 0 my ($this, $var_bind) = @_;
374              
375 0   0     0 return $this->_prepare_var_bind_list($var_bind || []);
376             }
377              
378             sub prepare_pdu_sequence
379             {
380 0     0 0 0 goto &_prepare_pdu_sequence;
381             }
382              
383             sub prepare_pdu_scope
384             {
385 0     0 0 0 goto &_prepare_pdu_scope;
386             }
387              
388             sub process_pdu
389             {
390 0     0 0 0 my ($this) = @_;
391              
392             # Clear any errors
393 0         0 $this->_error_clear();
394              
395             # PDU::=SEQUENCE
396 0 0       0 return $this->_error() if !defined $this->_process_pdu_sequence();
397              
398             # VarBindList::=SEQUENCE OF VarBind
399 0         0 return $this->_process_var_bind_list();
400             }
401              
402             sub process_pdu_scope
403             {
404 0     0 0 0 goto &_process_pdu_scope;
405             }
406              
407             sub process_pdu_sequence
408             {
409 1     1 0 4 goto &_process_pdu_sequence;
410             }
411              
412             sub process_var_bind_list
413             {
414 0     0 0 0 goto &_process_var_bind_list;
415             }
416              
417             sub expect_response
418             {
419 1     1 0 2 my ($this) = @_;
420              
421 1 50 33     5 if (($this->{_pdu_type} == GET_RESPONSE) ||
      33        
      33        
422             ($this->{_pdu_type} == TRAP) ||
423             ($this->{_pdu_type} == SNMPV2_TRAP) ||
424             ($this->{_pdu_type} == REPORT))
425             {
426 0         0 return FALSE;
427             }
428              
429 1         3 return TRUE;
430             }
431              
432             sub pdu_type
433             {
434 2     2 0 8 return $_[0]->{_pdu_type};
435             }
436              
437             sub error_status
438             {
439 0     0 0 0 my ($this, $status) = @_;
440              
441             # error-status::=INTEGER { noError(0) .. inconsistentName(18) }
442              
443 0 0       0 if (@_ == 2) {
444 0 0       0 if (!defined $status) {
445 0         0 return $this->_error('The error-status value is not defined');
446             }
447 0 0 0     0 if (($status < 0) ||
    0          
448             ($status > (($this->version > SNMP_VERSION_1) ? 18 : 5)))
449             {
450 0 0       0 return $this->_error(
451             'The error-status %s is out of range (0..%d)',
452             $status, ($this->version > SNMP_VERSION_1) ? 18 : 5
453             );
454             }
455 0         0 $this->{_error_status} = $status;
456             }
457              
458 0   0     0 return $this->{_error_status} || 0; # noError(0)
459             }
460              
461             sub error_index
462             {
463 0     0 0 0 my ($this, $index) = @_;
464              
465             # error-index::=INTEGER (0..max-bindings)
466              
467 0 0       0 if (@_ == 2) {
468 0 0       0 if (!defined $index) {
469 0         0 return $this->_error('The error-index value is not defined');
470             }
471 0 0 0     0 if (($index < 0) || ($index > 2147483647)) {
472 0         0 return $this->_error(
473             'The error-index value %s is out of range (0.. 2147483647)',
474             $index
475             );
476             }
477 0         0 $this->{_error_index} = $index;
478             }
479              
480 0   0     0 return $this->{_error_index} || 0;
481             }
482              
483             sub non_repeaters
484             {
485             # non-repeaters::=INTEGER (0..max-bindings)
486              
487 0   0 0 0 0 return $_[0]->{_error_status} || 0;
488             }
489              
490             sub max_repetitions
491             {
492             # max-repetitions::=INTEGER (0..max-bindings)
493              
494 0   0 0 0 0 return $_[0]->{_error_index} || 0;
495             }
496              
497             sub enterprise
498             {
499 0     0 0 0 return $_[0]->{_enterprise};
500             }
501              
502             sub agent_addr
503             {
504 0     0 0 0 return $_[0]->{_agent_addr};
505             }
506              
507             sub generic_trap
508             {
509 0     0 0 0 return $_[0]->{_generic_trap};
510             }
511              
512             sub specific_trap
513             {
514 0     0 0 0 return $_[0]->{_specific_trap};
515             }
516              
517             sub time_stamp
518             {
519 0     0 0 0 return $_[0]->{_time_stamp};
520             }
521              
522             sub var_bind_list
523             {
524 0     0 0 0 my ($this, $vbl, $types) = @_;
525              
526 0 0       0 return if defined $this->{_error};
527              
528 0 0       0 if (@_ > 1) {
529              
530             # The VarBindList HASH is being updated from an external
531             # source. We need to update the VarBind names ARRAY to
532             # correspond to the new keys of the HASH. If the updated
533             # information is valid, we will use lexicographical ordering
534             # for the ARRAY entries since we do not have a PDU to use
535             # to determine the ordering. The ASN.1 types HASH is also
536             # updated here if a cooresponding HASH is passed. We double
537             # check the mapping by populating the hash with the keys of
538             # the VarBindList HASH.
539              
540 0 0 0     0 if (!defined($vbl) || (ref($vbl) ne 'HASH')) {
541              
542 0         0 $this->{_var_bind_list} = undef;
543 0         0 $this->{_var_bind_names} = [];
544 0         0 $this->{_var_bind_types} = undef;
545              
546             } else {
547              
548 0         0 $this->{_var_bind_list} = $vbl;
549              
550 0         0 @{$this->{_var_bind_names}} =
  0         0  
551 0         0 map { $_->[0] }
552 0         0 sort { $a->[1] cmp $b->[1] }
553             map
554             {
555 0         0 my $oid = $_;
556 0         0 $oid =~ s/^\.//;
557 0         0 $oid =~ s/ /\.0/g;
558 0         0 [$_, pack 'N*', split m/\./, $oid]
559 0         0 } keys %{$vbl};
560              
561 0 0 0     0 if (!defined($types) || (ref($types) ne 'HASH')) {
562 0         0 $types = {};
563             }
564              
565 0         0 for (keys %{$vbl}) {
  0         0  
566 0 0       0 $this->{_var_bind_types}->{$_} =
567             exists($types->{$_}) ? $types->{$_} : undef;
568             }
569              
570             }
571              
572             }
573              
574 0         0 return $this->{_var_bind_list};
575             }
576              
577             sub var_bind_names
578             {
579 0     0 0 0 my ($this) = @_;
580              
581 0 0 0     0 return [] if defined($this->{_error}) || !defined $this->{_var_bind_names};
582              
583 0         0 return $this->{_var_bind_names};
584             }
585              
586             sub var_bind_types
587             {
588 0     0 0 0 my ($this) = @_;
589              
590 0 0       0 return if defined $this->{_error};
591              
592 0         0 return $this->{_var_bind_types};
593             }
594              
595             sub scoped
596             {
597 0     0 0 0 return $_[0]->{_scoped};
598             }
599              
600             # [private methods] ----------------------------------------------------------
601              
602             sub _prepare_pdu_scope
603             {
604 0     0   0 my ($this) = @_;
605              
606 0 0 0     0 return TRUE if (($this->{_version} < SNMP_VERSION_3) || ($this->{_scoped}));
607              
608             # contextName::=OCTET STRING
609 0 0       0 if (!defined $this->prepare(OCTET_STRING, $this->context_name())) {
610 0         0 return $this->_error();
611             }
612              
613             # contextEngineID::=OCTET STRING
614 0 0       0 if (!defined $this->prepare(OCTET_STRING, $this->context_engine_id())) {
615 0         0 return $this->_error();
616             }
617              
618             # ScopedPDU::=SEQUENCE
619 0 0       0 if (!defined $this->prepare(SEQUENCE)) {
620 0         0 return $this->_error();
621             }
622              
623             # Indicate that this PDU has been scoped and return success.
624 0         0 return $this->{_scoped} = TRUE;
625             }
626              
627             sub _prepare_pdu_sequence
628             {
629 1     1   1 my ($this, $type) = @_;
630              
631             # Do not do anything if there has already been an error
632 1 50       4 return $this->_error() if defined $this->{_error};
633              
634             # Make sure the PDU type was passed
635 1 50       3 return $this->_error('The SNMP PDU type is not defined') if (@_ != 2);
636              
637             # Set the PDU type
638 1         4 $this->{_pdu_type} = $type;
639              
640             # Make sure the request-id has been set
641 1 50       4 if (!exists $this->{_request_id}) {
642 1         10 $this->{_request_id} = int rand 2147483648;
643             }
644              
645             # We need to encode everything in reverse order so the
646             # objects end up in the correct place.
647              
648 1 50       5 if ($this->{_pdu_type} != TRAP) { # PDU::=SEQUENCE
649              
650             # error-index/max-repetitions::=INTEGER
651 1 50       6 if (!defined $this->prepare(INTEGER, $this->{_error_index})) {
652 0         0 return $this->_error();
653             }
654              
655             # error-status/non-repeaters::=INTEGER
656 1 50       4 if (!defined $this->prepare(INTEGER, $this->{_error_status})) {
657 0         0 return $this->_error();
658             }
659              
660             # request-id::=INTEGER
661 1 50       4 if (!defined $this->prepare(INTEGER, $this->{_request_id})) {
662 0         0 return $this->_error();
663             }
664              
665             } else { # Trap-PDU::=IMPLICIT SEQUENCE
666              
667             # time-stamp::=TimeTicks
668 0 0       0 if (!defined $this->prepare(TIMETICKS, $this->{_time_stamp})) {
669 0         0 return $this->_error();
670             }
671              
672             # specific-trap::=INTEGER
673 0 0       0 if (!defined $this->prepare(INTEGER, $this->{_specific_trap})) {
674 0         0 return $this->_error();
675             }
676              
677             # generic-trap::=INTEGER
678 0 0       0 if (!defined $this->prepare(INTEGER, $this->{_generic_trap})) {
679 0         0 return $this->_error();
680             }
681              
682             # agent-addr::=NetworkAddress
683 0 0       0 if (!defined $this->prepare(IPADDRESS, $this->{_agent_addr})) {
684 0         0 return $this->_error();
685             }
686              
687             # enterprise::=OBJECT IDENTIFIER
688 0 0       0 if (!defined $this->prepare(OBJECT_IDENTIFIER, $this->{_enterprise})) {
689 0         0 return $this->_error();
690             }
691              
692             }
693              
694             # PDUs::=CHOICE
695 1 50       5 if (!defined $this->prepare($this->{_pdu_type})) {
696 0         0 return $this->_error();
697             }
698              
699 1         4 return TRUE;
700             }
701              
702             sub _prepare_var_bind_list
703             {
704 1     1   2 my ($this, $var_bind) = @_;
705              
706             # The passed array is expected to consist of groups of four values
707             # consisting of two sets of ASN.1 types and their values.
708              
709 1 50       2 if (@{$var_bind} % 4) {
  1         4  
710 0         0 $this->var_bind_list(undef);
711 0         0 return $this->_error(
712 0         0 'The VarBind list size of %d is not a factor of 4', scalar @{$var_bind}
713             );
714             }
715              
716             # Initialize the "var_bind_*" data.
717              
718 1         2 $this->{_var_bind_list} = {};
719 1         3 $this->{_var_bind_names} = [];
720 1         3 $this->{_var_bind_types} = {};
721              
722             # Use the object's buffer to build each VarBind SEQUENCE and then append
723             # it to a local buffer. The local buffer will then be used to create
724             # the VarBindList SEQUENCE.
725              
726 1         2 my ($buffer, $name_type, $name_value, $syntax_type, $syntax_value) = (q{});
727              
728 1         1 while (@{$var_bind}) {
  2         11  
729              
730             # Pull a quartet of ASN.1 types and values from the passed array.
731 1         4 ($name_type, $name_value, $syntax_type, $syntax_value) =
732 1         1 splice @{$var_bind}, 0, 4;
733              
734             # Reverse the order of the fields because prepare() does a prepend.
735              
736             # value::=ObjectSyntax
737 1 50       8 if (!defined $this->prepare($syntax_type, $syntax_value)) {
738 0         0 $this->var_bind_list(undef);
739 0         0 return $this->_error();
740             }
741              
742             # name::=ObjectName
743 1 50       5 if ($name_type != OBJECT_IDENTIFIER) {
744 0         0 $this->var_bind_list(undef);
745 0         0 return $this->_error(
746             'An ObjectName type of 0x%02x was expected, but 0x%02x was found',
747             OBJECT_IDENTIFIER, $name_type
748             );
749             }
750 1 50       4 if (!defined $this->prepare($name_type, $name_value)) {
751 0         0 $this->var_bind_list(undef);
752 0         0 return $this->_error();
753             }
754              
755             # VarBind::=SEQUENCE
756 1 50       7 if (!defined $this->prepare(SEQUENCE)) {
757 0         0 $this->var_bind_list(undef);
758 0         0 return $this->_error();
759             }
760              
761             # Append the VarBind to the local buffer and clear it.
762 1         5 $buffer .= $this->clear();
763              
764             # Populate the "var_bind_*" data so we can provide consistent
765             # output for the methods regardless of whether we are a request
766             # or a response PDU. Make sure the HASH key is unique if in
767             # case duplicate OBJECT IDENTIFIERs are provided.
768              
769 1         14 while (exists $this->{_var_bind_list}->{$name_value}) {
770 0         0 $name_value .= q{ }; # Pad with spaces
771             }
772              
773 1         4 $this->{_var_bind_list}->{$name_value} = $syntax_value;
774 1         3 $this->{_var_bind_types}->{$name_value} = $syntax_type;
775 1         1 push @{$this->{_var_bind_names}}, $name_value;
  1         4  
776              
777             }
778              
779             # VarBindList::=SEQUENCE OF VarBind
780 1 50       4 if (!defined $this->prepare(SEQUENCE, $buffer)) {
781 0         0 $this->var_bind_list(undef);
782 0         0 return $this->_error();
783             }
784              
785 1         5 return TRUE;
786             }
787              
788             sub _create_oid_null_pairs
789             {
790 0     0   0 my ($this, $oids) = @_;
791              
792 0 0       0 return [] if !defined $oids;
793              
794 0 0       0 if (ref($oids) ne 'ARRAY') {
795 0         0 return $this->_error(
796             'The OBJECT IDENTIFIER list is expected as an array reference'
797             );
798             }
799              
800 0         0 my $pairs = [];
801              
802 0         0 for (@{$oids}) {
  0         0  
803 0         0 push @{$pairs}, OBJECT_IDENTIFIER, $_, NULL, q{};
  0         0  
804             }
805              
806 0         0 return $pairs;
807             }
808              
809             sub _create_oid_value_pairs
810             {
811 1     1   2 my ($this, $trios) = @_;
812              
813 1 50       3 return [] if !defined $trios;
814              
815 1 50       5 if (ref($trios) ne 'ARRAY') {
816 0         0 return $this->_error('The trio list is expected as an array reference');
817             }
818              
819 1 50       1 if (@{$trios} % 3) {
  1         5  
820 0         0 return $this->_error(
821             'The [OBJECT IDENTIFIER, ASN.1 type, object value] trio is expected'
822             );
823             }
824              
825 1         2 my $pairs = [];
826              
827 1         3 for (my $i = 0; $i < $#{$trios}; $i += 3) {
  2         7  
828 1         2 push @{$pairs},
  1         6  
829             OBJECT_IDENTIFIER, $trios->[$i], $trios->[$i+1], $trios->[$i+2];
830             }
831              
832 1         5 return $pairs;
833             }
834              
835             sub _process_pdu_scope
836             {
837 0     0   0 my ($this) = @_;
838              
839 0 0       0 return TRUE if ($this->{_version} < SNMP_VERSION_3);
840              
841             # ScopedPDU::=SEQUENCE
842 0 0       0 return $this->_error() if !defined $this->process(SEQUENCE);
843              
844             # contextEngineID::=OCTET STRING
845 0 0       0 if (!defined $this->context_engine_id($this->process(OCTET_STRING))) {
846 0         0 return $this->_error();
847             }
848              
849             # contextName::=OCTET STRING
850 0 0       0 if (!defined $this->context_name($this->process(OCTET_STRING))) {
851 0         0 return $this->_error();
852             }
853              
854             # Indicate that this PDU is scoped and return success.
855 0         0 return $this->{_scoped} = TRUE;
856             }
857              
858             sub _process_pdu_sequence
859             {
860 1     1   2 my ($this) = @_;
861              
862             # PDUs::=CHOICE
863 1 50       7 if (!defined ($this->{_pdu_type} = $this->process())) {
864 0         0 return $this->_error();
865             }
866              
867 1 50       5 if ($this->{_pdu_type} != TRAP) { # PDU::=SEQUENCE
868              
869             # request-id::=INTEGER
870 1 50       3 if (!defined ($this->{_request_id} = $this->process(INTEGER))) {
871 0         0 return $this->_error();
872             }
873             # error-status::=INTEGER
874 1 50       4 if (!defined ($this->{_error_status} = $this->process(INTEGER))) {
875 0         0 return $this->_error();
876             }
877             # error-index::=INTEGER
878 1 50       3 if (!defined ($this->{_error_index} = $this->process(INTEGER))) {
879 0         0 return $this->_error();
880             }
881              
882             # Indicate that we have an SNMP error, but do not return an error.
883 1 50 33     4 if (($this->{_error_status}) && ($this->{_pdu_type} == GET_RESPONSE)) {
884 0         0 $this->_error(
885             'Received %s error-status at error-index %d',
886             _error_status_itoa($this->{_error_status}), $this->{_error_index}
887             );
888             }
889              
890             } else { # Trap-PDU::=IMPLICIT SEQUENCE
891              
892             # enterprise::=OBJECT IDENTIFIER
893 0 0       0 if (!defined ($this->{_enterprise} = $this->process(OBJECT_IDENTIFIER))) {
894 0         0 return $this->_error();
895             }
896             # agent-addr::=NetworkAddress
897 0 0       0 if (!defined ($this->{_agent_addr} = $this->process(IPADDRESS))) {
898 0         0 return $this->_error();
899             }
900             # generic-trap::=INTEGER
901 0 0       0 if (!defined ($this->{_generic_trap} = $this->process(INTEGER))) {
902 0         0 return $this->_error();
903             }
904             # specific-trap::=INTEGER
905 0 0       0 if (!defined ($this->{_specific_trap} = $this->process(INTEGER))) {
906 0         0 return $this->_error();
907             }
908             # time-stamp::=TimeTicks
909 0 0       0 if (!defined ($this->{_time_stamp} = $this->process(TIMETICKS))) {
910 0         0 return $this->_error();
911             }
912              
913             }
914              
915 1         4 return TRUE;
916             }
917              
918             sub _process_var_bind_list
919             {
920 0     0     my ($this) = @_;
921              
922 0           my $value;
923              
924             # VarBindList::=SEQUENCE
925 0 0         if (!defined($value = $this->process(SEQUENCE))) {
926 0           return $this->_error();
927             }
928              
929             # Using the length of the VarBindList SEQUENCE,
930             # calculate the end index.
931              
932 0           my $end = $this->index() + $value;
933              
934 0           $this->{_var_bind_list} = {};
935 0           $this->{_var_bind_names} = [];
936 0           $this->{_var_bind_types} = {};
937              
938 0           my ($oid, $type);
939              
940 0           while ($this->index() < $end) {
941              
942             # VarBind::=SEQUENCE
943 0 0         if (!defined $this->process(SEQUENCE)) {
944 0           return $this->_error();
945             }
946             # name::=ObjectName
947 0 0         if (!defined ($oid = $this->process(OBJECT_IDENTIFIER))) {
948 0           return $this->_error();
949             }
950             # value::=ObjectSyntax
951 0 0         if (!defined ($value = $this->process(undef, $type))) {
952 0           return $this->_error();
953             }
954              
955             # Create a hash consisting of the OBJECT IDENTIFIER as a
956             # key and the ObjectSyntax as the value. If there is a
957             # duplicate OBJECT IDENTIFIER in the VarBindList, we pad
958             # that OBJECT IDENTIFIER with spaces to make a unique
959             # key in the hash.
960              
961 0           while (exists $this->{_var_bind_list}->{$oid}) {
962 0           $oid .= q{ }; # Pad with spaces
963             }
964              
965 0           DEBUG_INFO('{ %s => %s: %s }', $oid, asn1_itoa($type), $value);
966 0           $this->{_var_bind_list}->{$oid} = $value;
967 0           $this->{_var_bind_types}->{$oid} = $type;
968              
969             # Create an array with the ObjectName OBJECT IDENTIFIERs
970             # so that the order in which the VarBinds where encoded
971             # in the PDU can be retrieved later.
972              
973 0           push @{$this->{_var_bind_names}}, $oid;
  0            
974              
975             }
976              
977             # Return an error based on the contents of the VarBindList
978             # if we received a Report-PDU.
979              
980 0 0         if ($this->{_pdu_type} == REPORT) {
981 0           return $this->_report_pdu_error();
982             }
983              
984             # Return the var_bind_list hash
985 0           return $this->{_var_bind_list};
986             }
987              
988             {
989             my @error_status = qw(
990             noError
991             tooBig
992             noSuchName
993             badValue
994             readOnly
995             genError
996             noAccess
997             wrongType
998             wrongLength
999             wrongEncoding
1000             wrongValue
1001             noCreation
1002             inconsistentValue
1003             resourceUnavailable
1004             commitFailed
1005             undoFailed
1006             authorizationError
1007             notWritable
1008             inconsistentName
1009             );
1010              
1011             sub _error_status_itoa
1012             {
1013 0 0   0     return '??' if (@_ != 1);
1014              
1015 0 0 0       if (($_[0] > $#error_status) || ($_[0] < 0)) {
1016 0           return sprintf '??(%d)', $_[0];
1017             }
1018              
1019 0           return sprintf '%s(%d)', $error_status[$_[0]], $_[0];
1020             }
1021             }
1022              
1023             {
1024             my %report_oids = (
1025             '1.3.6.1.6.3.11.2.1.1' => 'snmpUnknownSecurityModels',
1026             '1.3.6.1.6.3.11.2.1.2' => 'snmpInvalidMsgs',
1027             '1.3.6.1.6.3.11.2.1.3' => 'snmpUnknownPDUHandlers',
1028             '1.3.6.1.6.3.12.1.4' => 'snmpUnavailableContexts',
1029             '1.3.6.1.6.3.12.1.5' => 'snmpUnknownContexts',
1030             '1.3.6.1.6.3.15.1.1.1' => 'usmStatsUnsupportedSecLevels',
1031             '1.3.6.1.6.3.15.1.1.2' => 'usmStatsNotInTimeWindows',
1032             '1.3.6.1.6.3.15.1.1.3' => 'usmStatsUnknownUserNames',
1033             '1.3.6.1.6.3.15.1.1.4' => 'usmStatsUnknownEngineIDs',
1034             '1.3.6.1.6.3.15.1.1.5' => 'usmStatsWrongDigests',
1035             '1.3.6.1.6.3.15.1.1.6' => 'usmStatsDecryptionErrors',
1036             );
1037              
1038             sub _report_pdu_error
1039             {
1040 0     0     my ($this) = @_;
1041              
1042             # Remove the leading dot (if present) and replace the dotted notation
1043             # of the OBJECT IDENTIFIER with the text ObjectName based upon an
1044             # expected list of report OBJECT IDENTIFIERs.
1045              
1046 0           my %var_bind_list;
1047              
1048 0           for my $oid (@{$this->{_var_bind_names}}) {
  0            
1049 0           my $text = $oid;
1050 0           $text =~ s/^\.//;
1051 0           for (keys %report_oids) {
1052 0 0         if ($text =~ s/\Q$_/$report_oids{$_}/) {
1053 0           last;
1054             }
1055             }
1056 0           $var_bind_list{$text} = $this->{_var_bind_list}->{$oid};
1057             }
1058              
1059 0           my $count = keys %var_bind_list;
1060              
1061 0 0         if ($count == 1) {
    0          
1062             # Return the OBJECT IDENTIFIER and value.
1063 0           my $text = (keys %var_bind_list)[0];
1064 0           return $this->_error(
1065             'Received %s Report-PDU with value %s', $text, $var_bind_list{$text}
1066             );
1067             } elsif ($count > 1) {
1068             # Return a list of OBJECT IDENTIFIERs.
1069 0           return $this->_error(
1070             'Received Report-PDU [%s]', join ', ', keys %var_bind_list
1071             );
1072             } else {
1073 0           return $this->_error('Received empty Report-PDU');
1074             }
1075              
1076             }
1077             }
1078              
1079             # ============================================================================
1080             1; # [end Net::SNMP::PDU]