1#! /usr/bin/perl
2#
3#
4# $Id: Simple.pm 75 2009-08-12 22:08:28Z lem $
5
6package Net::Radius::Server::Set::Simple;
7
8use 5.008;
9use strict;
10use warnings;
11
12our $VERSION = do { sprintf "%0.3f", 1+(q$Revision: 75 $ =~ /\d+/g)[0]/1000 };
13
14use Net::Radius::Server::Base qw/:set/;
15use base qw/Net::Radius::Server::Set/;
16__PACKAGE__->mk_accessors(qw/auto attr code result vsattr/);
17
18sub set_auto
19{
20    my $self = shift;
21    my $r_data = shift;
22    return unless $self->auto;
23
24    my $req = $r_data->{request};
25    my $rep = $r_data->{response};
26
27    $self->log(4, "Copy autheticator and id");
28
29    $rep->set_authenticator($req->authenticator);
30    $rep->set_identifier($req->identifier);
31}
32
33sub set_attr
34{
35    my $self = shift;
36    my $r_data = shift;
37
38    my $rep = $r_data->{response};
39    foreach (@{$self->attr})
40    {
41	$self->log(4, "set_attr " . join(' ', @$_));
42	$rep->set_attr(@$_);
43    }
44}
45
46sub set_code
47{
48    my $self = shift;
49    my $r_data = shift;
50
51    my $rep = $r_data->{response};
52    my $code = $self->code;
53    $self->log(4, "set_code $code");
54    $rep->set_code($code);
55}
56
57sub set_vsattr
58{
59    my $self = shift;
60    my $r_data = shift;
61
62    my $rep = $r_data->{response};
63    foreach (@{$self->vsattr})
64    {
65	$self->log(4, "set_vsattr " . join(' ', @$_));
66	$rep->set_vsattr(@$_);
67    }
68}
69
7042;
71
72__END__
73
74=head1 NAME
75
76Net::Radius::Server::Set::Simple - Simple set methods for RADIUS requests
77
78=head1 SYNOPSIS
79
80  use Net::Radius::Server::Set::Simple;
81  use Net::Radius::Server::Base qw/:set/;
82
83
84  my $set = Net::Radius::Server::Set::Simple->new
85    ({
86      code => 'Access-Accept',
87      auto => 1,
88      result => NRS_SET_RESPOND,
89      vsattr => [
90        [ 'Cisco' => 'cisco-avpair' => 'foo=bar' ],
91        [ 'Cisco' => 'cisco-avpair' => 'baz=bad' ],
92      ],
93      attr => [
94        [ 'Framed-IP-Address' => '127.0.0.1' ],
95        [ 'Reply-Message' => "Welcome home!!!\r\n\r\n" ],
96      ]});
97  my $set_sub = $set->mk;
98
99=head1 DESCRIPTION
100
101C<Net::Radius::Server::Set::Simple> implements simple but effective
102packet set method factories for use in C<Net::Radius::Server> rules.
103
104See C<Net::Radius::Server::Set> for general usage guidelines. The
105relevant attributes that control the matching of RADIUS requests are:
106
107=over
108
109=item C<auto>
110
111When set to a true value, cause the identifier and authenticator from
112the RADIUS request to be copied into the response.
113
114=item C<attr>
115
116Takes a list-ref containing list-refs where the first item is the
117RADIUS attribute to set and the second item is the value to set in the
118attribute. This translates to calls to C<-E<gt>set_attr()> in
119C<Net::Radius::Packet>.
120
121=item C<code>
122
123Sets the RADIUS packet code of the response to the given value. See
124Net::Radius::Packet(3) for more information on atribute and type
125representation.
126
127This is a thin wrapper around C<Net::Radius::Packet-E<gt>set_code()>.
128
129=item C<result>
130
131The result of the invocation of this set method. See
132C<Net::Radius::Server::Set> for more information. The example shown in
133the synopsis would cause an inmediate return of the packet. Other set
134methods after the current one won't be called at all.
135
136=item C<vsattr>
137
138Just as C<attr>, but dealing with
139C<Net::Radius::Packet-E<gt>set_vsattr()> instead.
140
141=back
142
143=head2 EXPORT
144
145None by default.
146
147
148=head1 HISTORY
149
150  $Log$
151  Revision 1.4  2006/12/14 16:33:17  lem
152  Rules and methods will only report failures in log level 3 and
153  above. Level 4 report success and failure, for deeper debugging
154
155  Revision 1.3  2006/12/14 15:52:25  lem
156  Fix CVS tags
157
158
159=head1 SEE ALSO
160
161Perl(1), Net::Radius::Server(3), Net::Radius::Server::Set(3),
162Net::Radius::Packet(3).
163
164=head1 AUTHOR
165
166Luis E. Muñoz, E<lt>luismunoz@cpan.orgE<gt>
167
168=head1 COPYRIGHT AND LICENSE
169
170Copyright (C) 2006 by Luis E. Muñoz
171
172This library is free software; you can redistribute it and/or modify
173it under the same terms as Perl 5.8.6 itself.
174
175=cut
176
177
178