Created
September 11, 2015 14:49
-
-
Save rns/5da061c82ed8c9cd8b05 to your computer and use it in GitHub Desktop.
deny_allow.pl with parens to hide eol
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env perl | |
# Adapted from tutorial Copyright (c) 2013 Peter Stuifzand | |
# at http://marpa-guide.github.io/chapter3.html | |
# In particular this is an attempt at Exercise 3 | |
use strict; | |
use warnings; | |
package Authorization; | |
use Moo; | |
use Marpa::R2; | |
use Data::Dumper; | |
has spec => ( | |
is => 'ro', | |
isa => sub { die if ref $_[0] }, | |
); | |
has grammar => ( | |
is => 'lazy', | |
); | |
has recognizer => ( | |
is => 'ro', | |
); | |
has ACL => ( | |
is => 'ro', | |
); | |
sub _build_grammar { | |
return <<'END_OF_SOURCE' | |
:start ::= rules | |
rules ::= rule+ | |
rule ::= cmd_type user_list (eol) | |
| cmd_type all (eol) | |
| user_decl (eol) | |
user_decl ::= user '=' user_list | |
user_list ::= user_spec+ | |
user_spec ::= user | list_ref | |
list_ref ~ '@' username | |
user ~ username | |
cmd_type ~ 'Deny' | 'Allow' | |
username ~ [\w]+ | |
all ~ 'all' | 'everybody' | |
:discard ~ ws | |
ws ~ [ \t]+ | |
eol ~ [\n]+ | |
END_OF_SOURCE | |
} | |
sub BUILD { | |
my ($self) = @_; | |
my $grammar = Marpa::R2::Scanless::G->new({ | |
default_action => '::array', | |
source => \$self->grammar, | |
}); | |
my $recognizer = Marpa::R2::Scanless::R->new({ grammar => $grammar }); | |
$self->{recognizer} = $recognizer; | |
print "Trying to parse:\n" . $self->spec . "\n\n"; | |
$recognizer->read(\$self->spec); | |
my $ACL = ${$recognizer->value}; | |
$self->{ACL} = $ACL; | |
print "Output:\n".Dumper($ACL); | |
return; | |
} | |
sub CanAccess { | |
my ($self, $username) = @_; | |
# ... make sense of $self->{ACL} | |
} | |
package main; | |
use Data::Dumper; | |
my $input = <<'INPUT'; | |
super_admins = me | |
admins = @super_admins admin root administrator peter | |
Deny all | |
Allow @admins carter | |
INPUT | |
my $auth = Authorization->new(spec => $input); | |
# print Dumper($auth); | |
print Dumper($auth->ACL); |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment