ACL-Regex

 view release on metacpan or  search on metacpan

Changes.PL  view on Meta::CPAN

    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;

examples/postifx-policy-server.pl  view on Meta::CPAN

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;

examples/postifx-policy-server.pl  view on Meta::CPAN

	# 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');

examples/postifx-policy-server.pl  view on Meta::CPAN

#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";

lib/ACL/Regex.pm  view on Meta::CPAN

	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 {

lib/ACL/Regex.pm  view on Meta::CPAN

   # 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

t/test_acl.pl  view on Meta::CPAN

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

}