From: Jacob Bachmeyer Date: Tue, 18 Oct 2022 02:06:20 +0000 (-0500) Subject: Factor element-processing loop out of read_directive_file X-Git-Url: https://vcs.fsf.org/?a=commitdiff_plain;h=59d0f34e9384cf9450911a790543584f978e05c1;p=gatekeeper.git Factor element-processing loop out of read_directive_file --- diff --git a/gatekeeper.pl b/gatekeeper.pl index 58002b2..b45c806 100755 --- a/gatekeeper.pl +++ b/gatekeeper.pl @@ -1267,48 +1267,21 @@ sub verify_keyring { # We assume DIRECTIVE_FILE is clear-signed (gpg --clearsign). Among # other things, this lets us use gpgv everywhere, for paranoia's sake. # -sub read_directive_file { - my $directive_file = shift; - my $uploaded_file = shift; - my $directive_only = shift; - # For debugging purposes, see below - my $directive_file_contents = ''; - my @lines = (); - open DIRECTIVE_FILE, '<', $directive_file - or ftp_abort("FATAL: open($directive_file) failed: $!"); - $directive_file_contents = join('', (@lines = )); - 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 - # uploader know something went wrong. So let's see if we can match the - # directive file signature against one of our public keyrings. - my @tmp_keyrings; - open(TMP,"/usr/bin/find $package_config_base -name pubring.gpg|"); - while() { - chomp(); - push(@tmp_keyrings,$_); - } - close(TMP); - my $tmp_retval = verify_keyring($directive_file,$directive_file_contents, - @tmp_keyrings); - push(@{$info{email}},$1) - if ($tmp_retval =~ /Good signature from .*?<(.*?)>/); - my $cnt = 0; # Keep track of the order of directives... - my $signed = 0; - # If there is a command in the directive that doesn't require an actual - # file to work on, we won't require the filename line in the directive - # file. This will allow people to upload a directive file only to - # archive/create symlinks/remove symlinks - my $filename_required = 1; +# As temporary scaffolding, also sets the %info quasi-global. +sub interpret_directive { + my $directive = shift; # presumed tainted + my $directive_file_contents = shift; # temporary scaffold + + my %header = ( package => undef, directory => undef, version => undef ); + my @ops; + my $have_install = 0; # can only install one file per directive + my $filename; + my $cnt = 0; # TODO: remove this foreach my $item (@$directive) { my $tainted_cmd = lc $item->[0]; @@ -1316,6 +1289,8 @@ sub read_directive_file { if ($tainted_cmd eq 'directory') { parse_directory_line($tainted_val, $directive_file_contents,0); + $header{directory} = $info{directory}; + $header{package} = $info{package}; } elsif ($tainted_cmd eq 'filename') { # We use the same filename restrictions as scan_incoming $tainted_val =~ /^($RE_filename_here)$/ @@ -1327,6 +1302,7 @@ sub read_directive_file { ."Error at filename directive: $val.",1,$directive_file_contents) if exists $info{"filename"}; + $filename = $val; $info{"filename"} = {"value" => $val, "order" => $cnt++}; # ok. } elsif ($tainted_cmd eq 'version') { $tainted_val =~ /^(\d+\.\d+)$/ @@ -1342,28 +1318,33 @@ sub read_directive_file { 1,$directive_file_contents) if exists $info{"version"}; + $header{version} = $val; # TODO: parse? $info{"version"} = $val; #ok. } 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 + push @ops, [symlink => $1, $2]; $info{"symlink-$1"} = {"link" => $2, "order" => $cnt++}; #ok. } elsif ($tainted_cmd eq 'rmsymlink') { $tainted_val =~ /^($RE_filename_relative)$/ or fatal("invalid parameters for rmsymlink command: $tainted_val", 1,$directive_file_contents); + push @ops, [rmsymlink => $1]; $info{"rmsymlink-$1"} = {"order" => $cnt++}; #ok. } elsif ($tainted_cmd eq 'archive') { $tainted_val =~ /^($RE_filename_relative)$/ or fatal("invalid parameters for archive command: $tainted_val", 1,$directive_file_contents); + push @ops, [archive => $1]; $info{"archive-$1"} = {"order" => $cnt++}; #ok. } 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); + push @ops, [set => replace => ($1 eq 'true')]; $info{"replace"} = $1; #ok. } elsif ($tainted_cmd eq 'comment') { # Comments are ok, we ignore them @@ -1374,7 +1355,51 @@ sub read_directive_file { fatal("Invalid directive line:\n\n $tainted_cmd $tainted_val", 1,$directive_file_contents); } + + if (!$have_install && $filename && defined $header{directory}) + { push @ops, [install => $filename]; $have_install = 1 } + } + + unshift @ops, [header => \%header]; + + return \@ops; +} + +sub read_directive_file { + my $directive_file = shift; + my $uploaded_file = shift; + my $directive_only = shift; + + # For debugging purposes, see below + my $directive_file_contents = ''; + + open DIRECTIVE_FILE, '<', $directive_file + or ftp_abort("FATAL: open($directive_file) failed: $!"); + $directive_file_contents = join('', ); + 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 + # uploader know something went wrong. So let's see if we can match the + # directive file signature against one of our public keyrings. + my @tmp_keyrings; + open(TMP,"/usr/bin/find $package_config_base -name pubring.gpg|"); + while() { + chomp(); + push(@tmp_keyrings,$_); } + close(TMP); + + my $tmp_retval = verify_keyring($directive_file,$directive_file_contents, + @tmp_keyrings); + push(@{$info{email}},$1) + if ($tmp_retval =~ /Good signature from .*?<(.*?)>/); + + my @ops = interpret_directive($directive, $directive_file_contents); if (exists($info{"replace"}) && ($info{"version"} eq '1.1')) { fatal("invalid directive 'replace', not supported prior to version 1.2", @@ -1398,6 +1423,12 @@ sub read_directive_file { fatal("no directory directive specified in $directive_file",1); } + # If there is a command in the directive that doesn't require an actual + # file to work on, we won't require the filename line in the directive + # file. This will allow people to upload a directive file only to + # archive/create symlinks/remove symlinks + my $filename_required = 1; + # There are a few possibilities regarding the 'filename' directive # 1. It exists in the directive file - there is no problem # 2. It doesn't exist in the directive file