File Coverage

blib/lib/Net/TacacsPlus/Packet.pm
Criterion Covered Total %
statement 62 138 44.9
branch 7 50 14.0
condition n/a
subroutine 17 30 56.6
pod 15 15 100.0
total 101 233 43.3


line stmt bran cond sub pod time code
1             package Net::TacacsPlus::Packet;
2              
3             =head1 NAME
4              
5             Net::TacacsPlus::Packet - Tacacs+ packet object
6              
7             =head1 SYNOPSIS
8            
9             # construct authentication START packet
10            
11             $pkt = Net::TacacsPlus::Packet->new(
12             #header
13             'type' => TAC_PLUS_AUTHEN,
14             'seq_no' => 1,
15             'flags' => 0,
16             'session_id' => $session_id,
17             #start
18             'action' => TAC_PLUS_AUTHEN_LOGIN,
19             'authen_type' => TAC_PLUS_AUTHEN_TYPE_(ASCII|PAP),
20             'key' => $secret,
21             );
22            
23            
24             # construct authentication CONTINUE packet
25            
26             $pkt = Net::TacacsPlus::Packet->new(
27             #header
28             'type' => TAC_PLUS_AUTHEN,
29             'seq_no' => 3,
30             'session_id' => $session_id,
31             #continue
32             'user_msg' => $username,
33             'data' => '',
34             'key' => $secret,
35             );
36            
37             # construct authentication REPLY packet from received raw packet
38            
39             $reply = Net::TacacsPlus::Packet->new(
40             'type' => TAC_PLUS_AUTHEN,
41             'raw' => $raw_reply,
42             'key' => $secret,
43             );
44              
45             # construct authorization REQUEST packet
46              
47             $pkt = Net::TacacsPlus::Packet->new(
48             #header
49             'type' => TAC_PLUS_AUTHOR,
50             'seq_no' => 1,
51             'session_id' => $session_id,
52             #request
53             'user' => $username,
54             'args' => $args, # arrayref
55             'key' => $secret,
56             );
57              
58             # construct authorization RESPONSE packet from received raw packet
59              
60             $response = Net::TacacsPlus::Packet->new(
61             'type' => TAC_PLUS_AUTHOR,
62             'raw' => $raw_reply,
63             'key' => $secret,
64             );
65              
66             # construct accounting REQUEST packet
67              
68             $pkt = Net::TacacsPlus::Packet->new(
69             #header
70             'type' => TAC_PLUS_ACCT,
71             'seq_no' => 1,
72             'session_id' => $session_id,
73             #request
74             'acct_flags' => TAC_PLUS_ACCT_FLAG_*,
75             'user' => $username,
76             'args' => $args, # arrayref
77             'key' => $secret,
78             );
79              
80             # construct accounting REPLY packet from received raw packet
81              
82             $reply = Net::TacacsPlus::Packet->new(
83             'type' => TAC_PLUS_ACCT,
84             'raw' => $raw_reply,
85             'key' => $secret,
86             );
87              
88             =head1 DESCRIPTION
89              
90             Library to create and manipulate Tacacs+ packets. Object can be build
91             from parameters or from raw received packet.
92              
93             =head1 AUTHOR
94              
95             Jozef Kutej Ejkutej@cpan.orgE
96              
97             Authorization and Accounting contributed by Rubio Vaughan Erubio@passim.netE
98              
99             =head1 VERSION
100              
101             1.06
102              
103             =head1 SEE ALSO
104              
105             tac-rfc.1.78.txt, Net::TacacsPlus::Client
106              
107             =cut
108              
109              
110             our $VERSION = '1.10_01';
111              
112 10     10   224419 use strict;
  10         21  
  10         383  
113 10     10   54 use warnings;
  10         16  
  10         515  
114              
115 10     10   210 use 5.006;
  10         28  
  10         397  
116              
117 10     10   3490 use Net::TacacsPlus::Constants 1.03;
  10         235  
  10         58  
118 10     10   4915 use Net::TacacsPlus::Packet::Header;
  10         28  
  10         69  
119 10     10   5033 use Net::TacacsPlus::Packet::AccountReplyBody;
  10         22  
  10         62  
120 10     10   5398 use Net::TacacsPlus::Packet::AccountRequestBody;
  10         24  
  10         79  
121 10     10   4651 use Net::TacacsPlus::Packet::AuthenContinueBody;
  10         26  
  10         67  
122 10     10   4682 use Net::TacacsPlus::Packet::AuthenReplyBody;
  10         22  
  10         64  
123 10     10   4525 use Net::TacacsPlus::Packet::AuthenStartBody;
  10         23  
  10         59  
124 10     10   4551 use Net::TacacsPlus::Packet::AuthorRequestBody;
  10         23  
  10         63  
125 10     10   4480 use Net::TacacsPlus::Packet::AuthorResponseBody;
  10         24  
  10         62  
126              
127 10     10   297 use Carp::Clan;
  10         13  
  10         35  
128 10     10   1273 use Digest::MD5 ('md5');
  10         16  
  10         713  
129              
130 10     10   43 use base qw{ Class::Accessor::Fast };
  10         14  
  10         14546  
131              
132             __PACKAGE__->mk_accessors(qw{
133             header
134             body
135             key
136             action
137             });
138              
139             =head1 METHODS
140              
141             =over 4
142              
143             =item new( somekey => somevalue )
144              
145             1. if constructing from parameters need this parameters:
146              
147             for header:
148              
149             'type' : TAC_PLUS_(AUTHEN|AUTHOR|ACCT)
150             'seq_no' : sequencenumber
151             'flags' : TAC_PLUS_(UNENCRYPTED_FLAG|SINGLE_CONNECT_FLAG)
152             'session_id': session id
153              
154             for authentication START body:
155              
156             'action' : TAC_PLUS_AUTHEN_(LOGIN|CHPASS|SENDPASS|SENDAUTH)
157             'authen_type': TAC_PLUS_AUTHEN_TYPE_(ASCII|PAP)
158             'key' : encryption key
159              
160             for authentication CONTINUE body:
161             'user_msg': msg required by server
162             'data' : data required by server
163             'key' : encryption key
164              
165             for authorization REQUEST body:
166             'user': username
167             'args': authorization arguments
168             'key' : encryption key
169              
170             for accounting REQUEST body:
171             'acct_flags': TAC_PLUS_ACCT_FLAG_(MORE|START|STOP|WATCHDOG)
172             'user' : username
173             'args' : authorization arguments
174             'key' : encryption key
175              
176             2. if constructing from received raw packet
177              
178             for AUTHEN reply, AUTHOR response and ACCT reply:
179              
180             'type': TAC_PLUS_(AUTHEN|AUTHOR|ACCT)
181             'raw' : raw packet
182             'key' : encryption key
183              
184             =cut
185              
186             sub new {
187 1     1 1 15 my $class = shift;
188 1         7 my %params = @_;
189              
190             #let the class accessor contruct the object
191 1         12 my $self = $class->SUPER::new(\%params);
192              
193             #create object from raw packet
194 1 50       13 if ($params{'raw'}) {
195 0         0 $self->decode_raw($params{'raw'});
196 0         0 delete $self->{'raw'};
197 0         0 return $self;
198             }
199              
200             #compute version byte if needed
201 1 50       4 if (not exists $params{'version'}) {
202 1 50       5 $params{'major_version'} = $params{'major_version'} ? $params{'major_version'} : TAC_PLUS_MAJOR_VER;
203 1 50       5 $params{'minor_version'} = $params{'minor_version'} ? $params{'minor_version'} : TAC_PLUS_MINOR_VER_DEFAULT;
204 1         5 $params{'version'} = $params{'major_version'}*0x10+$params{'minor_version'};
205             }
206            
207             #construct the packet header
208 1         11 $self->header(Net::TacacsPlus::Packet::Header->new(%params));
209              
210 1         16 my $type = $self->type;
211 1 50       7 croak "TacacsPlus packet type is required parameter."
212             if (not defined $type);
213            
214              
215 1 50       3 if ($type == TAC_PLUS_AUTHEN)
    0          
    0          
216             {
217 1 50       3 if ($params{'action'}) #if action is set it is the first START packet
    0          
    0          
218             {
219 1         9 $self->body(Net::TacacsPlus::Packet::AuthenStartBody->new(%params));
220             } elsif ($params{'user_msg'}) #else it is CONTINUE
221             {
222 0         0 $self->body(Net::TacacsPlus::Packet::AuthenContinueBody->new(%params));
223             } elsif ($params{'status'}) #else it is REPLY
224             {
225 0         0 $self->body(Net::TacacsPlus::Packet::AuthenReplyBody->new(%params));
226 0         0 } else { die("unknown request for body creation"); }
227             } elsif ($type == TAC_PLUS_AUTHOR)
228             {
229 0         0 $self->body(Net::TacacsPlus::Packet::AuthorRequestBody->new(%params));
230             } elsif ($type == TAC_PLUS_ACCT)
231             {
232 0         0 $self->body(Net::TacacsPlus::Packet::AccountRequestBody->new(%params));
233             } else
234             {
235 0         0 croak('TacacsPlus packet type '.$self->type.' unsupported.');
236             }
237              
238 1         7 return $self;
239             }
240              
241             =item check_reply($snd, $rcv)
242              
243             compare send and reply packet for errors
244              
245             $snd - packet object that was send
246             $rcv - packet object that was received afterwards
247              
248             checks sequence number, session id, version and flags
249              
250             =cut
251              
252             sub check_reply {
253 0     0 1 0 my ($self, $snd, $rcv) = @_;
254            
255 0 0       0 if (($snd->seq_no() + 1) != ($rcv->seq_no())) { croak("seq_no mismash"); }
  0         0  
256 0 0       0 if (($snd->session_id()) != ($rcv->session_id())) { croak("session_id mismash"); }
  0         0  
257 0 0       0 if (($snd->version()) != ($rcv->version())) { croak("version mismash"); }
  0         0  
258 0 0       0 if (($snd->flags()) != ($rcv->flags())) { croak("flags mismash"); }
  0         0  
259             }
260              
261             =item decode_raw($raw_pkt)
262              
263             From raw packet received create reply object:
264             Net::TacacsPlus::Packet::AuthenReplyBody or
265             Net::TacacsPlus::Packet::AuthorResponseBody or
266             Net::TacacsPlus::Packet::AccountReplyBody
267              
268             =cut
269              
270             sub decode_raw {
271 0     0 1 0 my ($self, $raw_pkt) = @_;
272            
273 0         0 my ($raw_header,$raw_body) = unpack("a".TAC_PLUS_HEADER_SIZE."a*",$raw_pkt);
274            
275 0         0 $self->header(Net::TacacsPlus::Packet::Header->new('raw_header' => $raw_header));
276              
277 0         0 $raw_body = $self->raw_xor_body($raw_body);
278            
279             # even sequence numbers are received by the client
280 0 0       0 if ($self->seq_no % 2 == 0) {
281 0 0       0 if ($self->type == TAC_PLUS_AUTHEN)
    0          
    0          
282             {
283 0         0 $self->body(Net::TacacsPlus::Packet::AuthenReplyBody->new('raw_body' => $raw_body));
284             } elsif ($self->type == TAC_PLUS_AUTHOR)
285             {
286 0         0 $self->body(Net::TacacsPlus::Packet::AuthorResponseBody->new('raw_body' => $raw_body));
287             } elsif ($self->type == TAC_PLUS_ACCT)
288             {
289 0         0 $self->body(Net::TacacsPlus::Packet::AccountReplyBody->new('raw_body' => $raw_body));
290             } else
291             {
292 0         0 die('TacacsPlus packet type '.$self->type.' unsupported.');
293             }
294             }
295             # odd sequence numbers are received by the server
296             else {
297 0 0       0 if ($self->type == TAC_PLUS_AUTHEN)
    0          
    0          
298             {
299 0         0 $self->body(Net::TacacsPlus::Packet::AuthenStartBody->new('raw_body' => $raw_body));
300             } elsif ($self->type == TAC_PLUS_AUTHOR)
301             {
302 0         0 $self->body(Net::TacacsPlus::Packet::AuthorRequestBody->new('raw_body' => $raw_body));
303             } elsif ($self->type == TAC_PLUS_ACCT)
304             {
305 0         0 $self->body(Net::TacacsPlus::Packet::AccountRequestBody->new('raw_body' => $raw_body));
306             } else
307             {
308 0         0 die('TacacsPlus packet type '.$self->type.' unsupported.');
309             }
310             }
311             }
312              
313             =item raw( )
314              
315             return binary representation of whole packet.
316              
317             =cut
318              
319             sub raw {
320 0     0 1 0 my $self = shift;
321 0         0 my $key = shift;
322            
323 0         0 my $header=$self->header->raw();
324 0         0 my $body=$self->raw_xor_body($self->body->raw());
325 0         0 $header=$header.pack("N",length($body));
326              
327 0         0 return $header.$body;
328             }
329              
330             =item raw_xor_body($data)
331              
332             XOR $data by pseudo pas.
333              
334             =cut
335              
336             sub raw_xor_body {
337 0     0 1 0 my ($self,$data) = @_;
338              
339 0 0       0 return $data if not $self->key;
340              
341 0         0 my $pseudo_pad=compute_pseudo_pad(
342             $self->session_id(),
343             $self->key,
344             $self->version(),
345             $self->seq_no(),
346             length($data),
347             );
348            
349 0         0 $data=$data ^ $pseudo_pad;
350              
351 0         0 return $data;
352             }
353              
354             =item compute_pseudo_pad( $sess_id,$key,$version,$seq_no,$length )
355              
356             compute md5 hash from parameters truncated to $length
357              
358             pseudo_pad = {MD5_1 [,MD5_2 [ ... ,MD5_n]]} truncated to len(data)
359              
360             The first MD5 hash is generated by concatenating the session_id, the
361             secret key, the version number and the sequence number and then running
362             MD5 over that stream. All of those input values are available in the
363             packet header, except for the secret key which is a shared secret
364             between the TACACS+ client and daemon.
365              
366             =cut
367              
368             sub compute_pseudo_pad {
369 0     0 1 0 my ( $sess_id,$key,$version,$seq_no,$length ) = @_;
370              
371 0         0 my ( $data,$md5hash, $hash, $md5len );
372              
373 0         0 $data = pack("Na*CC",$sess_id,$key,$version,$seq_no);
374            
375 0         0 $md5len = 0;
376 0         0 $hash = '';
377 0         0 $md5hash = '';
378              
379 0         0 while ( $md5len < $length ) {
380 0         0 $md5hash = md5($data.$md5hash);
381 0         0 $hash .= $md5hash;
382 0         0 $md5len+=16;
383             }
384              
385 0         0 return substr ( $hash, 0, $length );
386              
387             }
388              
389             =item server_msg( )
390              
391             returns last server msg
392              
393             =cut
394              
395             sub server_msg() {
396 0     0 1 0 my $self = shift;
397            
398 0         0 return $self->body->server_msg(@_);
399             }
400              
401             =item seq_no()
402              
403             Return packet sequence number.
404              
405             =cut
406              
407             sub seq_no() {
408 0     0 1 0 my $self = shift;
409            
410 0         0 return $self->header->seq_no(@_);
411             }
412              
413             =item session_id()
414              
415             Return packet session id.
416              
417             =cut
418              
419             sub session_id() {
420 0     0 1 0 my $self = shift;
421            
422 0         0 return $self->header->session_id(@_);
423             }
424              
425             =item version()
426              
427             Return version from packet header
428              
429             =cut
430              
431             sub version() {
432 0     0 1 0 my $self = shift;
433            
434 0         0 return $self->header->version(@_);
435             }
436              
437             =item flags()
438              
439             Return flags from packet header.
440              
441             =cut
442              
443             sub flags() {
444 0     0 1 0 my $self = shift;
445            
446 0         0 return $self->header->flags(@_);
447             }
448              
449             =item args()
450              
451             Return arguments returned by server in authorization response packet.
452              
453             =cut
454              
455             sub args() {
456 0     0 1 0 my $self = shift;
457            
458 0 0       0 if($self->type == TAC_PLUS_AUTHOR)
459             {
460 0         0 return $self->body->args(@_);
461             } else
462             {
463 0         0 die("Arguments only available for authorization response packets")
464             }
465             }
466              
467             =item status( )
468              
469             returns status of packet. it is used in REPLY packets received from
470             server.
471              
472             status is one of:
473              
474             TAC_PLUS_AUTHEN_STATUS_PASS => 0x01,
475             TAC_PLUS_AUTHEN_STATUS_FAIL => 0x02,
476             TAC_PLUS_AUTHEN_STATUS_GETDATA => 0x03,
477             TAC_PLUS_AUTHEN_STATUS_GETUSER => 0x04,
478             TAC_PLUS_AUTHEN_STATUS_GETPASS => 0x05,
479             TAC_PLUS_AUTHEN_STATUS_RESTART => 0x06,
480             TAC_PLUS_AUTHEN_STATUS_ERROR => 0x07,
481             TAC_PLUS_AUTHEN_STATUS_FOLLOW => 0x21,
482             TAC_PLUS_AUTHOR_STATUS_PASS_ADD => 0x01,
483             TAC_PLUS_AUTHOR_STATUS_PASS_REPL => 0x02,
484             TAC_PLUS_AUTHOR_STATUS_FAIL => 0x10,
485             TAC_PLUS_AUTHOR_STATUS_ERROR => 0x11,
486             TAC_PLUS_AUTHOR_STATUS_FOLLOW => 0x21,
487             TAC_PLUS_ACCT_STATUS_SUCCESS => 0x01,
488             TAC_PLUS_ACCT_STATUS_ERROR => 0x02,
489             TAC_PLUS_ACCT_STATUS_FOLLOW => 0x21,
490              
491             =cut
492              
493             sub status() {
494 0     0 1 0 my $self = shift;
495            
496 0         0 return $self->body->status(@_);
497             }
498              
499             =item send()
500              
501             Send out packet.
502              
503             =cut
504              
505             sub send() {
506 0     0 1 0 my ($self, $remote) = @_;
507              
508 0         0 my $raw_pkt = $self->raw();
509            
510 0         0 my $bytes = $remote->send($raw_pkt);
511 0 0       0 croak("error sending packet!") if ($bytes != length($raw_pkt));
512            
513 0         0 return $bytes;
514             }
515              
516             =item type()
517              
518             Returns packet type taken from packet header eg. $self->header->type;
519              
520             =cut
521              
522             sub type {
523 1     1 1 2 my $self = shift;
524            
525 1         3 return $self->header->type(@_);
526             }
527              
528             1;
529              
530             =back
531              
532             =head1 COPYRIGHT AND LICENSE
533              
534             Copyright (C) 2006 by Jozef Kutej
535              
536             This library is free software; you can redistribute it and/or modify
537             it under the same terms as Perl itself, either Perl version 5.8.4 or,
538             at your option, any later version of Perl 5 you may have available.
539              
540             =cut