abnf.cgi.in

#!/usr/bin/perl
#
# Quick hack to get my abnf parser on the web.
# Bill Fenner <fenner@fenron.com> 23 June 2004
#
use CGI qw/:standard/;
use File::Temp;
use strict;

print header;
print start_html("Bill's ABNF Parser"), h1("Bill's ABNF Parser");
if (param("abnf")) {
	my $abnf = param("abnf");
	$abnf =~ s/\r\n/\n/gm;	# HTTP might use \r\n line seperators
	my ( $orig, $tmpabnf ) = mkstemps( "/tmp/abnf-origXXXXXX", ".txt" );
	my ( $parsed, $tmpparsed ) = mkstemps( "/tmp/abnf-parsedXXXXXX", ".txt" );
	my ( $prepped, $tmpprepped ) = mkstemps( "/tmp/abnf-preppedXXXXXX", ".txt" );
	print $orig $abnf, "\n";
	close($orig);
	my $rfc7405 = param("rfc7405");
	my $rfc7405arg = "";
	if ($rfc7405 eq "expected") {
		$rfc7405arg = "-o RFC7405";
	} elsif ($rfc7405 eq "no") {
		$rfc7405arg = "-o ~RFC7405";
	}
	open(ERRORS, "@WEBBINDIR@/bap $rfc7405arg < $tmpabnf 2>&1 >$tmpparsed |");
	my @errors = <ERRORS>;
	close(ERRORS);
	if (@errors) {
		print h1("Errors during parsing:");
		print p("Errors are noted by line number and column, e.g. line:column: Something bad.");
		my @lines = split(/\n/, $abnf);
		my $numlines = @lines;
		my $numwidth = length(sprintf("%d", $numlines));
		# XXX I don't think "use CGI" wants me to output my own markup
		print "<pre>\n";
		foreach my $error (@errors) {
			if ($error =~ /^(\d+):(\d+):/) {
				my $line = $1;
				my $col = $2;
				if ($lines[$line - 1]) {
					my $lastline = $line;
					# Column 0 might mean the end of the
					# previous line, so make sure that
					# we get that.
					if ($col == 0) {
						$line--;
					}
					while ($line > 1 && $lines[$line - 1] =~ /^(\s|$)/) {
						$line--;
					}
					while ($line <= $lastline) {
						printf("%${numwidth}d: %s\n", $line, htmlify($lines[$line - 1]));
						$line++;
					}
					print " " x ($col + $numwidth + 1), "^\n";
				}
			}
			print htmlify($error);
			if ($error =~ /on line (\d+)/) {
				my $line = $1;
				# This one is the beginning of the rule.
				my $lastline = $line;
				while ($lastline < $#lines && $lines[$lastline] =~ /^(\s|$)/) {
					$lastline++;
				}
				while ($line <= $lastline) {
					printf("%${numwidth}d: %s\n", $line, htmlify($lines[$line - 1]));
					$line++;
				}
			}
			print "\n";
		}
		print "</pre>\n";
	} else {
		print h1("No errors during parsing.");
	}
	# XXX
	system("@WEBBINDIR@/prep $tmpabnf > $tmpprepped");
	print h1("Differences between original and Bill's \"canonical\":");
	print p("There should be very few differences here.  The \"canonical\" output may change 0*1(foo) to [foo], or other equivalences.  If there are any parenthesis added, examine carefully what they surround, as they represent the default concatenation near an alternation which may not not be what you mean.  The original has been processed to facilitate comparison; the processing shouldn't change valid ABNF but can make certain invalid constructs look more invalid.");
	open(DIFF, "@WEBDIFF@ $tmpprepped $tmpparsed |");
	print <DIFF>;
	close(DIFF);
	foreach my $file ( $tmpabnf, $tmpparsed, $tmpprepped ) {
		unlink( $file );
	}
}
print hr, start_form, p("Enter ABNF Here:");
print textarea('abnf', '', 20, 80);
print br;
print radio_group(-name=>'rfc7405', -values=>['expected','warn','no'], -default=>'warn', -labels=>{'expected'=>'This uses RFC7405', 'warn'=>'Warn if this uses RFC7405', 'no'=>'Using RFC7405 is an error'}, -columns=>1, -colheaders=>['Uses RFC7405?']);
print br, submit, end_form, hr;
print end_html, "\n";

sub htmlify($) {
	my($line) = shift;

	$line =~ s/&/\&amp;/g;
	$line =~ s/>/\&gt;/g;
	$line =~ s/</\&lt;/g;
	$line;
}