# Grammar for Ciena devices
#
# Copyright (c) 2009, 2010 Tomas Zeman <tzeman@volny.cz>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted providing that the following conditions 
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
# IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
{ # perl code follows

$::res = {};
$::res->{port} ={};
$::res->{"sub-port"} ={};
$::res->{pm} = {
	instance => {},
	service => {},
	'sub-port' => {},
};
$::res->{pbt} = {
	reserved => {},	# reserved bvids
	'bridge-mac' => {},
};
$::res->{'pbt-service'} = {};
$::res->{'pbt-transit'} = {};
$::res->{'pbt-tunnel-group'} = {};
$::res->{'pbt-tunnel'} = {};
$::res->{'tunnel'} = {};
$::res->{'tunnel-pair'} = {};
$::res->{'cfm-service'} = {};
$::res->{vc} = {};
$::res->{vs} = {};
$::res->{"vs-vlans"} = {};
$::res->{vlans} = {};
$::res->{interface} = {};

# local (current line) attribute-value-list, ie. property value
my $avl = {};
my $vlan_range = {};

# Consumes attribute value list.
# @param type Type (port/sub_port/etc).
# @param id Identifier, eg. port number.
sub consume_avl {
	my ($type, $id) = (@_);
	$::res->{$type}->{$id} = {} unless exists $::res->{$type}->{$id};
	foreach my $k (keys %$avl) {
		$::res->{$type}->{$id}->{$k} = $avl->{$k};
	}
	$avl = {};
}

# Consumes attribute value list into supplied pointer (into hash).
# @param ptr Pointer where AVL will be stored.
# @param id Identifier, eg. port number.
sub consume_avl_ptr {
	my ($ptr, $id) = (@_);
	$ptr->{$id} = {} unless exists $ptr->{$id};
	foreach my $k (keys %$avl) {
		$ptr->{$id}->{$k} = $avl->{$k};
	}
	$avl = {};
}

} # end of perl code

file:		<skip: qr/[^\S\n]*/>	# Ignore non-newline whitespace
		line(s) eofile

line: 		emptyline
		| comment
		| cmdline 
		| <error>

emptyline:	eol

comment: 	/^\!.*/ #eol

cmdline:	l_hostname
		| l_port
		| l_sub_port
		| l_pm
		| l_pbt
		| l_tunnel_pair
		| l_tunnel
		| l_cfm_service
		| l_vc
		| l_vs
		| l_vlan
		| l_iface
		| word(s) #eol

word:		/[0-9a-zA-Z:\/_\#\"\.\$,+<>=-]+/
		{ $item[1] }

identifier:	/[0-9a-zA-Z:_-]+/
		{ $item[1] }

ip4:		/\d+\.\d+\.\d+\.\d+/
		{ $item[1] }

quoted_text:	<perl_quotelike>
		{ $item[1][2] }
		| /[0-9a-zA-Z:\/_\#\"\.&\*,-]+/
		{ $item[1] }

value:		/[0-9a-zA-Z:\/_\#\"\.&\*,-]+/
		{ $item[1] }

eofile:		/^\Z/

eol:		/\n/

rest_of_line:	word(s)
		| eol

# Hostname
l_hostname:	"system" "set" "host-name" identifier
		{ $::res->{hostname} = $item{identifier} }

# Port
l_port:		"port" /disable|set/ "port" port_num avls
		{
		$avl->{action} = $item[2];
		consume_avl("port", $item{port_num}); 
		}

port_num:	/\d+(\/\d+)?/
		{ $item[1] }
		| /[0-9a-zA-Z]+/
		{ $item[1] }

avls:		avl(s)
		| eol

avl:		"description" quoted_text
		{ $avl->{description} = $item{quoted_text}; }
		| word value
		{ $avl->{$item{word}} = $item{value}; }
# Sub-port
l_sub_port:	"sub-port" /add|create/ "sub-port" identifier avls /(vlan-untagged-data)?/
		{
		$avl->{action} = $item[2];
		consume_avl("sub-port", $item{identifier}); 
		$::res->{'sub-port'}->{$item{identifier}}->{'vtag-stack'} = $item[6]
			if (length $item[6] > 0);
		}

# PM
l_pm:		"pm" "enable" "pm-instance" identifier
		{ $::res->{pm}->{instance}->{$item{identifier}} = "enabled" }
		| "pm" "create" /service|sub-port/ identifier avls
		{
		$::res->{pm}->{$item[3]}->{$item{identifier}} = {};
		consume_avl_ptr($::res->{pm}->{$item[3]}, $item{identifier});
		}

# PBT
bvid:		/\d+/
		{ $item[1] }

mac:		/\d{12}|(\d\d:){5}\d\d/
		{ $item[1] }

l_pbt:		"pbt" "reserve" "bvid" bvid
		{ $::res->{pbt}->{reserved}->{$item{bvid}} = 1 }
		| "pbt" "set" "bridge-mac" mac avls
		{
		$::res->{pbt}->{'bridge-mac'}->{$item{mac}} = {};
		consume_avl_ptr($::res->{pbt}->{'bridge-mac'}, $item{mac})
		}
		| "pbt" "service" "create" "service" identifier avls
		{ consume_avl("pbt-service", $item{identifier}) }
		| "pbt" "tunnel-group" "create" "group" identifier avls
		{ consume_avl("pbt-tunnel-group", $item{identifier}) }
		| "pbt" "transit" /\w+/ "pbt-transit" identifier avls
		{ consume_avl("pbt-transit", $item{identifier}) }
		| "pbt" /encap|decap/"-tunnel" /\w+/ /\S+/ identifier avls
		{
		$::res->{"pbt-tunnel"}->{$item{identifier}}->{type} = $item[2];
		consume_avl("pbt-tunnel", $item{identifier})
		}
		| "pbt" "remote-bridge" "create" /bridge(-name)?/ identifier avls
		{
		$::res->{pbt}->{'remote-bridge'}->{$item{identifier}} = {};
		consume_avl_ptr($::res->{pbt}->{'remote-bridge'}, $item{identifier})
		}

# Tunnel pair
l_tunnel_pair:	"tunnel" "pair" "create" "tnl-pair" identifier avls
		{ consume_avl("tunnel-pair", $item{identifier}) }

# Tunnel
l_tunnel:	"tunnel" /encap|decap/ "create" /\S+/ identifier avls
		{
		my ($tun_t, $pbt_t, $tun) = ($item[2], $item[4], $item{identifier});
		my $id = "$tun_t/$pbt_t/$tun";
		$::res->{tunnel}->{$id} = {
			"tunnel-type" => $tun_t,
			"pbt-type" => $pbt_t,
			"tunnel-name" => $tun,
		};
		consume_avl("tunnel", $id);
		}

# CFM
l_cfm_service:	"cfm" "service" "create" identifier identifier "name" identifier avls
		{
		my ($pbt_type, $pbt, $cfm) = ($item[4], $item[5], $item[7]);
		$::res->{"cfm-service"}->{$cfm} = {
			"pbt-type" => $pbt_type,
			"pbt" => $pbt,
		};
		consume_avl("cfm-service", $cfm);
		}
		| "cfm" "service" "set" "service" identifier avls
		{ consume_avl("cfm-service", $item{identifier}) }
		| "cfm" "service" "enable" "service" identifier
		{ $::res->{"cfm-service"}->{$item{identifier}}->{enabled} = 1; }

# Virtual circuit
l_vc:		"virtual-circuit" "pbt" "create" identifier identifier avls
		{
		my ($vc_type, $vc) = ($item[4], $item[5]);
		$::res->{vc}->{$vc}->{type} = $vc_type;
		consume_avl("vc", $vc);
		}

# Virtual switch
l_vs:		"virtual-switch" "create" "vs" identifier
		{ $::res->{vs}->{$item{identifier}} = {}; }
		| "virtual-switch" "ethernet" "create" "vs" identifier avls
		{
		my ($vs, $vc) = ($item[5], $avl->{vc});
		$::res->{vs}->{$vs}->{ethernet}->{vc} = $vc;
		}
		| "virtual-switch" "ethernet" "add" "vs" identifier avls
		{
		my $vs = $item{identifier};
		$::res->{vs}->{$vs}->{ethernet}->{members} = []
			unless exists $::res->{vs}->{$vs}->{ethernet}->{members};
		my %params = %$avl;
		push @{$::res->{vs}->{$vs}->{ethernet}->{members}}, \%params;
		$avl = {};
		}
		| "virtual-switch" "interface" "attach" /(\w|-)+/ identifier "vs" identifier
		{
		my ($entity_type, $entity, $vs) = ($item[4], $item[5], $item[7]);
		$::res->{vs}->{$vs}->{interfaces} = []
			unless exists $::res->{vs}->{$vs}->{interfaces};
		push @{$::res->{vs}->{$vs}->{interfaces}}, {
			entity => $entity,
			type => $entity_type,
		};
		}
		| "virtual-switch" "l2-cft" "protocol" "add" "vs" identifier avls
		{
		my $vs = $item{identifier};
		$::res->{vs}->{$vs}->{"l2-cft"}->{protocols} = []
			unless exists $::res->{vs}->{$vs}->{"l2-cft"}->{protocols};
		my %params = %$avl;
		push @{$::res->{vs}->{$vs}->{"l2-cft"}->{protocols}}, \%params;
		$avl = {};
		}
		| "virtual-switch" "l2-cft" "enable" "vs" identifier
		{ $::res->{vs}->{$item{identifier}}->{"l2-cft"}->{enabled} = 1 }
		| "virtual-switch" "private-forwarding-groups" "enable" "vs" identifier
		{ $::res->{vs}->{$item{identifier}}->{"priv-fwd-grp"}->{enabled} = 1 }
		| "virtual-switch" "private-forwarding-groups" "set" "vs" identifier avls
		{
		my $vs = $item{identifier};
		my %params = %$avl;
		$::res->{vs}->{$vs}->{"priv-fwd-grp"} = \%params;
		$avl = {};
		}
		| "virtual-switch" "add" "reserved-vlan" /\d+/"-"/\d+/
		{
		my ($from, $to) = ($item[4], $item[6]);
		for (my $i = $from; $i <= $to; $i++) {
			$::res->{"vs-vlans"}->{$i} = 1;
		}
		}

# Vlan
vlan_s_range:	/\d+/"-"/\d+/
		{ for (my $i = $item[1]; $i <= $item[3]; $i++) { $vlan_range->{$i} = 1; } }
		| /\d+/
		{ $vlan_range->{$item[1]} = 1 }
vlan_range: 	vlan_s_range","vlan_range
		| vlan_s_range
l_vlan:		"vlan" "create" "vlan" vlan_range
		{
		foreach my $vlan (keys %$vlan_range) {
			$::res->{vlans}->{$vlan} = 1;
		}
		$vlan_range = {};
		}
		| "vlan" /add|remove/ "vlan" vlan_range "port" port_num
		{
		my $action = ($item[2] =~ /remove/) ? 0 : 1;
		foreach my $vlan (keys %$vlan_range) {
			$::res->{port}->{$item{port_num}}->{vlans}->{$vlan} = $action;
		}
		$vlan_range = {};
		}

# Interface
l_iface:	"interface" "remote" "set" "ip" ip4 "subnet" ip4
		{
		my ($ip, $mask) = ($item[5], $item[7]);
		$::res->{interface}->{remote} = {
			ip => $ip,
			mask => $mask
		}
		}
		| "interface" "local" "disable"
		{ $::res->{interface}->{'local'}->{disabled} = 1; }
		| "interface" "set" "gateway" ip4
		{ $::res->{interface}->{gateway} = $item{ip4}; }
		| "interface" "create" "remote-interface" identifier "ip" ip4 "subnet" ip4 "vs" identifier
		{
		my ($iface, $ip, $mask, $vs) = ($item[4], $item[6], $item[8], $item[10]);
		$::res->{interface}->{remote} = {
			ip => $ip,
			mask => $mask,
			id => $iface,
			vs => $vs,
		}
		}