winupd/cfgparser.pm

package cfgparser;

use strict;

require Exporter;
@cfgparser::ISA = qw(Exporter);
@cfgparser::EXPORT = qw(
	parse_structure
	parse_cfg_file
);

use logging;
use JSON;
use Data::Dumper;

sub check_structure ($$$);

sub check_structure ($$$)
{
	my ($label, $structure, $grammar) = @_;

	my $stype = ref($structure);
	my $gtype = $$grammar{Type};
	if ($gtype eq 'or') {
		my $options = $$grammar{Options};
		if ($stype eq 'LIST') {
			foreach my $subgrammar (@$options) {
				my $gtype = $$subgrammar{Type};
				if ($gtype eq 'list') {
					return check_structure($label, $structure, $subgrammar);
				}
			}
			print_log('config', ERROR, 'Found LIST, not expecting this at %s', $label);
			return 0;
		}
		elsif ($stype eq 'HASH') {
			foreach my $subgrammar (@$options) {
				my $gtype = $$subgrammar{Type};
				if ($gtype eq 'map' || $gtype eq 'struct') {
					return check_structure($label, $structure, $subgrammar);
				}
			}
			print_log('config', ERROR, 'Found HASH, not expecting this at %s', $label);
			return 0;
		}
		elsif ($stype eq '') {
			foreach my $subgrammar (@$options) {
				my $gtype = $$subgrammar{Type};
				if ($gtype eq 'string' || $gtype eq 'integer') {
					return check_structure($label, $structure, $subgrammar);
				}
			}
			print_log('config', ERROR, 'Found SCALAR, not expecting this at %s', $label);
			return 0;
		}
		else {
			print_log('config', ERROR, 'Found %s, not expecting this at %s', $stype, $label);
			return 0;
		}
	}
	if ($gtype eq 'map') {
		if ($stype ne 'HASH') {
			print_log('config', ERROR, 'Expecting HASH, found %s at %s', $stype, $label);
			return 0;
		}
		my $sublabel = $label;
		$sublabel .= '/' unless $sublabel eq '/';
		foreach my $key (keys %$structure) {
			return 0 unless check_structure($sublabel.$key, $$structure{$key}, $$grammar{Elements});
		}
		return 1;
	}
	if ($gtype eq 'struct') {
		if ($stype ne 'HASH') {
			print_log('config', ERROR, 'Expecting HASH, found %s at %s', $stype, $label);
			return 0;
		}
		my $sublabel = $label;
		$sublabel .= '/' unless $sublabel eq '/';
		my $keywords = $$grammar{Keywords};
		foreach my $key (keys %$structure) {
			my $kw = $$keywords{$key};
			if (! defined $kw) {
				print_log('config', ERROR, 'Unknown keyword %s at %s', $key, $label);
				return 0;
			}
			return 0 unless check_structure($sublabel.$key, $$structure{$key}, $kw);
		}
		foreach my $key (keys %$keywords) {
			my $kw = $$keywords{$key};
			next unless defined $$kw{Mandatory} && $$kw{Mandatory};
			if (! defined $$structure{$key}) {
				print_log('config', ERROR, 'Missing mandatory keyword %s at %s', $key, $label);
				return 0;
			}
		}
		my $checkfunc = $$grammar{Check};
		return 0 if defined $checkfunc && ! &{$checkfunc}($structure, $label);
		return 1;
	}
	if ($gtype eq 'list') {
		if ($stype ne 'ARRAY') {
			print_log('config', ERROR, 'Expecting ARRAY, found %s at %s', $stype, $label);
			return 0;
		}
		my $index = 0;
		foreach my $element (@$structure) {
			$index++;
			return 0 unless check_structure($label.'['.$index.']', $element, $$grammar{Elements});
		}
		return 1;
	}
	if ($stype ne '') {
		print_log('config', ERROR, 'Expecting SCALAR, found %s at %s', $stype, $label);
		return 0;
	}
	if ($gtype eq 'string') {
		print_log('config', DEBUG2, 'Found string value %s at %s', $structure, $label);
	}
	elsif ($gtype eq 'integer') {
		if ($structure !~ /^\d+$/o) {
			print_log('config', ERROR, 'Expecting integer value, found %s at %s', $structure, $label);
			return 0;
		}
		print_log('config', DEBUG2, 'Found integer value %s at %s', $structure, $label);
	}
	else {
		print_log('config', ERROR, 'Unknown grammar element type: %s', $gtype);
		return 0;
	}
	return 1;
}

sub parse_structure ($$$)
{
	my ($path, $contents, $grammar) = @_;

	my $structure = eval { decode_json($contents) };
	if (! defined $structure) {
		my $error = $@;
		print_log('config', ERROR, 'Cannot parse config file %s: %s', $path, $error);
		return undef;
	}
	return undef unless check_structure('/', $structure, $grammar);
	return $structure;
}

sub parse_cfg_file ($$)
{
	my ($path, $grammar) = @_;

	if (! open(FILE, '<', $path)) {
		print_log('config', ERROR, 'Cannot open file %s: %s', $path, $!);
		return undef;
	}
	my $contents = '';
	while (<FILE>) {
		$contents .= $_;
	}
	close(FILE);
	return parse_structure($path, $contents, $grammar);
}

1;