ACL-Regex
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
Revision history for perl module ACL::Regex
0.02 2013-11-03
- Started using Changes
[Fixes]
- Fixed POD documentation syntax problems
use strict;
use CPAN::Changes;
# Load from file
my $changes = CPAN::Changes->load( 'Changes' );
# Create a new Changes file
$changes = CPAN::Changes->new(
preamble => 'Revision history for perl module ACL::Regex'
);
# Started to use the changes stuff
my $release = CPAN::Changes::Release->new(
version => '0.02',
date => '2013-11-03',
);
$release->add_changes( { group => 'Fixes' }, 'Fixed POD documentation syntax problems' );
$release->add_changes( 'Started using Changes' );
$changes->add_release( $release );
open my $fd, ">Changes";
print $fd $changes->serialize;
--- #YAML:1.0
name: ACL-Regex
version: 0.0002
abstract: Class to generate access controls using PCRE
author:
- Peter Blair (pblair@cpan.org)
license: unknown
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
build_requires:
ExtUtils::MakeMaker: 0
requires: {}
no_index:
directory:
- t
- inc
generated_by: ExtUtils::MakeMaker version 6.57_05
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Makefile.PL view on Meta::CPAN
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'ACL::Regex',
VERSION_FROM => 'lib/ACL/Regex.pm',
AUTHOR => 'Peter Blair (pblair@cpan.org)',
ABSTRACT => 'Class to generate access controls using PCRE',
PREREQ_PM => {
},
);
Any application can make use of the module, the example application is a perl
service that takes postfix style policy server declarations, converts them
into a native format, and checks them against a database of ACLs.
Note, that this intended for use strictly with Postfix systems, but rather
any system that requires an ACL: web-application, mail application, etc.
Installation:
$ perl Makefile.PL && make test install
examples/postifx-policy-server.pl view on Meta::CPAN
# Global config settings
my $TC = 1;
my $debug = 1;
my $port = 12345;
our $pidfile = "/var/run/postfix-policy-server.pid";
our %redirectmap;
# Param1: Client socket
# Param2: hash_ref
sub parse_postfix_input( $$ ) {
my ($socket,$hashref) = @_;
local $/ = "\r\n";
while( my $line = <$socket> ){
chomp( $line );
$line =~ s/\r//g;
$line =~ s/\n//g;
return if $line =~ /^(\r|\n)*$/;
#print "DEBUG: $line" if $debug;
if( $line =~ /^(\w+?)=(.+)$/ ){
$hashref->{$1} = $2;
}
}
}
sub convert_hashref_to_acl($){
my( $hash_ref ) = @_;
my @a;
for( sort( keys %$hash_ref ) ) {
my $str = "$_=\[$hash_ref->{$_}\]";
push( @a, $str );
}
return( join( " ", @a ) );
}
sub process_client($){
my ($socket) = @_;
# Create some stuff
my $accept_acl = ACL->new->generate_required( 'required.txt' )->parse_acl_from_file( { Filename => "acl.permit.txt" } );
my $reject_acl = ACL->new->generate_required( 'required.txt' )->parse_acl_from_file( { Filename => "acl.reject.txt" } );
ACCEPT: while( my $client = $socket->accept() ){
my $hash_ref = {};
parse_postfix_input( $client, $hash_ref );
my $action = convert_hashref_to_acl( $hash_ref );
print "Action: " . Dumper($action) . "\n";
my ($rc,$regex,$comment) = $reject_acl->match( $action );
print Dumper( $rc ) . Dumper( $regex ) . Dumper( $comment ) . "\n";
if( $rc ){
print $client "action=reject $comment\n\n";
next ACCEPT;
# Match
}
($rc,$regex,$comment) = $accept_acl->match( $action );
print Dumper( $rc ) . Dumper( $regex ) . Dumper( $comment ) . "\n";
if( $rc ){
print $client "action=ok $comment\n\n";
next ACCEPT;
# Match
}
# Handle any redirects
print $client "action=dunno\n\n";
}
}
sub handle_sig_int
{
unlink( $pidfile );
exit(0);
}
#openlog('missed-spam-policy', '', 'mail');
#syslog('info', 'launching in daemon mode') if $ARGV[0] eq 'quiet-quick-start';
#Proc::Daemon::Init if $ARGV[0] eq 'quiet-quick-start';
# Attempt to parse in the redirect config
$SIG{INT} = \&handle_sig_int;
# Ignore client disconnects
$SIG{PIPE} = "IGNORE";
open PID, "+>", "$pidfile" or die("Cannot open $pidfile: $!\n");
print PID "$$";
close( PID );
my $server = IO::Socket::INET->new(
LocalPort => $port,
Type => SOCK_STREAM,
Reuse => 1,
Listen => 10
)
or die
"Couldn't be a tcp server on port $default_config->{serverport} : $@\n";
# Generate a number of listener threads
my @threads = ();
for( 1 .. $TC ){
my $thread = threads->create( \&process_client, $server );
push( @threads, $thread );
}
foreach my $thread ( @threads ){
$thread->join();
}
unlink( $pidfile );
closelog;
exit( 0 );
lib/ACL/Regex.pm view on Meta::CPAN
use strict;
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
@EXPORT = qw( new parse_acl_from_file match );
$VERSION = '0.0002';
sub new {
my $type = shift;
bless {}, $type;
}
# This variable stores all of the required fields
# for the ACL. If a required field is not in a
# given ACL or action, then it is autogenerated
# with the defaults (enabled).
my @required = qw(
account
action
ip
group
dow
time
);
sub generate_required( $$ ){
my ( $acl, $required_file ) = @_;
open FD, "<$required_file" or die("Cannot open $required_file: $!\n" );
while( <FD> ){
next if /^#/;
if( /(\S+?)=(\S+)/ ){
my @a = split( /,/, $2 );
$acl->{req}->{$1} = \@a;
}
}
return ($acl);
}
sub sanitize_acl ($$) {
my ( $self, $acl ) = @_;
# Split up the ACL
my %hash = $acl =~ /(\S+?)=\[([^\[^\]].+?)\]/g;
my @acl_array;
my @local_required = sort( keys %hash );
my $action = $hash{action};
return -1,'ERR','Action not defined'
unless defined $hash{action};
#return 0,'WARN','Action not defined in required fields'
# unless defined $self->{req}->{$action};
if( defined $self->{req}->{$action} ){
#print "Using pre-defined requirements for $action from file\n";
@local_required = @{$self->{req}->{$action}};
}
# Regenerate the hash
for my $key ( sort ( @local_required ) ) {
unless ( defined $hash{$key} ) {
# Uh-oh, it wasn't specified
my $acl_element = "$key=\\\[(.*?)\\\]";
push ( @acl_array, $acl_element );
} else {
my $acl_element = "$key=\\\[$hash{$key}\\\]";
push ( @acl_array, $acl_element );
}
} ## end for my $key ( sort ( @required...
return 0,'OK',join ( " ", @acl_array );
} ## end sub sanitize_acl ($)
sub sanitize_action ($$) {
my ( $self, $acl ) = @_;
# Split up the ACL
my %hash = $acl =~ /(\S+?)=\[([^\[^\]].+?)\]/g;
my @acl_array;
my @local_required = sort( keys %hash );
my $action = $hash{action};
return -1,'ERR',"Action [$action] not defined"
unless defined $hash{action};
#return 0,'WARN','Action not defined in required fields'
# unless defined $self->{req}->{$action};
if( defined $self->{req}->{$action} ){
@local_required = @{$self->{req}->{$action}};
}
my $action = $hash{action};
# Regenerate the hash
for my $key ( sort ( @local_required ) ) {
unless ( defined $hash{$key} ) {
# Uh-oh, it wasn't specified
my $acl_element = "$key=\[]";
push ( @acl_array, $acl_element );
} else {
my $acl_element = "$key=\[$hash{$key}\]";
push ( @acl_array, $acl_element );
}
} ## end for my $key ( sort ( @required...
return 0,'OK',join ( " ", @acl_array );
} ## end sub sanitize_action ($)
sub parse_acl_from_file( $$ ) {
my ( $self, $hash ) = @_;
die ( "Please give a filename as an option!\n" )
unless defined $hash->{Filename};
open FD, "<$hash->{Filename}"
or die ( "Cannot open $hash->{Filename}: $!\n" );
ENTRY: while ( <FD> ) {
chomp;
s/^.*?(\s*#.*)//; # Get rid of comments
next ENTRY if /^$/;
if( /^\/(.+?)\/\s+?(.*)/ ){
my ($regex, $comment) = ($1,$2);
my ($rc,$rs,$sanitized) = $self->sanitize_acl( $regex );
next ENTRY
if $rc < 0;
$self->{message}->{"$sanitized"} = $comment;
push ( @{ $self->{ACL} }, $sanitized );
}
} ## end while ( <FD> )
close( FD );
return( $self );
} ## end sub parse_acl_from_file( $$ )
sub match ($$) {
my ( $self, $action ) = @_;
my ($rc,$rs,$sanitized) = $self->sanitize_action( $action );
return( $rc,$rs,'')
if $rc < 0;
for my $regex ( @{ $self->{ACL} } ) {
return ( 1, $regex, $self->{message}->{"$regex"} ) if ( $sanitized =~ /$regex/i );
}
return ( 0, '', '' );
} ## end sub match ($$)
1;
# vim: set ai ts=4 nu:
__END__
=head1 NAME
ACL::Regex - Process arbitrary events with regular expressions.
=head1 SYNOPSIS
use ACL::Regex;
# Instantiate a reject object
my $reject_acl = ACL::Regex->new->
generate_required( 'required.txt' )->
parse_acl_from_file( { Filename => "acl.reject.txt" } );
while( <> ){
chomp;
my ($rc,$regex,$comment) = $reject_acl->match( $_ );
if( $rc ){
print "\t! Rejected against $regex\n";
print "\t: Reason: $comment\n";
next;
}
}
=head1 DESCRIPTION
ACL::Regex allows you to parse a series of actions, key/value pairs through
an object containing a series of regular expressions.
=head2 OBJECT ORIENTED INTERFACE
The module is written with an object oriented interface. There is no function
interface to choose from. To streamline many of the initial operations of the
view release on metacpan - search on metacpan
( run in 1.538 second using v1.00-cache-2.02-grep-82fe00e-cpan-48ebf85a1963 )