File Coverage

blib/lib/Net/TacacsPlus/Client.pm
Criterion Covered Total %
statement 46 181 25.4
branch 3 88 3.4
condition 0 12 0.0
subroutine 15 21 71.4
pod 8 8 100.0
total 72 310 23.2


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Net::TacacsPlus::Client - Tacacs+ client library
4              
5             =head1 SYNOPSIS
6              
7             use Net::TacacsPlus::Client;
8             use Net::TacacsPlus::Constants;
9            
10             my $tac = new Net::TacacsPlus::Client(
11             host => 'localhost',
12             key => 'secret');
13            
14             if ($tac->authenticate($username, $password, TAC_PLUS_AUTHEN_TYPE_PAP)){
15             print "Authentication successful.\n";
16             } else {
17             print "Authentication failed: ".$tac->errmsg()."\n";
18             }
19              
20             my @args = ( 'service=shell', 'cmd=ping', 'cmd-arg=10.0.0.1' );
21             my @args_response;
22             if($tac->authorize($username, \@args, \@args_response))
23             {
24             print "Authorization successful.\n";
25             print "Arguments received from server:\n";
26             print join("\n", @args_response);
27             } else {
28             print "Authorization failed: " . $tac->errmsg() . "\n";
29             }
30              
31             @args = ( 'service=shell', 'cmd=ping', 'cmd-arg=10.0.0.1' );
32             if($tac->account($username, \@args))
33             {
34             print "Accounting successful.\n";
35             } else {
36             print "Accounting failed: " . $tac->errmsg() . "\n";
37             }
38              
39             =head1 DESCRIPTION
40              
41             Currently only PAP and ASCII authentication can be used agains Tacacs+ server.
42              
43             Tested agains Cisco ACS 3.3 and Cisco (ftp://ftp-eng.cisco.com/pub/tacacs/) tac-plus server.
44              
45             =cut
46              
47              
48             package Net::TacacsPlus::Client;
49              
50             our $VERSION = '1.10';
51              
52 2     2   48985 use strict;
  2         6  
  2         72  
53 2     2   13 use warnings;
  2         4  
  2         59  
54              
55 2     2   1869 use Carp::Clan;
  2         11507  
  2         18  
56 2     2   3201 use IO::Socket;
  2         59024  
  2         11  
57 2     2   1582 use Exporter;
  2         4  
  2         75  
58 2     2   63 use 5.006;
  2         8  
  2         93  
59 2     2   11 use Fcntl qw(:DEFAULT);
  2         4  
  2         1254  
60 2     2   2020 use POSIX qw( EINTR );
  2         18596  
  2         19  
61 2     2   2786 use English qw( -no_match_vars );
  2         6  
  2         23  
62              
63 2     2   3109 use Net::TacacsPlus::Constants 1.03;
  2         73  
  2         14  
64 2     2   1335 use Net::TacacsPlus::Packet 1.03;
  2         59  
  2         19  
65              
66 2     2   69 use base qw{ Class::Accessor::Fast };
  2         4  
  2         6263  
67              
68             __PACKAGE__->mk_accessors(qw{
69             timeout
70             port
71             host
72             key
73            
74             tacacsserver
75             session_id
76             seq_no
77             errmsg
78             server_msg
79             authen_method
80             authen_type
81             });
82              
83             our @EXPORT_OK = ('authenticate', 'authorize', 'account');
84              
85             my $DEFAULT_TIMEOUT = 15;
86             my $DEFAULT_PORT = 49;
87              
88             =head1 METHODS
89              
90             =over 4
91              
92             =item new( somekey => somevalue )
93              
94             required parameters: host, key
95              
96             host - tacacs server
97             key - ecryption secret
98              
99             optional parameters: timeout, port
100              
101             timeout - tcp timeout
102             port - tcp port
103              
104             =cut
105              
106             sub new {
107 2     2 1 19 my $class = shift;
108 2         11 my %params = @_;
109              
110             #let the class accessor contruct the object
111 2         33 my $self = $class->SUPER::new(\%params);
112            
113 2 50       38 $self->timeout($DEFAULT_TIMEOUT) if not defined $self->timeout;
114 2 50       53 $self->port($DEFAULT_PORT) if not defined $self->port;
115              
116 2         33 return $self;
117             }
118              
119             =item close()
120              
121             Close socket connection.
122              
123             =cut
124              
125             sub close {
126 2     2 1 6 my $self = shift;
127              
128 2 50       12 if ($self->tacacsserver) {
129 0 0       0 if (!close($self->tacacsserver)) { warn "Error closing IO socket!\n" };
  0         0  
130 0         0 $self->tacacsserver(undef);
131             }
132             }
133              
134             =item init_tacacs_session()
135              
136             Inititalize socket connection to tacacs server.
137              
138             =cut
139              
140             sub init_tacacs_session
141             {
142 0     0 1 0 my $self = shift;
143              
144 0         0 my $remote;
145 0         0 $remote = IO::Socket::INET->new(Proto => "tcp", PeerAddr => $self->host,
146             PeerPort => $self->port, Timeout => $self->timeout);
147 0 0       0 croak("unable to connect to " . $self->host . ":" . $self->port . "\n")
148             if not defined $remote;
149            
150 0         0 $self->tacacsserver($remote);
151 0         0 $self->tacacsserver->blocking(0); # should not block because we use select()
152 0         0 $self->session_id(int(rand(2 ** 32 - 1))); #2 ** 32 - 1
153 0         0 $self->seq_no(1);
154 0         0 $self->errmsg('');
155             }
156              
157             =item errmsg()
158              
159             Returns latest error message
160              
161             =item authenticate(username, password, authen_type)
162              
163             username - tacacs+ username
164             password - tacacs+ user password
165             authen_type - TAC_PLUS_AUTHEN_TYPE_ASCII | TAC_PLUS_AUTHEN_TYPE_PAP
166             rem_addr - remote client address (optional, default is 127.0.0.1)
167             port - remote client port (optional, default is Virtual00)
168             new_password - if set (other than undef) will trigger password change
169              
170             =cut
171              
172             sub authenticate {
173 0     0 1 0 my ($self,$username,$password,$authen_type,$rem_addr,$port,$new_password) = @_;
174              
175 0         0 my $status;
176 0         0 eval {
177             #init session. will die if unable to connect.
178 0         0 $self->init_tacacs_session(); # moved within eval
179              
180             #tacacs+ START packet
181 0         0 my $pkt;
182              
183 0 0       0 $rem_addr = '127.0.0.1' if !defined $rem_addr;
184 0 0       0 $port = 'Virtual00' if !defined $port;
185 0 0       0 if ($authen_type == TAC_PLUS_AUTHEN_TYPE_ASCII)
    0          
186             {
187 0 0       0 $pkt = Net::TacacsPlus::Packet->new(
188             #header
189             'type' => TAC_PLUS_AUTHEN,
190             'seq_no' => $self->seq_no,
191             'flags' => 0,
192             'session_id' => $self->session_id,
193             'authen_type' => $authen_type,
194             #start
195             'action' => (defined $new_password ? TAC_PLUS_AUTHEN_CHPASS : TAC_PLUS_AUTHEN_LOGIN),
196             'user' => $username,
197             'key' => $self->key,
198             'rem_addr' => $rem_addr,
199             'port' => $port,
200             );
201             } elsif ($authen_type == TAC_PLUS_AUTHEN_TYPE_PAP)
202             {
203 0         0 $pkt = Net::TacacsPlus::Packet->new(
204             #header
205             'type' => TAC_PLUS_AUTHEN,
206             'seq_no' => $self->seq_no,
207             'flags' => 0,
208             'session_id' => $self->session_id,
209             'authen_type' => $authen_type,
210             'minor_version' => 1,
211             #start
212             'action' => TAC_PLUS_AUTHEN_LOGIN,
213             'key' => $self->key,
214             'user' => $username,
215             'data' => $password,
216             'rem_addr' => $rem_addr,
217             'port' => $port,
218             );
219             } else {
220 0         0 croak ('unsupported "authen_type" '.$authen_type.'.');
221             }
222              
223 0         0 $pkt->send($self->tacacsserver);
224              
225             #loop through REPLY/CONTINUE packets
226 0   0     0 do {
227             #receive reply packet
228 0         0 my $reply = $self->recv_reply(TAC_PLUS_AUTHEN);
229              
230 0         0 Net::TacacsPlus::Packet->check_reply($pkt,$reply);
231 0         0 $self->seq_no($reply->seq_no()+1);
232            
233 0         0 $self->server_msg($reply->server_msg);
234              
235 0         0 $status=$reply->status();
236 0 0 0     0 if ($status == TAC_PLUS_AUTHEN_STATUS_GETUSER)
    0          
    0          
    0          
    0          
237             {
238 0         0 $pkt = Net::TacacsPlus::Packet->new(
239             #header
240             'type' => TAC_PLUS_AUTHEN,
241             'seq_no' => $self->seq_no,
242             'session_id' => $self->session_id,
243             #continue
244             'user_msg' => $username,
245             'data' => '',
246             'key' => $self->key,
247             );
248 0         0 $pkt->send($self->tacacsserver);
249             } elsif ($status == TAC_PLUS_AUTHEN_STATUS_GETDATA)
250             {
251 0         0 $pkt = Net::TacacsPlus::Packet->new(
252             #header
253             'type' => TAC_PLUS_AUTHEN,
254             'seq_no' => $self->seq_no,
255             'session_id' => $self->session_id,
256             #continue
257             'user_msg' => $password,
258             'data' => '',
259             'key' => $self->key,
260             );
261 0         0 $pkt->send($self->tacacsserver);
262             } elsif ($status == TAC_PLUS_AUTHEN_STATUS_GETPASS)
263             {
264 0 0       0 $pkt = Net::TacacsPlus::Packet->new(
265             #header
266             'type' => TAC_PLUS_AUTHEN,
267             'seq_no' => $self->seq_no,
268             'session_id' => $self->session_id,
269             #continue
270             'user_msg' => (defined $new_password ? $new_password : $password),
271             'data' => '',
272             'key' => $self->key,
273             );
274 0         0 $pkt->send($self->tacacsserver);
275             } elsif ($status == TAC_PLUS_AUTHEN_STATUS_ERROR)
276             {
277 0         0 croak('authen status - error');
278             } elsif (($status == TAC_PLUS_AUTHEN_STATUS_FAIL) || ($status == TAC_PLUS_AUTHEN_STATUS_PASS))
279             {
280             } else
281             {
282 0         0 die('unhandled status '.(0 + $status).' (wrong secret key?)'."\n");
283             }
284             } while (($status != TAC_PLUS_AUTHEN_STATUS_FAIL) && ($status != TAC_PLUS_AUTHEN_STATUS_PASS))
285             };
286 0 0       0 if ($EVAL_ERROR)
287             {
288 0         0 $self->errmsg($EVAL_ERROR);
289 0         0 $self->close();
290 0         0 return undef;
291             }
292            
293 0         0 $self->close();
294 0 0       0 return undef if $status == TAC_PLUS_AUTHEN_STATUS_FAIL;
295              
296 0         0 $self->authen_method(TAC_PLUS_AUTHEN_METH_TACACSPLUS); # used later for authorization
297 0         0 $self->authen_type($authen_type); # used later for authorization
298 0         0 return 1;
299             }
300              
301             =item authorize(username, args, args_response)
302              
303             username - tacacs+ username
304             args - tacacs+ authorization arguments
305             args_response - updated by tacacs+ authorization arguments returned by server (optional)
306             rem_addr - remote client address (optional, default is 127.0.0.1)
307             port - remote client port (optional, default is Virtual00)
308              
309              
310             =cut
311              
312             sub authorize
313             {
314 0     0 1 0 my ($self, $username, $args, $args_response, $rem_addr, $port) = @_;
315            
316 0 0       0 $args_response = [] if not defined $args_response;
317 0 0       0 croak 'pass array ref as args_response parameter' if ref $args_response ne 'ARRAY';
318              
319 0         0 my $status;
320 0         0 eval {
321 0         0 check_args($args);
322 0         0 $self->init_tacacs_session();
323              
324 0 0       0 $rem_addr = '127.0.0.1' if !defined $rem_addr;
325 0 0       0 $port = 'Virtual00' if !defined $port;
326             # tacacs+ authorization REQUEST packet
327 0         0 my $pkt = Net::TacacsPlus::Packet->new(
328             #header
329             'type' => TAC_PLUS_AUTHOR,
330             'seq_no' => $self->seq_no,
331             'flags' => 0,
332             'session_id' => $self->session_id,
333             #request
334             'authen_method' => $self->authen_method,
335             'authen_type' => $self->authen_type,
336             'user' => $username,
337             'args' => $args,
338             'key' => $self->key,
339             'rem_addr' => $rem_addr,
340             'port' => $port,
341             );
342            
343 0         0 $pkt->send($self->tacacsserver);
344            
345             #receive reply packet
346 0         0 my $reply = $self->recv_reply(TAC_PLUS_AUTHOR);
347              
348 0         0 Net::TacacsPlus::Packet->check_reply($pkt,$reply);
349 0         0 $self->seq_no($reply->seq_no()+1);
350              
351 0         0 $status = $reply->status();
352 0 0 0     0 if ($status == TAC_PLUS_AUTHOR_STATUS_ERROR)
    0          
    0          
353             {
354 0         0 croak('author status - error');
355             } elsif ($status == TAC_PLUS_AUTHOR_STATUS_PASS_ADD ||
356             $status == TAC_PLUS_AUTHOR_STATUS_PASS_REPL)
357             {
358 0         0 @{$args_response} = @{$reply->args()}; # make any arguments from server available to caller
  0         0  
  0         0  
359             } elsif ($status == TAC_PLUS_AUTHOR_STATUS_FAIL)
360             {
361             } else
362             {
363 0         0 croak('unhandled status '.(0 + $status).'');
364             }
365             };
366 0 0       0 if ($EVAL_ERROR)
367             {
368 0         0 $self->errmsg($EVAL_ERROR);
369 0         0 $self->close();
370 0         0 return undef;
371             }
372              
373 0         0 $self->close();
374 0 0       0 return undef if $status == TAC_PLUS_AUTHOR_STATUS_FAIL;
375 0         0 return $status;
376             }
377              
378             =item check_args([])
379              
380             Check if the arguments comply with RFC.
381              
382             =cut
383              
384             sub check_args
385             {
386 0     0 1 0 my $args = shift;
387 0         0 my @args = @{$args};
  0         0  
388 0         0 my %args;
389 0         0 foreach my $arg (@args)
390             {
391 0 0       0 if ($arg =~ /^([^=*]+)[=*](.*)$/)
392             {
393 0         0 $args{$1} = $2;
394             } else
395             {
396 0         0 croak("Invalid authorization argument syntax: $arg");
397             }
398             }
399 0 0       0 croak("Missing mandatory argument 'service'")
400             if (!$args{'service'});
401 0 0 0     0 croak("Must supply 'cmd' argument if service=shell is specified")
402             if($args{'service'} eq 'shell' and !exists($args{'cmd'}));
403             # TODO: more RFC checks
404             }
405            
406              
407             =item account(username, args)
408              
409             username - tacacs+ username
410             args - tacacs+ authorization arguments
411             flags - optional: tacacs+ accounting flags
412             default: TAC_PLUS_ACCT_FLAG_STOP
413             rem_addr - remote client address (optional, default is 127.0.0.1)
414             port - remote client port (optional, default is Virtual00)
415              
416             =cut
417              
418             sub account
419             {
420 0     0 1 0 my ($self,$username,$args,$flags,$rem_addr,$port) = @_;
421            
422 0         0 my $status;
423 0         0 eval {
424 0         0 $self->init_tacacs_session();
425              
426 0 0       0 $rem_addr = '127.0.0.1' if !defined $rem_addr;
427 0 0       0 $port = 'Virtual00' if !defined $port;
428             # tacacs+ accounting REQUEST packet
429 0         0 my $pkt = Net::TacacsPlus::Packet->new(
430             #header
431             'type' => TAC_PLUS_ACCT,
432             'seq_no' => $self->seq_no,
433             'flags' => 0,
434             'session_id' => $self->session_id,
435             #request
436             'acct_flags' => $flags,
437             'authen_method' => $self->authen_method,
438             'authen_type' => $self->authen_type,
439             'user' => $username,
440             'args' => $args,
441             'key' => $self->key,
442             'rem_addr' => $rem_addr,
443             'port' => $port,
444             );
445            
446 0         0 $pkt->send($self->tacacsserver);
447            
448             #receive reply packet
449 0         0 my $reply = $self->recv_reply(TAC_PLUS_ACCT);
450              
451 0         0 Net::TacacsPlus::Packet->check_reply($pkt,$reply);
452 0         0 $self->seq_no($reply->seq_no()+1);
453              
454 0         0 $status = $reply->status();
455 0 0       0 if ($status == TAC_PLUS_ACCT_STATUS_ERROR)
    0          
456             {
457 0         0 croak('account status - error');
458             } elsif ($status == TAC_PLUS_ACCT_STATUS_SUCCESS)
459             {
460             } else
461             {
462 0         0 croak('unhandled status '.(0 + $status).'');
463             }
464             };
465 0 0       0 if ($EVAL_ERROR)
466             {
467 0         0 $self->errmsg($EVAL_ERROR);
468 0         0 $self->close();
469 0         0 return undef;
470             }
471              
472 0         0 $self->close();
473 0 0       0 return undef if $status == TAC_PLUS_ACCT_STATUS_ERROR;
474 0         0 return $status;
475             }
476              
477             =item recv_reply(type)
478              
479             method for receiving TAC+ reply packet from the server.
480              
481             C is a L type.
482              
483             =cut
484              
485             sub recv_reply {
486 0     0 1 0 my ($self, $type) = @_;
487              
488 0         0 my $raw_reply = '';
489 0         0 my $reply = undef;
490 0         0 my $retry = 0;
491 0         0 while($retry <= 5) {
492 0         0 $retry++;
493 0         0 my $readset = '';
494 0         0 vec($readset, fileno($self->tacacsserver), 1) = 1;
495 0         0 my $nfound = select($readset, undef, undef, $self->timeout);
496 0 0       0 croak('reply read error: timeout') if $nfound == 0;
497 0 0       0 if($nfound == -1)
498             {
499 0 0       0 next if $! == EINTR;
500 0         0 croak("reply read error: $!");
501             }
502 0         0 my $buf;
503 0         0 my $nread = $self->tacacsserver->recv($buf, 1024);
504 0 0       0 if(!defined $nread)
505             {
506 0 0       0 next if $! == EINTR;
507 0         0 croak("reply read error: $!");
508             }
509 0         0 $raw_reply .= $buf;
510 0 0       0 if(length($raw_reply) >= TAC_PLUS_HEADER_SIZE)
511             {
512 0         0 my ($raw_header,$raw_body) = unpack("a".TAC_PLUS_HEADER_SIZE."a*",$raw_reply);
513 0         0 my $header = Net::TacacsPlus::Packet::Header->new('raw_header' => $raw_header);
514 0 0       0 if(length($raw_body) >= $header->length)
515             {
516 0         0 $reply = Net::TacacsPlus::Packet->new(
517             'type' => $type,
518             'raw' => $raw_reply,
519             'key' => $self->key,
520             );
521 0         0 last;
522             }
523             }
524             }
525 0 0       0 croak("reply read error: maximum retry count exceeded") if !defined $reply;
526 0         0 return $reply;
527             }
528              
529             sub DESTROY {
530 2     2   1974 my $self = shift;
531              
532 2         11 $self->close();
533             }
534              
535             1;
536              
537             =back
538              
539             =head1 AUTHOR
540              
541             Jozef Kutej - Ejkutej@cpan.orgE
542              
543             Authorization and Accounting contributed by Rubio Vaughan Erubio@passim.netE
544              
545             =head1 VERSION
546              
547             1.07
548              
549             =head1 SEE ALSO
550              
551             tac-rfc.1.78.txt, Net::TacacsPlus::Packet
552              
553             Complete client script C.
554              
555             =head1 TODO
556              
557             tacacs+ CHAP, ARAP, MSCHAP authentication
558              
559             =head1 COPYRIGHT AND LICENSE
560              
561             Copyright (C) 2006 by Jozef Kutej
562              
563             This library is free software; you can redistribute it and/or modify
564             it under the same terms as Perl itself, either Perl version 5.8.4 or,
565             at your option, any later version of Perl 5 you may have available.
566              
567             =cut
568