File Coverage

blib/lib/Net/TacacsPlus/Packet/Header.pm
Criterion Covered Total %
statement 28 35 80.0
branch 6 12 50.0
condition n/a
subroutine 7 9 77.7
pod 3 3 100.0
total 44 59 74.5


line stmt bran cond sub pod time code
1             package Net::TacacsPlus::Packet::Header;
2              
3             =head1 NAME
4              
5             Net::TacacsPlus::Packet::Header - Tacacs+ packet header
6              
7             =head1 DESCRIPTION
8              
9             3. The TACACS+ packet header
10              
11             All TACACS+ packets always begin with the following 12 byte header.
12             The header is always cleartext and describes the remainder of the
13             packet:
14              
15              
16             1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8
17            
18             +----------------+----------------+----------------+----------------+
19             |major | minor | | | |
20             |version| version| type | seq_no | flags |
21             +----------------+----------------+----------------+----------------+
22             | |
23             | session_id |
24             +----------------+----------------+----------------+----------------+
25             | |
26             | length |
27             +----------------+----------------+----------------+----------------+
28              
29             =cut
30              
31             our $VERSION = '1.10';
32              
33 10     10   55 use strict;
  10         20  
  10         382  
34 10     10   54 use warnings;
  10         17  
  10         308  
35              
36 10     10   189 use 5.006;
  10         34  
  10         415  
37 10     10   52 use Net::TacacsPlus::Constants 1.03;
  10         161  
  10         64  
38 10     10   15002 use Carp::Clan;
  10         64809  
  10         88  
39              
40 10     10   1909 use base qw{ Class::Accessor::Fast };
  10         24  
  10         11587  
41              
42             __PACKAGE__->mk_accessors(qw{
43             version
44             type
45             seq_no
46             flags
47             session_id
48             length
49             });
50              
51             =head1 METHODS
52              
53             =over 4
54              
55             =item new( somekey => somevalue)
56              
57             Construct tacacs+ packet header object
58              
59             1. if constructing from parameters:
60              
61             'version': protocol version
62             'type': TAC_PLUS_(AUTHEN|AUTHOR|ACCT)
63             'seq_no': sequencenumber - default 1
64             'flags': TAC_PLUS_(UNENCRYPTED_FLAG|SINGLE_CONNECT_FLAG) - default none
65             'session_id': session id
66              
67             2. if constructing from raw packet
68              
69             'raw_header': raw packet
70              
71             =cut
72              
73             sub new {
74 1     1 1 3 my $class = shift;
75 1         6 my %params = @_;
76            
77             #let the class accessor contruct the object
78 1         9 my $self = $class->SUPER::new(\%params);
79              
80             #build header from binary data
81 1 50       22 if ($params{'raw_header'}) {
82 0         0 $self->decode($params{'raw_header'});
83 0         0 delete $self->{'raw_header'};
84 0         0 return $self;
85             }
86              
87             #parameters check and default values
88 1 50       6 carp("session_id must be set!") if not defined $self->session_id;
89 1 50       22 carp("version must be set!") if not defined $self->version;
90 1 50       10 carp("type must be set!") if not defined $self->type;
91 1 50       11 $self->seq_no(1) if not defined $self->seq_no();
92 1 50       9 $self->flags(0) if not defined $self->flags();
93              
94 1         14 return $self;
95             }
96              
97             =item decode($raw_data)
98              
99             Decode $raw_data to version, type, seq_no, flags, session_id, length
100              
101             =cut
102              
103             sub decode {
104 0     0 1   my ($self, $raw_data) = @_;
105            
106 0           ( $self->{'version'}, #i dont't use object calls ->xyz() to improve speed a little bit and he it is not really neccesary
107             $self->{'type'},
108             $self->{'seq_no'},
109             $self->{'flags'},
110             $self->{'session_id'},
111             $self->{'length'} ) = unpack("CCCCNN", $raw_data);
112            
113             }
114              
115             =item raw()
116              
117             returns raw binary representation of header.
118              
119             B For complete binary header, length of body must be
120             added.
121              
122             =cut
123              
124             sub raw {
125 0     0 1   my $self = shift;
126              
127 0           return pack("CCCCN", #i dont't use object calls ->xyz() to improve speed a little bit and he it is not really neccesary
128             $self->{'version'},
129             $self->{'type'},
130             $self->{'seq_no'},
131             $self->{'flags'},
132             $self->{'session_id'},
133             );
134             }
135              
136             =back
137              
138             =cut
139              
140             1;