Imported Upstream version 0.02
This commit is contained in:
Mario Fetka
commit
187b1bcce8
|
|
@ -0,0 +1,98 @@
|
|||
#define PERL_NO_GET_CONTEXT /* we want efficiency */
|
||||
#include "EXTERN.h"
|
||||
#include "perl.h"
|
||||
#include "XSUB.h"
|
||||
|
||||
#include "ppport.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
static unsigned long parse_ip_and_mask (char *cip, unsigned long *ipm)
|
||||
{
|
||||
int i1, i2, i3, i4, m;
|
||||
unsigned long iip, mask;
|
||||
char *c;
|
||||
|
||||
i1 = i2 = i3 = i4 = m = 0;
|
||||
c = cip;
|
||||
|
||||
// skip leading non-numerics
|
||||
for ( ; *c && (*c < '0' || *c > '9'); c++)
|
||||
;
|
||||
// load first node
|
||||
for ( ; *c >= '0' && *c <= '9'; c++)
|
||||
i1 = i1 * 10 + (*c - '0');
|
||||
// skip non-numerics
|
||||
for ( ; *c && (*c < '0' || *c > '9'); c++)
|
||||
;
|
||||
// load second node
|
||||
for ( ; *c >= '0' && *c <= '9'; c++)
|
||||
i2 = i2 * 10 + (*c - '0');
|
||||
// skip non-numerics
|
||||
for ( ; *c && (*c < '0' || *c > '9'); c++)
|
||||
;
|
||||
// load third node
|
||||
for ( ; *c >= '0' && *c <= '9'; c++)
|
||||
i3 = i3 * 10 + (*c - '0');
|
||||
// skip non-numerics
|
||||
for ( ; *c && (*c < '0' || *c > '9'); c++)
|
||||
;
|
||||
// load forth node
|
||||
for ( ; *c >= '0' && *c <= '9'; c++)
|
||||
i4 = i4 * 10 + (*c - '0');
|
||||
// skip non-numerics
|
||||
for ( ; *c && (*c < '0' || *c > '9'); c++)
|
||||
;
|
||||
// load mask
|
||||
for ( ; *c >= '0' && *c <= '9'; c++)
|
||||
m = m * 10 + (*c - '0');
|
||||
|
||||
// build numeric ip address
|
||||
iip =
|
||||
(i1 << 24) |
|
||||
((i2 & 0xff) << 16) |
|
||||
((i3 & 0xff) << 8) |
|
||||
(i4 & 0xff);
|
||||
|
||||
// mask it
|
||||
mask = (m) ? 0xffffffff << ((32 - m) & 31) : 0xffffffff;
|
||||
iip &= mask;
|
||||
if (ipm)
|
||||
*ipm = mask;
|
||||
|
||||
return iip;
|
||||
}
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
MODULE = Net::IP::CMatch PACKAGE = Net::IP::CMatch
|
||||
|
||||
int
|
||||
match_ip (ip, ...)
|
||||
char *ip
|
||||
|
||||
PREINIT:
|
||||
int i;
|
||||
unsigned long iip, mip, mask;
|
||||
STRLEN n_a;
|
||||
|
||||
CODE:
|
||||
RETVAL = 0;
|
||||
iip = parse_ip_and_mask (ip, &mask);
|
||||
for (i = 1; i < items; i++) {
|
||||
mip = parse_ip_and_mask ((char *) SvPV (ST (i), n_a), &mask);
|
||||
if ((iip & mask) == mip) {
|
||||
RETVAL = 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
Revision history for Perl extension Net::IP::CMatch.
|
||||
|
||||
0.02 Tue Dec 21 06:33:43 2004
|
||||
- original version; created by h2xs 1.23 with options
|
||||
-A -b 5.6.1 Net::IP::CMatch
|
||||
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
Changes
|
||||
CMatch.xs
|
||||
Makefile.PL
|
||||
MANIFEST
|
||||
ppport.h
|
||||
README
|
||||
t/Net-IP-CMatch.t
|
||||
lib/Net/IP/CMatch.pm
|
||||
META.yml Module meta-data (added by MakeMaker)
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
# http://module-build.sourceforge.net/META-spec.html
|
||||
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
|
||||
name: Net-IP-CMatch
|
||||
version: 0.02
|
||||
version_from: lib/Net/IP/CMatch.pm
|
||||
installdirs: site
|
||||
requires:
|
||||
|
||||
distribution_type: module
|
||||
generated_by: ExtUtils::MakeMaker version 6.17
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
use 5.006001;
|
||||
use ExtUtils::MakeMaker;
|
||||
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
|
||||
# the contents of the Makefile that is written.
|
||||
WriteMakefile(
|
||||
NAME => 'Net::IP::CMatch',
|
||||
VERSION_FROM => 'lib/Net/IP/CMatch.pm', # finds $VERSION
|
||||
PREREQ_PM => {}, # e.g., Module::Name => 1.1
|
||||
($] >= 5.005 ? ## Add these new keywords supported since 5.005
|
||||
(ABSTRACT_FROM => 'lib/Net/IP/CMatch.pm', # retrieve abstract from module
|
||||
AUTHOR => 'Beau E. Cox <beaucox@hawaii.rr.com>') : ()),
|
||||
LIBS => [''], # e.g., '-lm'
|
||||
DEFINE => '', # e.g., '-DHAVE_SOMETHING'
|
||||
INC => '-I.', # e.g., '-I. -I/usr/include/other'
|
||||
# Un-comment this if you add C files to link with later:
|
||||
# OBJECT => '$(O_FILES)', # link all the C files too
|
||||
);
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
Net-IP-CMatch version 0.02
|
||||
==========================
|
||||
|
||||
NAME
|
||||
Net::IP::CMatch - Efficiently match IP addresses against IP ranges with
|
||||
C.
|
||||
|
||||
INSTALLATION
|
||||
To install this module type the following:
|
||||
|
||||
perl Makefile.PL
|
||||
make
|
||||
make test
|
||||
make install
|
||||
|
||||
DEPENDENCIES
|
||||
This module requires these other modules and libraries:
|
||||
|
||||
perl >= 5.6.1
|
||||
|
||||
SYNOPSIS
|
||||
use Net::IP::CMatch;
|
||||
my $match = match_ip( $ip_addr, $match_ip1, $match_ip2, ... );
|
||||
|
||||
DESCRIPTION
|
||||
Net::IP::CMatch is based upon, and does the same thing as
|
||||
Net::IP::Match. The unconditionally exported subroutine 'match_ip'
|
||||
determines if the ip to match ( first argument ) matches any of the
|
||||
subsequent ip arguments. Match arguments may be absolute quads, as
|
||||
'127.0.0.1', or contain mask bits as '111.245.76.248/29'. A true return
|
||||
value indicates a match. It was written in C, rather than a macro,
|
||||
preprocessed through Perl's source filter mechanism ( as is
|
||||
Net::IP::Match ), so that the ip arguments could be traditional perl
|
||||
scalars. The C code is lean and mean ( IMHO ).
|
||||
|
||||
Example in Apache/mod_perl
|
||||
I use this module in my Apache server's mod_perl DB logging script to
|
||||
determine if an incoming IP is 'remote' or 'local'. First, I set up some
|
||||
variables in httpd.conf:
|
||||
|
||||
PerlSetvar DBILogger_local_ips '222.234.52.192/29'
|
||||
PerlAddvar DBILogger_local_ips '111.245.76.248/29'
|
||||
PerlAddvar DBILogger_local_ips '10.0.0.0/24'
|
||||
PerlAddvar DBILogger_local_ips '172.16.0.0/12'
|
||||
PerlAddvar DBILogger_local_ips '192.168.0.0/16'
|
||||
PerlAddvar DBILogger_local_ips '127.0.0.1'
|
||||
|
||||
These are the ip addresses I want to be considered local. In the
|
||||
mod_perl module:
|
||||
|
||||
my @local_ips = $r->dir_config( "DBILogger_local_ips" );
|
||||
my $local = match_ip( $incoming_ip, @local_ips );
|
||||
|
||||
Now $local is just that, and I set the database key accordingly.
|
||||
|
||||
EXPORT
|
||||
'match_ip', unconditionally.
|
||||
|
||||
SEE ALSO
|
||||
Net::IP::Match by Marcel Grünauer.
|
||||
|
||||
AUTHOR
|
||||
Beau E. Cox, <beaucox@hawaii.rr.com>
|
||||
|
||||
COPYRIGHT AND LICENSE
|
||||
Copyright (C) 2004 by Beau E. Cox
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself, either Perl version 5.6.1 or, at
|
||||
your option, any later version of Perl 5 you may have available.
|
||||
|
|
@ -0,0 +1,87 @@
|
|||
package Net::IP::CMatch;
|
||||
|
||||
use 5.006001;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
|
||||
our @EXPORT = qw(
|
||||
match_ip
|
||||
);
|
||||
|
||||
our $VERSION = '0.02';
|
||||
|
||||
require XSLoader;
|
||||
XSLoader::load('Net::IP::CMatch', $VERSION);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Net::IP::CMatch - Efficiently match IP addresses against IP ranges with C.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Net::IP::CMatch;
|
||||
my $match = match_ip( $ip_addr, $match_ip1, $match_ip2, ... );
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Net::IP::CMatch is based upon, and does the same thing as Net::IP::Match.
|
||||
The unconditionally exported subroutine 'match_ip' determines if the
|
||||
ip to match ( first argument ) matches any of the subsequent ip arguments.
|
||||
Match arguments may be absolute quads, as '127.0.0.1', or contain
|
||||
mask bits as '111.245.76.248/29'.
|
||||
A true return value indicates a match. It was written in C, rather than
|
||||
a macro, preprocessed
|
||||
through Perl's source filter mechanism ( as is Net::IP::Match ), so that
|
||||
the ip arguments could be traditional perl scalars. The C code is
|
||||
lean and mean ( IMHO ).
|
||||
|
||||
=head2 Example in Apache/mod_perl
|
||||
|
||||
I use this module in my Apache server's mod_perl DB logging script to
|
||||
determine if an incoming IP is 'remote' or 'local'. First, I set up
|
||||
some variables in httpd.conf:
|
||||
|
||||
PerlSetvar DBILogger_local_ips '222.234.52.192/29'
|
||||
PerlAddvar DBILogger_local_ips '111.245.76.248/29'
|
||||
PerlAddvar DBILogger_local_ips '10.0.0.0/24'
|
||||
PerlAddvar DBILogger_local_ips '172.16.0.0/12'
|
||||
PerlAddvar DBILogger_local_ips '192.168.0.0/16'
|
||||
PerlAddvar DBILogger_local_ips '127.0.0.1'
|
||||
|
||||
These are the ip addresses I want to be considered local. In the
|
||||
mod_perl module:
|
||||
|
||||
my @local_ips = $r->dir_config( "DBILogger_local_ips" );
|
||||
my $local = match_ip( $incoming_ip, @local_ips );
|
||||
|
||||
Now $local is just that, and I set the database key accordingly.
|
||||
|
||||
=head2 EXPORT
|
||||
|
||||
'match_ip', unconditionally.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Net::IP::Match> by Marcel GrE<uuml>nauer.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Beau E. Cox, E<lt>beaucox@hawaii.rr.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2004 by Beau E. Cox
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.6.1 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use FindBin qw($Bin);
|
||||
|
||||
use Test::More tests => 4;
|
||||
|
||||
################# test 1 (should succeed) #######################
|
||||
BEGIN { use_ok('Net::IP::CMatch') };
|
||||
|
||||
my $match;
|
||||
|
||||
################# test 2 (should fail) #######################
|
||||
|
||||
$match = match_ip( qw( 207.175.219.202 10.0.0.0/8 99.99.99 ) );
|
||||
ok( ! $match, "check non-match" );
|
||||
|
||||
################# test 3 (should succeed) #######################
|
||||
|
||||
$match = match_ip( qw( 207.175.219.202 10.0.0.0/8
|
||||
192.168.0.0/16 207.175.219.200/29 ) );
|
||||
ok( $match, "check match" );
|
||||
|
||||
################# test 4 (should succeed) #######################
|
||||
|
||||
my @ips = split / /, '10.0.0.0/8 192.168.0.0/16 207.175.219.200/29';
|
||||
$match = match_ip( "'207.175.219.202xxx'", @ips );
|
||||
ok( $match, "check another match" );
|
||||
Loading…
Reference in New Issue