From b99b7a6ba563affc82c263df5914f204405a3184 Mon Sep 17 00:00:00 2001 From: Jacob Bachmeyer Date: Wed, 2 Nov 2022 21:19:00 -0500 Subject: [PATCH] Add structured exception for directive syntax errors This also improves the reporting of these errors, with a highlight line inserted for each error encountered, in context. --- gatekeeper.pl | 55 ++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 46 insertions(+), 9 deletions(-) diff --git a/gatekeeper.pl b/gatekeeper.pl index ec23cef..d4d3f46 100755 --- a/gatekeeper.pl +++ b/gatekeeper.pl @@ -548,6 +548,16 @@ BEGIN { } } +{ + package Local::Exception::directive_syntax; + {our @ISA = qw(Local::Exception)} + + sub trace { (shift)->{trace} } + + sub trace_msg + { return join("\n", map join(': ', @$_), @{(shift)->{trace}})."\n" } +} + =item throw $type => ($key => $value)... Throw a TYPE exception, with further options specified as key/value pairs. @@ -1675,6 +1685,8 @@ sub interpret_directive { my $directive_file_contents = shift; # temporary scaffold my @errors; + my @trace; + my $version_error; my %options = ( replace => undef ); my %header = ( version => undef, options => \%options, @@ -1692,31 +1704,39 @@ sub interpret_directive { if ($versions[0][1] =~ /^(\d+\.\d+)$/) { my $val = $1; # so far so good - # We only support version 1.1/1.2 right now! - push @errors, "invalid version $val, not supported" - if (($val ne '1.1') and ($val ne '1.2')); - $header{version} = $val; # TODO: parse? } else { # version value does not match required pattern push @errors, "invalid version $versions[0][1]"; + $version_error = 'invalid version'; } } elsif (scalar @versions > 1) { push @errors, "invalid multiple version elements"; + $version_error = 'multiple version elements'; } else { # no version at all; no longer allowed push @errors, "no version specified in directive"; } } + if ($header{version} + && $header{version} ne '1.1' && $header{version} ne '1.2') { + push @errors, "invalid version $header{version}, not supported"; + $version_error = 'unsupported version'; + } + foreach my $item (@$directive) { my $tainted_cmd = lc $item->[0]; my $tainted_val = $item->[1]; + push @trace, $item; + if (!$tainted_val && !($tainted_cmd =~ m/^comment|^no-op/)) { push @errors, "invalid $tainted_cmd element with no value"; + push @trace, [' ^--', 'element with no value']; } elsif ($tainted_cmd eq 'directory') { unless ($tainted_val =~ m/^($RE_filename_relative)$/) { push @errors, "invalid directory $tainted_val"; + push @trace, [' ^--', 'this directory name is invalid']; next; } my $val = $1; # so far so good @@ -1727,6 +1747,7 @@ sub interpret_directive { # A couple of subdir levels are ok, but don't allow hundreds. if ($dir_depth > MAX_DIRECTORY_DEPTH) { push @errors, "$dir_depth levels is too deep, in $val"; + push @trace, [' ^--', 'this directory name is nested too deeply']; next; } @@ -1735,6 +1756,7 @@ sub interpret_directive { push @errors, "Only one directory directive is allowed per directive file. " ."Error at directory directive: $val"; + push @trace, [' ^--', 'second directory element found here']; next; } @@ -1745,6 +1767,7 @@ sub interpret_directive { # We use the same filename restrictions as scan_incoming unless ($tainted_val =~ /^($RE_filename_here)$/) { push @errors, "invalid filename $tainted_val"; + push @trace, [' ^--', 'this filename is invalid']; next; } my $val = $1; # so far so good @@ -1754,16 +1777,20 @@ sub interpret_directive { push @errors, "Only one filename directive is allowed per directive file. " ."Error at filename directive: $val."; + push @trace, [' ^--', 'second filename element found here']; next; } $header{filename} = $val; } elsif ($tainted_cmd eq 'version') { - # already handled above + # already handled above; insert any error into the trace + push @trace, [' ^--', $version_error] if $version_error; } elsif ($tainted_cmd eq 'symlink') { unless ($tainted_val =~ /^($RE_filename_relative)\s+($RE_filename_relative)$/) { push @errors, "invalid parameters for symlink command: $tainted_val"; + push @trace, + [' ^--', 'invalid parameters here; need TARGET and LINKNAME']; next; } # $1 -- link target $2 -- link name @@ -1771,6 +1798,8 @@ sub interpret_directive { } elsif ($tainted_cmd eq 'rmsymlink') { unless ($tainted_val =~ /^($RE_filename_relative)$/) { push @errors, "invalid parameters for rmsymlink command: $tainted_val"; + push @trace, + [' ^--', 'invalid parameter here; need relative filename']; next; } push @ops, [rmsymlink => $1]; @@ -1778,6 +1807,8 @@ sub interpret_directive { unless ($tainted_val =~ /^($RE_filename_relative)$/) { push @errors, "invalid parameters for archive command: $tainted_val"; + push @trace, + [' ^--', 'invalid parameter here; need relative filename']; next; } push @ops, [archive => $1]; @@ -1786,12 +1817,15 @@ sub interpret_directive { unless ($tainted_val =~ /^(true|false)$/) { push @errors, "invalid parameters for replace command: $tainted_val"; + push @trace, + [' ^--', 'invalid parameter here; need "true" or "false"']; next; } if ($header{version} eq '1.1') { push @errors, "invalid directive 'replace', not supported prior to version 1.2"; + push @trace, [' ^--', 'this element was introduced in version 1.2']; next; } @@ -1803,6 +1837,7 @@ sub interpret_directive { push @ops, ['no-op']; } else { push @errors, "Invalid directive line:\n\n $tainted_cmd $tainted_val"; + push @trace, [' ^--', 'this element is not recognized']; } if (!defined($install) @@ -1821,9 +1856,9 @@ sub interpret_directive { } if (@errors) { - # TODO: eventually report all errors found - # for now, just report the first error, to emulate an immediate fatal() - fatal($errors[0],1,$directive_file_contents); + ftp_syslog('err', $errors[0]); + throw directive_syntax => + trace => \@trace, summary => $errors[0]; } return \@ops; @@ -2529,8 +2564,10 @@ foreach my $packet (@packets) { # each list element is an array reference } # If a send_to_user key is set, then this came from a call to fatal(). - if (defined $E->{send_to_user}) { + if (defined $E->{send_to_user}) { # scaffolding for now mail($E->{message},$E->{send_to_user}); + } elsif ($E->type_p('directive_syntax')) { + mail(join("\n",$E->{summary},'',$E->trace_msg),1); } } else { # Exceptions thrown by perl itself come out as strings -- 2.25.1