File Coverage

blib/lib/Net/TacacsPlus/Packet/AuthenStartBody.pm
Criterion Covered Total %
statement 38 41 92.6
branch 12 12 100.0
condition n/a
subroutine 9 9 100.0
pod 3 3 100.0
total 62 65 95.3


line stmt bran cond sub pod time code
1             package Net::TacacsPlus::Packet::AuthenStartBody;
2              
3             =head1 NAME
4              
5             Net::TacacsPlus::Packet::AuthenStartBody - Tacacs+ authentication packet body
6              
7             =head1 DESCRIPTION
8              
9             The authentication START packet body
10              
11             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
12              
13             +----------------+----------------+----------------+----------------+
14             | action | priv_lvl | authen_type | service |
15             +----------------+----------------+----------------+----------------+
16             | user len | port len | rem_addr len | data len |
17             +----------------+----------------+----------------+----------------+
18             | user ...
19             +----------------+----------------+----------------+----------------+
20             | port ...
21             +----------------+----------------+----------------+----------------+
22             | rem_addr ...
23             +----------------+----------------+----------------+----------------+
24             | data...
25             +----------------+----------------+----------------+----------------+
26              
27             =cut
28              
29              
30             our $VERSION = '1.10_01';
31              
32 10     10   46 use strict;
  10         14  
  10         1617  
33 10     10   48 use warnings;
  10         10  
  10         227  
34              
35 10     10   160 use 5.006;
  10         35  
  10         358  
36 10     10   50 use Net::TacacsPlus::Constants 1.03;
  10         142  
  10         53  
37 10     10   56 use Carp::Clan;
  10         13  
  10         54  
38              
39 10     10   1467 use base qw{ Class::Accessor::Fast };
  10         14  
  10         4547  
40              
41             __PACKAGE__->mk_accessors(qw{
42             action
43             priv_lvl
44             authen_type
45             service
46             user
47             data
48             port
49             rem_addr
50             });
51              
52             =head1 METHODS
53              
54             =over 4
55              
56             =item new( somekey => somevalue)
57              
58             Construct tacacs+ authentication START packet body object
59              
60             Parameters:
61              
62             action : TAC_PLUS_AUTHEN_[^_]+$
63             priv_lvl : TAC_PLUS_PRIV_LVL_* - default TAC_PLUS_PRIV_LVL_MIN
64             authen_type : TAC_PLUS_AUTHEN_TYPE_*
65             service : TAC_PLUS_AUTHEN_SVC_* - default TAC_PLUS_AUTHEN_SVC_LOGIN
66             user : username
67             data : data - default ''
68             port : port - default 'Virtual00'
69             rem_addr : our ip address - default '127.0.0.1'
70              
71             =cut
72              
73             sub new {
74 3     3 1 456 my $class = shift;
75 3         13 my %params = @_;
76              
77             #let the class accessor contruct the object
78 3         21 my $self = $class->SUPER::new(\%params);
79              
80 3 100       37 if ($params{'raw_body'}) {
81 1         10 $self->decode($params{'raw_body'});
82 1         2 delete $self->{'raw_body'};
83 1         3 return $self;
84             }
85              
86 2 100       11 $self->priv_lvl(TAC_PLUS_PRIV_LVL_MIN) if not defined $self->priv_lvl();
87 2 100       31 $self->service(TAC_PLUS_AUTHEN_SVC_LOGIN) if not defined $self->service();
88 2 100       19 $self->data('') if not defined $self->data();
89 2 100       15 $self->port('Virtual00') if not defined $self->port();
90 2 100       15 $self->rem_addr('127.0.0.1') if not defined $self->rem_addr();
91              
92 2         19 return $self;
93             }
94              
95              
96             =item decode($raw_data)
97              
98             Construct object from raw packet.
99              
100             =cut
101              
102             sub decode {
103 1     1 1 2 my ($self, $raw_data) = @_;
104            
105 1         1 my $length_user;
106             my $length_port;
107 0         0 my $length_rem_addr;
108 0         0 my $length_data;
109 0         0 my $payload;
110            
111             (
112 1         9 $self->{'action'},
113             $self->{'priv_lvl'},
114             $self->{'authen_type'},
115             $self->{'service'},
116             $length_user,
117             $length_port,
118             $length_rem_addr,
119             $length_data,
120             $payload,
121             ) = unpack("C8a*", $raw_data);
122              
123             (
124 1         12 $self->{'user'},
125             $self->{'port'},
126             $self->{'rem_addr'},
127             $self->{'data'},
128             ) = unpack(
129             "a".$length_user
130             ."a".$length_port
131             ."a".$length_rem_addr
132             ."a".$length_data
133             ,
134             $payload
135             );
136             }
137              
138              
139             =item raw()
140              
141             Return binary data of packet body.
142              
143             =cut
144              
145             sub raw {
146 1     1 1 1468 my $self = shift;
147              
148 1         13 my $body = pack("C8a*a*a*a*",
149             $self->{'action'},
150             $self->{'priv_lvl'},
151             $self->{'authen_type'},
152             $self->{'service'},
153             length($self->{'user'}),
154             length($self->{'port'}),
155             length($self->{'rem_addr'}),
156             length($self->{'data'}),
157             $self->{'user'},
158             $self->{'port'},
159             $self->{'rem_addr'},
160             $self->{'data'},
161             );
162              
163 1         2 return $body;
164             }
165              
166             1;
167              
168             =back
169              
170             =cut