#!/usr/bin/perl -d
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# This program chews up symbolic MIBs and produces a  C  table.   The #
# syntax  of a .mib file is rather poorly characterized; this program #
# basically just handles what I've seen in actual .mib files.         #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
$, = ' ';
$" = '.';

# Patterns:
$psym = '([A-Za-z][-_A-Za-z0-9]*)';
$pnum  = '([0-9]+)';
$DF = '::=';
$LB = '{';
$RB = '}';
$LP = '(';
$RP = ')';

%onam = ('iso', '1');	# OID table with name as key.
%oval = ('1', 'iso');	# OID table with value as key.

# Read the MIB and process each line.
while () {
	&tok(2) || last;
	if ($t[1] eq 'OBJECT-TYPE') {
	   if ($t[0] eq 'IMPORTS') {
		   $imports = &findstr(';');
		   @imports = splice(@t,0,$imports);
		   shift @t;	# Eat up the semicolon.
		   next;
	   }
		$name = $t[0];
		splice(@t,0,2);
		next;
	}
	if ($t[0] eq 'ACCESS') {
		&access($name,$t[1]);
		splice(@t,0,2);
		next;
	}
	if ($t[0] eq 'DESCRIPTION') {
		&descr($name,$t[1]);
		splice(@t,0,2);
		next;
	}
	if ($t[0] eq 'INDEX' && $t[1] eq $LB) {
		splice(@t,0,2);
		&index($name);
		next;
	}
	if ($t[0] eq "STATUS") {
		# It's always "mandatory".
		splice(@t,0,2);
		next;
	}
	if ($t[0] eq "SYNTAX") {
		splice(@t,0,1);
		&syntax($name);
		next;
	}
	if ($t[0] eq $DF && $t[1] eq $LB) {	# "::= { ... }" alone.
		splice(@t,0,2);
		&oid($name);
		next;
	}
	&tok(5) || last;

	if ($t[1] eq 'OBJECT' 
	&&  $t[2] eq 'IDENTIFIER'
	&&  $t[3] eq $DF
	&&  $t[4] eq $LB) {
		$objid = $t[0];
		splice(@t,0,5);
		&oid($objid);
		next;
	}
# We don't actually do anything with "fooEntry ::= SEQUENCE { ... }"
	if ($t[1] eq $DF 
	&&  $t[2] eq 'SEQUENCE'
	&&  $t[3] eq $LB) {
		if (($i = &findstr($RB)) < 0) {
			print STDERR "Line $.: Can't find '$RB'\n";
			next;
		}
		while (@t && $t[0] ne $RB) {
			splice(@t,0,$i + 1);	# Discard them.
		}
		next;
	}
	if ($t[1] eq 'DEFINITIONS'
	&&  $t[2] eq $DF
	&&  $t[3] eq 'BEGIN') {
		$mib = $t[0];
		print "MIB: $mib\n";
		splice(@t,0,4);
		next;
	}
	print "Line $. in $ARGV: Can't handle \"$t[0]\"\n";
	shift @t;
	next;
}

# Dump the table in object-id order:
print "Table:\n";
foreach $v (sort(oidorder keys(%oval))) {
	$i = &inst($oval{$v});
	$n = $oval{$v};
	$N = &caps($n);
	$a = $access{$n} || 'XX';
	$d = $descr{$n};
	$t = ($i eq 'G') ? 'GROUP' : &caps($type{$n}) || 'OTHER';
	print "{{$v.$i},";
	print "\t$t,";
	print "\t$N,";
	print "\t$a,";
	print "\t\"$n\"";
	print "},";
#	print "\t/* $d */" if $d;
	print "\n";
}
exit 0;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# &access(name,type)                                                  #
#                                                                     #
# This registers the read/write permissions for the named variable.   #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub access {
	local($name,$val) = @_;
	$val =~ s/\s+//g;
	if ($val eq 'read-only') {
		$val = 'RO'
	} elsif ($val eq 'read-write') {
		$val = 'RW'
	} elsif ($val eq 'write-only') {
		$val = 'WO'
	} elsif ($val eq 'not-accessible') {
		$val = 'NA'
	}
	$access{$name} = $val;
}
# - - - - - - - - - - - - - - - - - - - - - - - - #
# &addoid($name,$val,...)                         #
#                                                 #
# Add a new oid to the tables; return its value.  #
# - - - - - - - - - - - - - - - - - - - - - - - - #
sub addoid {
	local($n,@l) = @_;
	local($l);
	if ($onam{$n}) {
		print STDERR "Redefining $n (was $onam{$n})\n";
	}
	$l = "@l";
	$onam{$n} = $l;
	$oval{$l} = $n;
	print "OID: $l $n\n";
	return $l;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#    &caps(string)                                                    #
#  Return the string with all letters capitalized.                    #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub caps {
	local($x) = @_;
	$x =~ tr/a-z/A-Z/;
	$x;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#   &descr(name,text)                                                 #
# This registers a text description for the named variable.           #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub descr {
	local($name,$text) = @_;
	$descr{$name} = $text;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#   &findstr(pattern)                                                 #
# Given  a  string,  expand  @t until the string appears.  The return #
# value is the index where it is found.  The return value is -1 if we #
# hit EOF first.                                                      #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub findstr {
	local($s) = @_; local($n);
	while (($n = &havestr($s)) < 0) {
		if (!&tok(@t + 1)) {
			print "EOF\n";
			return -1;
	}	}
	$fs = $n;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#
# Get the value for a symbolic name, or '*' if it isn't defined. #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#
sub getoid {
	local($n) = @_;
	if ($onam{$n}) {return $onam{$n};}
	print STDERR "Line $Line: Can't decode \"$n\"\n";
	return '*';
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#     &havestr(string)                                                #
#  Look thru @t for a string that exactly matches  the  string.   The #
#  return value is the index where it is found. The return value is 0 #
#  if we hit EOF first.                                               #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub havestr {
	local($s) = @_; local($n);
	for $n (0 .. $#t) {
		if ($t[$n] eq $s) {
			return $n;
		}
	}
	-1;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#   &index(name)                                                      #
# This registers an index for the named variable. This routine should #
# find @t filled with "type ...  }".                                  #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub index {
	local($name) = @_;
	local(@list,@new); # local($indx);
	if (($indx = &findstr($RB)) < 0) {
		print STDERR "Line $Line: Can't find matching '}'\n";
	} else {
		@new = splice(@t,0,$indx);
		@list = (@list , @new);
		$index{$name} = "@list";
		$indices{$name} = @list;
		splice(@t,0,1);		# Get rid of the right brace.
	}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# &inst(name)                                                         #
#                                                                     #
# This returns a code for the object instance for the name.  The code #
# is  '0',  'G',  or a string of 'F's, one per object-instance value. #
# This is rather kludgy,  and  uses  the  fact  that  the  INDEX  was #
# attached  to  the  parent node, not to this one.  Also, we look for #
# IpAddress" items, and convert them to four 'F's.                    #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub inst {
	local($name) = @_;
	local($inst,$i,@i,$p,$t);
	if ($p = $parent{$name}) {
		if ($i = $index{$p}) {
			@i = split(/\./,$i);
			for (@i) {
				$t = $type{$_};
				if ($type{$_} eq "IpAddress") {
					$inst .= '.F.F.F.F';
				} else {
					$inst .= '.F';
				}
			}
			$inst =~ s/^\.//;
		} elsif ($children{$name}) {
			$inst = 'G';
		} else {
			$inst = '0';
		}
	} else {
		$inst = 'R';	# Root is assumed to be a group.
	}
	$inst;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# This function takes a name and a definition in the @t vector.   The #
# definition  is scanned, and values are added to the %onam and %oval #
# tables if possible.  There are several formats.                     #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub oid {
	local($name) = @_;
	local($i,$o,$xx);
	if (&findstr($RB) < 0) {
		printf STDERR "Line $Line: Incomplete object definition.\n";
		return 0;
	}
	while ($t[0] ne $RB) {
		if (@t > 4 && $t[1] eq $LP && $t[3] eq $RP) {	# name(num)
			$o = &addoid($t[0],$o,$t[2]);
			&parent($xx,$t[0]) if $xx;
			$xx = $t[0];	# Remember last list item.
			splice(@t,0,4);
			next;
		}
		if (@t > 2 && $t[1] > 0) {		# name num
			$o = &addoid($name,&getoid($t[0]),$t[1]);
			&parent($t[0],$name);
			$xx = $t[0];
			splice(@t,0,2);
			next;
		} 
		if (@t > 1) { 			# name
			$o .= &getoid($t[0]);
			&parent($xx,$t[0]) if $xx;
			$xx = $t[0];
			splice(@t,0,1);
			next;
		}
		print STDERR "Line $Line: Can't handle \"@t\"\n";
	}
	splice(@t,0,1);	# Delete the right brace.
	$oval{$name};	# Probably not used.
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Here's a routine to determine which of two oid values comes first.  #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub oidorder {
	local($i,@a,@b);
	@a = split(/\./,$a);
	@b = split(/\./,$b);
	for ($i=0; $a[$i] && $b[$i]; $i++) {
		return -1 if ($a[$i] < $b[$i]);
		return  1 if ($a[$i] > $b[$i]);
	}
	return  1 if $a[$i];
	return -1 if $b[$i];
	return  0;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#
# &parent(x,y,...) enters x as the parent of the rest of the args. #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#
sub parent {
	local($p) = shift(@_);
	foreach (@_) {
		$parent{$_} = $p;
		$children{$p} .= $_ . ' ';
	}
}
# - - - - - - - - - - - - - - - #
# Process the SEQUENCE command. #
# - - - - - - - - - - - - - - - #
sub seq {
	local($item);
#	print "Seq: $SEQUENCE $item\n";
	&getblock($RB);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#    &getblock(delimiter)                                             #
# Eat up input until the next line that ends with the delimiter,  and #
# combine it all into one long string.                                #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub getblock {
	local($dlm) = @_;
	local($val);
	while (<>) {
#		++$Line;
		close(ARGV) if eof;
		s/\n$/ /;
		s/\s*--\s*.*//;
#		print "Got: $_\n";
		if (/(.*)$dlm\s*$/) {
			$val .= $1;
			return $val;
		}
		$val .= $_;
	}
	printf STDERR "Line $.: EOF in {block}\n";
	$val;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# This takes care of the cruft necessary to keep $Line and $ARGV  set #
# to the correct thing for error messages.                            #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub newfile {
	print "Close $ARGV.\n";
	close(ARGV);
#	$Line = 0;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#   &syntax(name)                                                     #
# This registers the type of the named variable.  The type is one  or #
# more tokens in @t.                                                  #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub syntax {
	local($name) = @_;
	local($type,$i);
	$type = shift @t;
	if ($type eq 'INTEGER') {
		if ($t[0] eq $LP) {	# INTEGER ( x .. y )
			$i = &findstr($RP);
			splice(@t,0,$i+1);	# Discard them.
		} elsif ($t[0] eq $LB) {	# INTEGER { x .. y }
			$i = &findstr($RB);
			splice(@t,0,$i+1);	# Discard them.
		}
	} elsif ($type eq 'OBJECT') {
		if ($t[0] eq 'IDENTIFIER') {
			$type = 'OBJID';
			shift @t;
		}
	} elsif ($type eq 'OCTET') {
		if ($t[0] eq 'STRING') {
			$type = 'STRING';
			shift @t;
		}
	} elsif ($type eq 'DisplayString') {
		if ($t[0] eq $LP) {	# DisplayString ( x .. y )
			$i = &findstr($RP);
			splice(@t,0,$i+1);	# Discard them.
		}
	} elsif ($type eq 'Sequence' || $type eq 'SEQUENCE') {
		if ($t[0] eq 'of' || $t[0] eq 'OF') {
			shift @t;	# Delete the 'of'.
			shift @t;	# Delete the type.
		}
	}
	$type{$name} = $type;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#   &tok(n)                                                           #
# Read in enough to make sure that there at least n tokens in the  @t #
# list;  return the number of tokens in @t, or zero for failure if we #
# are at EOF and there aren't n tokens left.                          #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub tok {
	local($n) = @_;
	local($line,@line,$s);
	while (@t < $n) {
		close(ARGV) if eof;
		$line = <> 
			|| return 0;	# EOF.
		if (++$Line == 1) {
			printf "File $ARGV:\n";
		}
		while ($line) {
			$line =~ s/^\s+//;	# Strip off initial white stuff.
			last if !$line;
			if ($line =~ s/^--.*//) {
				last;
			}
			if (substr($line,0,1) eq '"') {	# Quoted string.
				if ($line =~ s/^"(.*)"\n//) {	# Complete on this line.
					$s = $1;
				} elsif ($line =~ s/^"(.*)//) {	# Incomplete.
					$s = $1;
					$s .= &getblock('"');
				}
				@t = (@t , $s);
				next;
			}
			if ($line =~ s/^$psym//) {	# Symbolic name.
				@t = (@t , $1);
				next;
			}
			if ($line =~ s/^$pnum//) {	# Number.
				@t = (@t , $1);
				next;
			}
			if ($line =~ s/^([(){};,])\s*//) {	# Assorted punctuation.
				@t = (@t , $1);
				next;
			}
			if ($line =~ s/^(::=)\s*//) {	# BNF definition.
				@t = (@t , $1);
				next;
			}
			if ($line =~ s/^(\.\.)\b//) {	# BNF definition.
				@t = (@t , $1);
				next;
			}
		}
	}
	return scalar(@t);
}