From 92647b93192036f6d65d5bf0db4d8a2175c27095 Mon Sep 17 00:00:00 2001 From: Jacob Bachmeyer Date: Sat, 15 Oct 2022 22:16:16 -0500 Subject: [PATCH] Add helper procedures for directive handling in gatekeeper --- gatekeeper.pl | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 60 insertions(+), 1 deletion(-) diff --git a/gatekeeper.pl b/gatekeeper.pl index 7fba45d..54c762b 100755 --- a/gatekeeper.pl +++ b/gatekeeper.pl @@ -769,7 +769,7 @@ sub fatal { # -# - Directive reader +# - Directive reader and parsing helpers # =item $directive = read_directive ( $handle ) @@ -842,6 +842,65 @@ sub read_directive_from_file { return $records; } +=item @values = find_directive_elements ( $directive, $key ) + +Search the DIRECTIVE arrayref for KEY elements and return their associated +values. An empty list is returned if no KEY elements are found in +DIRECTIVE. The KEY comparison is case-insensitive. + +The values returned from this procedure are tainted. + +=cut + +sub find_directive_elements { + my $directive = shift; + my $key = lc shift; + + return map $_->[1], grep lc($_->[0]) eq $key, @$directive; +} + +=item $directory = find_directory ( $directive ) + +Extract the destination directory name from the parsed DIRECTIVE arrayref. +An exception is thrown if DIRECTIVE does not contain exactly one +"directory" element or if the value of that element is not acceptable. + +The value returned from this procedure is untainted. + +=cut + +sub find_directory { + my $directive = shift; + + my @values = find_directive_elements($directive, 'directory'); + + die "Only one directory directive is allowed per directive file." + if scalar @values > 1; + die "no directory directive specified" + unless @values; + + die "invalid directory $values[0]" + unless $values[0] =~ m/^($RE_filename_relative)$/; + + return $values[0]; +} + +=item $package = find_package ( $directive ) + +Extract the package name from the parsed DIRECTIVE arrayref. An exception +is thrown if DIRECTIVE does not contain exactly one "directory" element or +if the value of that element is not a relative file name. + +The value returned from this procedure is untainted. + +=cut + +sub find_package { + # The package name is the first directory named in the directory element. + my @dirs = File::Spec::Unix->splitdir(find_directory(@_)); + return $dirs[0]; +} + # # - [SC] Scan for incoming packets -- 2.25.1