1package Gantry::Control::C::Access;
2
3use strict;
4
5use constant MP2 => (
6    exists $ENV{MOD_PERL_API_VERSION} and
7    $ENV{MOD_PERL_API_VERSION} >= 2
8);
9
10# must explicitly import for mod_perl2
11BEGIN {
12    if (MP2) {
13        require Gantry::Engine::MP20;
14        Gantry::Engine::MP20->import();
15    }
16}
17
18############################################################
19# Functions                                                #
20############################################################
21
22######################################################################
23# Main Execution Begins Here                                         #
24######################################################################
25sub handler : method {
26    my( $self, $r ) = @_;
27
28    my $remote_ip = $self->remote_ip( $r );
29
30    # Range, or specfic ips.
31    my $ranges  = $r->dir_config( 'AuthAllowRanges' );
32
33    if ( defined $r->dir_config( 'auth_allow_ranges' ) ) {
34        $ranges = $r->dir_config( 'auth_allow_ranges' );
35    }
36
37    my $ips = $r->dir_config( 'AuthAllowIps' );
38
39    if ( defined $r->dir_config( 'auth_allow_ips' ) ) {
40        $ips = $r->dir_config( 'auth_allow_ips' );
41    }
42
43    my $ignore = $r->dir_config( 'AccessNoOverRide' );
44
45    if ( defined $r->dir_config( 'ignore_access_handler' ) ) {
46        if ( $r->dir_config( 'ignore_access_handler' ) =~/^y/i ) {
47            $ignore = 1;
48        }
49        elsif ( $r->dir_config( 'ignore_access_handler' ) =~ /^n/i ) {
50            $ignore = 0;
51        }
52    }
53
54    $ignore     = 0 if ( ! defined $ignore );
55
56    if ( defined $ranges ) {
57        # make the decimal version of the ip.
58
59        my @remote = split( '\.', $remote_ip );
60
61        my $dip = ip2bin( $remote[0] );
62        $dip    .= ip2bin( $remote[1] );
63        $dip    .= ip2bin( $remote[2] );
64        $dip    .= ip2bin( $remote[3] );
65
66        # This is broken in 5.05
67        #my $dip1 = sprintf( "%08b %08b %08b %08b", split( '\.', $remote_ip ));
68
69        for my $range ( split( ',', $ranges ) ) {
70            my ( $ranged, $slash ) = $range =~ /^(.*)\/(\d+)$/;
71
72            my @ranger  = split( '\.', $ranged );
73            my $drng    = ip2bin( $ranger[0] );
74            $drng       .= ip2bin( $ranger[1] );
75            $drng       .= ip2bin( $ranger[2] );
76            $drng       .= ip2bin( $ranger[3] );
77
78            # This is broken in 5.05
79            #my $drng = sprintf( "%08b%08b%08b%08b", split( '\.', $ranged ) );
80
81            if ( substr( $dip, 0, $slash) eq substr( $drng, 0, $slash ) ) {
82
83                if ( ! $r->user ) {
84                    $r->user( 'anoymous_ip_user' );
85                }
86
87                if ( ! $ignore ) {
88                    $r->set_handlers( PerlAuthenHandler => [
89                        sub{ $self->status_const( 'OK' ) }
90                    ] );
91                    $r->set_handlers( PerlAuthzHandler  => [
92                        sub{ $self->status_const( 'OK' ) } ] );
93                }
94
95                return( $self->status_const( 'OK' ) );
96            }
97        }
98    }
99
100    if ( defined $ips ) {
101        for my $ip ( split( ',', $ips ) ) {
102            if ( $ip =~ /^\s?$remote_ip\s?$/ ) {
103                if ( ! $r->user ) {
104                    $r->user( 'anoymous_ip_user' );
105                }
106
107                if ( ! $ignore ) {
108                    $r->set_handlers( PerlAuthenHandler => [
109                        sub{ $self->status_const( 'OK' ) }
110                    ] );
111                    $r->set_handlers( PerlAuthzHandler  => [
112                        sub{ $self->status_const( 'OK' ) } ] );
113                }
114
115                return( $self->status_const( 'OK' ) );
116            }
117        }
118    }
119
120    return( $self->status_const( 'DECLINED' ) );
121
122} # END handler
123
124#-------------------------------------------------
125# ip2bin( $ip )
126#-------------------------------------------------
127# dec 2 bin for the ip address.
128#-------------------------------------------------
129sub ip2bin {
130    my $dec = shift;
131
132    my $bin = unpack( "B32", pack( "N", $dec ) );
133    $bin    =~ s/^0+(?=\d)//;
134
135    if ( length( $bin ) < 8 ) {
136        return( '0' x ( 8 - length( $bin ) ) . $bin );
137    }
138    else {
139        return( $bin );
140    }
141} # END ip2bin
142
143#-------------------------------------------------
144# $self->import(  @options )
145#-------------------------------------------------
146sub import {
147    my ( $self, @options ) = @_;
148
149    my( $engine, $tplugin );
150
151    foreach (@options) {
152
153        # Import the proper engine
154        if (/^-Engine=(.*)$/) {
155            $engine = "Gantry::Engine::$1";
156            eval "use $engine";
157            if ( $@ ) {
158                die "unable to load engine $1 ($@)";
159            }
160        }
161
162    }
163
164} # end: import
165
166# EOF
1671;
168
169__END__
170
171=head1 NAME
172
173Gantry::Control::C::Access - Authentication by IP
174
175=head1 DESCRIPTION
176
177This is an Authentication module against an IP range.
178
179=head1 APACHE
180
181This is the minimum configuration to set up Authen on a location,
182it is probably more usefull with Authz on and the App based authz handlers
183turned on as well. The C<auth_allow_ranges> takes ranges of ip address in
184cidr notation comma seperated. The C<auth_allow_ips> takes single ip
185addresses seperated by commas. The C<auth_ignore_access_handler> allows
186the access not to over ride authen and authz if needed, set to 1 not
187to override do not set if you want the override to happen.
188
189  <Location / >
190
191    PerlSetVar  auth_allow_ranges  "192.168.1.0/24,192.168.2.0/24"
192    PerlSetVar  auth_allow_ips     "127.0.0.1"
193    PerlSetVar  auth_ignore_access_handler  1
194
195    AuthType Basic
196    AuthName "My Auth Location"
197
198    PerlAccessHandler   Gantry::Control::C::Access
199
200    require valid-user
201 </Location>
202
203=head1 DATABASE
204
205No database is specfically required for this module.
206
207=head1 METHODS
208
209=over 4
210
211=item handler
212
213The mod_perl access handler.
214
215=item ip2bin
216
217For internal use.
218
219=back
220
221=head1 SEE ALSO
222
223Gantry(3)
224
225=head1 LIMITATIONS
226
227It only checks against the IP addresses and users table and only
228provides yes/no access. For more granuality check out the Authz handlers
229to turn on as well.
230
231=head1 AUTHOR
232
233Tim Keefer <tkeefer@gmail.com>
234
235=head1 COPYRIGHT
236
237Copyright (C) 2005-6, Tim Keefer.
238
239This library is free software; you can redistribute it and/or modify
240it under the same terms as Perl itself, either Perl version 5.8.6 or,
241at your option, any later version of Perl 5 you may have available.
242
243=cut
244