oneaccess.gramar
changeset 36 149c2265de24
child 37 7174a6414069
equal deleted inserted replaced
35:5a18e00f9ba1 36:149c2265de24
       
     1 # Grammar for OneAccess devices
       
     2 # Configuration is expected to be preprocessed via following command:
       
     3 # perl -ne '/(^\s*)(\S.*)$/; print length($1)." $2\n"'
       
     4 #
       
     5 # Copyright (c) 2012 Tomas Zeman <tzeman@volny.cz>
       
     6 # All rights reserved.
       
     7 #
       
     8 # Redistribution and use in source and binary forms, with or without
       
     9 # modification, are permitted providing that the following conditions 
       
    10 # are met:
       
    11 # 1. Redistributions of source code must retain the above copyright
       
    12 #    notice, this list of conditions and the following disclaimer.
       
    13 # 2. Redistributions in binary form must reproduce the above copyright
       
    14 #    notice, this list of conditions and the following disclaimer in the
       
    15 #    documentation and/or other materials provided with the distribution.
       
    16 #
       
    17 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
       
    18 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
       
    19 # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
       
    20 # ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
       
    21 # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
       
    22 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
       
    23 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
       
    24 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
       
    25 # STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
       
    26 # IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
       
    27 # POSSIBILITY OF SUCH DAMAGE.
       
    28 #
       
    29 
       
    30 { # perl code follows
       
    31 
       
    32 $::res = {};
       
    33 
       
    34 # Returns pointer to context hashref as specified by ctx stack.
       
    35 # @param ctx_path array of ctx stack.
       
    36 sub ctx {
       
    37 	return ctx_rel($::res, @_);
       
    38 }
       
    39 
       
    40 # Returns pointer to context hashref as specified by ctx stack,
       
    41 # relative to the supplied ctx pointer.
       
    42 # @param ptr current ctx pointer from which ctx build starts.
       
    43 # @param ctx_path array of ctx stack.
       
    44 sub ctx_rel {
       
    45 	my $ptr = shift;
       
    46 	my @ctx_path = @_;
       
    47 	foreach my $part (@ctx_path) {
       
    48 		$ptr->{$part} = {} unless exists ($ptr->{$part});
       
    49 		$ptr = $ptr->{$part};
       
    50 	}
       
    51 	return $ptr;
       
    52 }
       
    53 
       
    54 } # end of perl code
       
    55 
       
    56 file:		<skip: qr/[^\S\n]*/>	# Ignore non-newline whitespace
       
    57 		line(s) eofile
       
    58 
       
    59 line: 		s_controller
       
    60 		| s_interface
       
    61 		| l_vrf
       
    62 		| indent comment 
       
    63 		| indent cmdline 
       
    64 		| indent emptyline
       
    65 		| <error>
       
    66 
       
    67 emptyline:	eol
       
    68 
       
    69 comment: 	/!.*/ eol
       
    70 
       
    71 cmdline:	l_hostname eol
       
    72 		| l_hash eol
       
    73 		| word(s) eol
       
    74 
       
    75 word:		/\S+/  # any non-space
       
    76 		{ $item[1] }
       
    77 
       
    78 type:		/\w+/
       
    79 		{ $item[1] }
       
    80 
       
    81 num:		/\d+/
       
    82 		{ $item[1] }
       
    83 
       
    84 indent:		/\d+/
       
    85 		{ $item[1] }
       
    86 
       
    87 range:		/\d+/"-"/\d+/
       
    88 		{ { from => $item[1], to => $item[3] } } 
       
    89 		| /\d+/
       
    90 		{ { from => $item[1], to => $item[1] } } 
       
    91 
       
    92 keyword:	/[\w-]+/
       
    93 		{ $item[1] }
       
    94 
       
    95 identifier:	/[0-9a-zA-Z:_-]+/
       
    96 		{ $item[1] }
       
    97 
       
    98 quoted_text:	<perl_quotelike>
       
    99 		{ $item[1][2] }
       
   100 		| /[0-9a-zA-Z:\/_\#\"\.,-]+/
       
   101 		{ $item[1] }
       
   102 
       
   103 value:		/[0-9a-zA-Z:\/_\#\"\.,-]+/
       
   104 		{ $item[1] }
       
   105 
       
   106 eofile:		/^\Z/
       
   107 
       
   108 eol:		/\n/
       
   109 
       
   110 rest_of_line:	word(s)
       
   111 		| eol
       
   112 
       
   113 # section
       
   114 section:	cmdline(s) "!"
       
   115 		{ print "section\n"; }
       
   116 
       
   117 l_section:	/[1-9]/ word(s) eol
       
   118 		| /[1-9]/ "exit" eol
       
   119 		| /[1-9]/ eol
       
   120 		| <error>
       
   121 
       
   122 # Lines w/ hash (passwd, secret etc)
       
   123 l_hash:		word(s) /\S+/ word(s)
       
   124 		| word(s) /\S+/
       
   125 
       
   126 # Hostname
       
   127 l_hostname:	"hostname" identifier
       
   128 		{ $::res->{hostname} = $item{identifier} }
       
   129 
       
   130 # Description
       
   131 l_description:	"description" /[^\n]+/
       
   132 		{ $arg{ctx}->{description} = $item[2] }
       
   133 
       
   134 # controller section
       
   135 controller_num:	/\d+/
       
   136 		{ $item[1] }
       
   137 
       
   138 s_controller:	"0" "controller" type controller_num eol s_controller_l[ctx => ctx('controller', $item{controller_num}) ](s) "0" "exit" eol
       
   139 		{ $::res->{controller}->{$item{controller_num}}->{type} = $item{type} }
       
   140 
       
   141 s_controller_l:	"1" s_controller_content[ctx => $arg{ctx}] eol
       
   142 		| s_dsl_group[ctx => $arg{ctx}]
       
   143 		| l_section
       
   144 
       
   145 s_controller_content: l_description[ctx => $arg{ctx}]
       
   146 		| "framing" keyword
       
   147 		{ $arg{ctx}->{framing} = $item{keyword} }
       
   148 
       
   149 s_dsl_group:	"2" "dsl-group" num eol s_dsl_group_l[ctx => ctx_rel($arg{ctx}, 'dsl-group', $item{num})](s) "2" "exit" eol
       
   150 
       
   151 s_dsl_group_l:  indent s_dsl_group_content[ctx => $arg{ctx}] eol
       
   152 
       
   153 s_dsl_group_content:	"autoconfig"
       
   154 		{ $arg{ctx}->{autoconfig} = 1 }
       
   155 		| "execute"
       
   156 		{ $arg{ctx}->{execute} = 1 }
       
   157 		| "caplist" identifier
       
   158 		{ $arg{ctx}->{caplist} = $item{identifier} }
       
   159 		| "vendorspecoctets" num
       
   160 		{ $arg{ctx}->{vendorspecoctets} = $item{num} }
       
   161 
       
   162 # interface section
       
   163 iface_type:	/[0-9a-zA-Z:-]+/
       
   164 		{ $item[1] }
       
   165 
       
   166 iface_num:	/\d+([\.\/]\d+)*/
       
   167 		{ $item[1] }
       
   168 
       
   169 s_interface:	"0" "interface" iface_type iface_num /\S*/ eol s_interface_l[ctx => ctx("interface", $item{iface_type}.":".$item{iface_num}) ](s) "0" "exit" eol
       
   170 		{
       
   171 		my $id = $item{iface_type}.":".$item{iface_num};
       
   172 		$::res->{interface}->{$id}->{type} = $item{iface_type};
       
   173 		$::res->{interface}->{$id}->{num} = $item{iface_num}
       
   174 		}
       
   175 
       
   176 ip:		/\d+\.\d+\.\d+\.\d+/
       
   177 		{ $item[1] }
       
   178 
       
   179 s_interface_l:  "1" s_interface_content[ctx => $arg{ctx}] eol
       
   180 		| l_section
       
   181 
       
   182 s_interface_content: l_description[ctx => $arg{ctx}]
       
   183 		| /(no)?/ "shutdown"
       
   184 		{ $arg{ctx}->{shutdown} = ($item[1] eq 'no') ? 0 : 1 }
       
   185 		| "ip" "address" ip ip
       
   186 		{ $arg{ctx}->{ip} = $item[3]; $arg{ctx}->{mask} = $item[4] }
       
   187 		| "encapsulation" keyword /\S*/
       
   188 		{
       
   189 		$arg{ctx}->{encap} = $item[2];
       
   190 		$arg{ctx}->{encap_param} = $item[3] if length($item[3]) > 0
       
   191 		}
       
   192 		| "bandwidth" num
       
   193 		{ $arg{ctx}->{bandwidth} = $item{num} }
       
   194 		| "speed" num
       
   195 		{ $arg{ctx}->{speed} = $item{num} }
       
   196 		| "ip" "vrf" "forwarding" word
       
   197 		{ $arg{ctx}->{"ip-vrf-fwd"} = $item{word} }
       
   198 		| "bridge-group" num
       
   199 		{ $arg{ctx}->{"bridge-group"} = $item{num} }
       
   200 		| "framing" keyword
       
   201 		{ $arg{ctx}->{framing} = $item{keyword} }
       
   202 
       
   203 # vrf
       
   204 l_vrf:		"0" "ip" "vrf" keyword eol
       
   205 		{ $::res->{"ip-vrf"} = $item{keyword} }