Add helper procedures for directive handling in gatekeeper

diff --git a/gatekeeper.pl b/gatekeeper.pl
index 7fba45d7a445376833c6c6e23ac8eb9fc767d9b9..54c762b52e51b91f54e2ba796ad8c69bdf019fc0 100755 (executable)
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -769,7 +769,7 @@ sub fatal {
 
 \f
 #
-# - 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];
+}
+
 \f
 #
 # - [SC] Scan for incoming packets