my $directive_file_contents = '';
my @lines = ();
- open (DIRECTIVE_FILE, "<", $directive_file)
+ open DIRECTIVE_FILE, '<', $directive_file
or ftp_abort("FATAL: open($directive_file) failed: $!");
$directive_file_contents = join('', (@lines = <DIRECTIVE_FILE>));
- close (DIRECTIVE_FILE) or ftp_warn("close($directive_file) failed: $!");
+ seek DIRECTIVE_FILE, 0, 0
+ or ftp_abort("FATAL: seek($directive_file) failed: $!");
+ my $directive = read_directive(*DIRECTIVE_FILE{IO});
+ close DIRECTIVE_FILE
+ or ftp_warn("close($directive_file) failed: $!");
# If we don't know whose project this file belongs to, because the
# 'directory:' line is messed up or not there, we'd still like to let the
# archive/create symlinks/remove symlinks
my $filename_required = 1;
- foreach my $line (@lines) {
- $line =~ s/\r\n/\n/g; # deal with dos-based line endings...
- $line =~ s/\s+$/\n/; # Some people like to put spaces after their commands
- $line =~ s/^\s+//; # Or even *before* their commands
- last if ($line =~ /^-----BEGIN PGP SIGNATURE/);
- if ($line =~ /^-----BEGIN PGP SIGNED MESSAGE-----$/) {
- $signed = 1;
- next;
- }
- next if ($line =~ /^Hash:/);
- next if ($line =~ /^\s*$/);
- # Just make sure we don't parse any lines that are NOT part of the
- # signed message! GPG will make sure that a line that looks like
- # "-----BEGIN PGP SIGNED MESSAGE-----" will be escaped.
- next if (!$signed);
-
+ foreach my $item (@$directive) {
+ my $tainted_cmd = lc $item->[0];
+ my $tainted_val = $item->[1];
- my ($tainted_cmd,$tainted_val) = split(' ',$line,2);
- if ($tainted_cmd =~ /^Directory:?$/i) {
+ if ($tainted_cmd eq 'directory') {
parse_directory_line($tainted_val, $directive_file_contents,0);
- } elsif ($tainted_cmd =~ /^Filename:?$/i) {
+ } elsif ($tainted_cmd eq 'filename') {
# We use the same filename restrictions as scan_incoming
$tainted_val =~ /^($RE_filename_here)$/
or fatal("invalid filename $tainted_val",1,$directive_file_contents);
if exists $info{"filename"};
$info{"filename"} = {"value" => $val, "order" => $cnt++}; # ok.
- } elsif ($tainted_cmd =~ /^Version:?$/i) {
+ } elsif ($tainted_cmd eq 'version') {
$tainted_val =~ /^(\d+\.\d+)$/
or fatal("invalid version $tainted_val",1,$directive_file_contents);
my $val = $1; # so far so good
if exists $info{"version"};
$info{"version"} = $val; #ok.
- } elsif ($tainted_cmd =~ /^symlink:?$/i) {
+ } elsif ($tainted_cmd eq 'symlink') {
$tainted_val =~ /^($RE_filename_relative)\s+($RE_filename_relative)$/
or fatal("invalid parameters for symlink command: $tainted_val",
1,$directive_file_contents);
# $1 -- link target $2 -- link name
$info{"symlink-$1"} = {"link" => $2, "order" => $cnt++}; #ok.
- } elsif ($tainted_cmd =~ /^rmsymlink:?$/i) {
+ } elsif ($tainted_cmd eq 'rmsymlink') {
$tainted_val =~ /^($RE_filename_relative)$/
or fatal("invalid parameters for rmsymlink command: $tainted_val",
1,$directive_file_contents);
$info{"rmsymlink-$1"} = {"order" => $cnt++}; #ok.
- } elsif ($tainted_cmd =~ /^archive:?$/i) {
+ } elsif ($tainted_cmd eq 'archive') {
$tainted_val =~ /^($RE_filename_relative)$/
or fatal("invalid parameters for archive command: $tainted_val",
1,$directive_file_contents);
$info{"archive-$1"} = {"order" => $cnt++}; #ok.
- } elsif ($tainted_cmd =~ /^replace:?$/i) {
+ } elsif ($tainted_cmd eq 'replace') {
# This command is only supported from v1.2
$tainted_val =~ /^(true|false)$/
or fatal("invalid parameters for replace command: $tainted_val",
1,$directive_file_contents);
$info{"replace"} = $1; #ok.
- } elsif ($tainted_cmd =~ /^comment:?$/i) {
+ } elsif ($tainted_cmd eq 'comment') {
# Comments are ok, we ignore them
- } elsif (IN_TEST_MODE && $tainted_cmd =~ /^no-op:?$/i) {
+ } elsif (IN_TEST_MODE && $tainted_cmd eq 'no-op') {
# The testsuite uses a no-op command to validate directive processing.
$info{'no-op'} = {order => $cnt++};
} else {