perl/libnet-ip-cmatch-perl
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Imported Upstream version 0.02

Browse Source
This commit is contained in:
Mario Fetka 2017-09-15 15:33:38 +02:00
commit 187b1bcce8
9 changed files with 5139 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
CMatch.xs Normal file
View File

@ -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

6
Changes Normal file
View File

@ -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

9
MANIFEST Normal file
View File

@ -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)

10
META.yml Normal file
View File

@ -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

17
Makefile.PL Normal file
View File

@ -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
);

70
README Normal file
View File

@ -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.

87
lib/Net/IP/CMatch.pm Normal file
View File

@ -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

4812
ppport.h Normal file
View File

File diff suppressed because it is too large Load Diff

30
t/Net-IP-CMatch.t Normal file
View File

@ -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" );