ACL-Regex

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

Revision history for perl module ACL::Regex

0.02 2013-11-03
 - Started using Changes

 [Fixes]
 - Fixed POD documentation syntax problems

Changes.PL  view on Meta::CPAN

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;

MANIFEST  view on Meta::CPAN

Changes
Changes.PL
examples/postifx-policy-server.pl
lib/ACL/Regex.pm
Makefile.PL
MANIFEST
MANIFEST.SKIP
README
t/001.t
t/acl.permit.txt
t/acl.reject.txt
t/action.txt
t/actions.txt
t/required.txt
t/test_acl.pl
META.yml                                 Module meta-data (added by MakeMaker)

MANIFEST.SKIP  view on Meta::CPAN

^.git

META.yml  view on Meta::CPAN

--- #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    => {
                    },
);

README  view on Meta::CPAN

This ACL system provides a light framework for supplying regex-style, sys-admin
friendly access control to any kind of application.

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

#!/usr/bin/perl
#
use IO::Socket;
use threads;
use Proc::Daemon;
use Sys::Syslog qw( :DEFAULT setlogsock);

use Data::Dumper;
use lib( "./" );
use ACL;

# 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

package ACL::Regex;
# This is a little package used to handle ACLs in a friendly,
# sysadmin like regex enabled manner.

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
object, many of the initialization methods return the object reference, allowing
the programmer to chain the commands together.

=over 4

=item B<generate_required>

This method pulls in a I<:file> containing a series of required keys.

=item B<sanitize_acl>

This method re-sorts the keys in alphabetical order.

=item B<sanitize_action>

This method accomplishes the same thing as B<:sanitize_acl>
but for actions.

=item B<parse_acl_from_file>

This method takes a hash as a parameter:

  parse_acl_from_file( { Filename => "acl.reject.txt" } )

=item B<match>

This method takes an action as a parameter, and returns a triplet
containing the return code, matched regex, and any comment associated
with the regex.

=back

=head2 INPUT FILES

=head3 ACL REGEX FILE

An example of ain input ACL file can be found in the I<t> folder of this project, but it simply
comprises of rows that look like:

  # Don't allow domain admins to delete mailboxes on weekends or mondays
  /action=[mac-delete-mailbox] account=[.*@domain.net.adm] group=[domain-admin] dow=[sat|sun|mon]/        Domain admins can only delete mailboxes during the week
  # Reject mail from brazil
  /account=[.*@example.net] ip=[200..*] group=[user] action=[send-mail]/  No mail to be sent from Brazil!

The two tab deliminated columns separate the regex acl and the comment returned if any
match is found.

=head3 REQUIRED FILE

The required file is supplied to the object during instantiation and will seed
the object with a list of I<required> keys in the hash.  This way, if a key regex
isn't present in the B<ACL REGEX FILE> then the object will fill the hash with
a regex that I<matches all> possibilities.  This is designed to satisfy the regex
string should a key be absent from the action line.

  # This file contains a list of actions, and required attributes
  send-mail=account,ip,group,dow,time
  rwi_login=account,ip,auth_method,dow,time
  create_user=account,ip

=head3 ACTION FILE

A line of B<key>=[B<val>] pairs to be consumed by the ACL object.  These get
massaged so that any action key that doesn't satisfy the B<REQUIRED> fields are
added and the entire string is sorted by key name.

=head1 AUTHOR

Peter Blair C<pblair@cpan.org>

=head1 COPYRIGHT

This program is distributed in the hope that it will be
useful, but it is provided “as is” and without any express
or implied warranties.

=head1 BUGS

Please report any bugs via L<https://github.com/petermblair/Perl-CPAN/issues>.

t/001.t  view on Meta::CPAN

use lib "lib/";
use ACL::Regex;

use Test::More qw(no_plan);

ok( 0 == 0, "Simple" );

exit 0;

t/acl.permit.txt  view on Meta::CPAN

/action=[create-user] group=[(admin|superadmin)]/	Allow admins and superadmins to create users
/action=[delete-user] group=[(super)?admin]/		Allow admins and superadmins to delete users
/action=[login] group=[user]/				Allow users to login
/action=[send-mail] group=[user] dow=[(mon|tue|wed|thu|fri)]/	Allow users to send mail during the work week
/action=[login-app] group=[(super-)?admin] ip=[1.2.3.\d{1,3}] dow=[.*]/	Allow superadmins to login to the app from 1.2.3.0/24
/account=[.*?@.*.adm] action=[login-mac] group=[(super-)?admin]/	Allow mac access to superadmins

t/acl.reject.txt  view on Meta::CPAN

# Don't allow domain admins to delete mailboxes on weekends or mondays
/action=[mac-delete-mailbox] account=[.*@domain.net.adm] group=[domain-admin] dow=[sat|sun|mon]/	Domain admins can only delete mailboxes during the week
# Reject mail from brazil
/account=[.*@example.net] ip=[200..*] group=[user] action=[send-mail]/	No mail to be sent from Brazil!

t/action.txt  view on Meta::CPAN

action=[send-mail] account=[uwonnotice@example.net] ip=[200.1.2.3] group=[user] dow=[wed]
account=[pblair@example.adm] action=[login_mac] group=[super-admin] dow=[mon] time=[09:00]

t/required.txt  view on Meta::CPAN

# This file contains a list of actions, and required attributes
send-mail=account,ip,group,dow,time
rwi_login=account,ip,auth_method,dow,time
create_user=account,ip

t/test_acl.pl  view on Meta::CPAN

#!/usr/bin/perl
#use warnings;
use strict;
use lib( "../lib" );
use ACL::Regex;
use Data::Dumper;

my $accept_acl = ACL::Regex->new->
	generate_required( 'required.txt' )->
	parse_acl_from_file( { Filename => "acl.permit.txt" } );

my $reject_acl = ACL::Regex->new->
	generate_required( 'required.txt' )->
	parse_acl_from_file( { Filename => "acl.reject.txt" } );

my @actions;

# Read an action
while( <> ){
	chomp;
	push( @actions, $_ );
}

ACTION: for my $action ( @actions ){
	print "Action: $action\n";
	# Check against the reject
	my ($rc,$regex,$comment) = $reject_acl->match( $action );
	if( $rc ){
		print "\t! Rejected against $regex\n";
		print "\t: Reason: $comment\n";
		next ACTION;
	}
	($rc,$regex,$comment) = $accept_acl->match( $action );
	if( $rc ){
		print "\t* Accepted against $regex\n";
		print "\t: Reason: $comment\n";
		next ACTION;
	}

	print "\t? No ACLs matched\n";

}

 view all matches for this distribution
 view release on metacpan -  search on metacpan

( run in 1.417 second using v1.00-cache-2.02-grep-82fe00e-cpan-1925d2aa809 )