From a96893313398cd471167646c80474fff8cc925ae Mon Sep 17 00:00:00 2001
From: Jacob Bachmeyer <jcb@gnu.org>
Date: Sat, 8 Oct 2022 22:08:42 -0500
Subject: [PATCH] Collect file name validation patterns

This results in some small semantic changes:  the new patterns are
stricter in handling symlink arguments and slightly looser for the
directory line.  However, this improves consistency, since the old
patterns could imply directories that could not be directly named.
---
 gatekeeper.pl | 33 +++++++++++++++++++++++++++------
 1 file changed, 27 insertions(+), 6 deletions(-)

diff --git a/gatekeeper.pl b/gatekeeper.pl
index 5d18b48..bef37b6 100755
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -439,6 +439,27 @@ if (IN_TEST_MODE) {
 openlog(SYSLOG_APP_IDENT, 'pid', SYSLOG_FACILITY);
 ftp_syslog('info', "Beginning upload processing run.");
 
+#
+# -- Filename validation patterns
+#
+
+# Directives use POSIX-style filenames, regardless of what platform we are
+# actually running on, even though this tool expects to be run on the GNU
+# system, which uses POSIX filename syntax.
+require File::Spec::Unix;	# ensure that File::Spec::Unix is loaded
+# note that loading File::Spec earlier almost certainly made this a no-op
+
+# regex matching an acceptable filename in "this" directory
+#  must begin with alphanumeric, underscore, or plus sign
+#  and contain only those characters, plus hyphen, dot, and tilde
+#  note that an acceptable filename may not begin with dot, so ".." is out
+my $RE_filename_here = qr/[[:alnum:]_+][-.[:alnum:]_+~]*/;
+# regex matching an acceptable relative filename
+#  all components must be acceptable filenames
+#  empty components are not allowed
+#  a trailing slash is not allowed
+my $RE_filename_relative = qr[$RE_filename_here(?:/$RE_filename_here)*];
+
 #
 # -- Configuration sanity check
 #
@@ -835,7 +856,7 @@ sub scan_incoming {
   while (my $tainted_ent = readdir (INCOMING)) {
     # don't look at files with a leading dot or dash, but allow those chars
     # subsequently.  Omit files containing any other weird characters.
-    next unless $tainted_ent =~ /^([\w_+][-.\w_+~]*)$/;
+    next unless $tainted_ent =~ /^($RE_filename_here)$/;
     my $ent = $1;
 
     # Don't look at files with really long names, either.
@@ -1022,7 +1043,7 @@ sub parse_directory_line {
   # Can't let it start with  - . /  or contain strange characters.
   # This disallows .. as a file name component since no component
   # can start with a . at all.
-  $tainted_val =~ m,^(\w[-.\w]*(/\w[-.\w]*)*)$,
+  $tainted_val =~ m,^($RE_filename_relative)$,
     or fatal("invalid directory $tainted_val\n$directive_file_contents",
 	     1,$directive_file_contents);
   my $val = $1;  # so far so good
@@ -1191,7 +1212,7 @@ sub read_directive_file {
       parse_directory_line($tainted_val, $directive_file_contents,0);
     } elsif ($tainted_cmd =~ /^Filename:?$/i) {
       # We use the same filename restrictions as scan_incoming
-      $tainted_val =~ /^([\w_+][-.\w_+~]*)$/
+      $tainted_val =~ /^($RE_filename_here)$/
 	or fatal("invalid filename $tainted_val",1,$directive_file_contents);
       my $val = $1;  # so far so good
 
@@ -1217,7 +1238,7 @@ sub read_directive_file {
 
       $info{"version"} = $val; #ok.
     } elsif ($tainted_cmd =~ /^symlink:?$/i) {
-      $tainted_val =~ /^([\w_+][-.\w_+\/]*)\s+([\w_+][-.\w_+\/]*)$/
+      $tainted_val =~ /^($RE_filename_relative)\s+($RE_filename_relative)$/
 	or fatal("invalid parameters for symlink command: $tainted_val",
 		 1,$directive_file_contents);
       my ($target,$link) = ($1,$2);  # so far so good
@@ -1226,7 +1247,7 @@ sub read_directive_file {
 	if ($target =~ /\.\./ || $link =~ /\.\./);
       $info{"symlink-$target"} = {"link" => $link, "order" => $cnt++}; #ok.
     } elsif ($tainted_cmd =~ /^rmsymlink:?$/i) {
-      $tainted_val =~ /^([\w_+][-.\w_+\/]*)$/
+      $tainted_val =~ /^($RE_filename_relative)$/
 	or fatal("invalid parameters for rmsymlink command: $tainted_val",
 		 1,$directive_file_contents);
       my $val = $1;  # so far so good
@@ -1235,7 +1256,7 @@ sub read_directive_file {
 	if ($val =~ /\.\./);
       $info{"rmsymlink-$1"} = {"order" => $cnt++}; #ok.
     } elsif ($tainted_cmd =~ /^archive:?$/i) {
-      $tainted_val =~ /^([\w_+][-.\w_+\/]*)$/
+      $tainted_val =~ /^($RE_filename_relative)$/
 	or fatal("invalid parameters for archive command: $tainted_val",
 		 1,$directive_file_contents);
       my $val = $1;  # so far so good
-- 
2.25.1