Merge pull request #1506 from NixOS/ipc

Stop shelling out

.perlcriticrc

@@ -2,3 +2,9 @@ theme = community
 
 # 5 is the least complainy, 1 is the most complainy
 severity = 1
+
+# Disallow backticks - use IPC::Run3 instead for better security
+include = InputOutput::ProhibitBacktickOperators
+
+# Prohibit shell-invoking system() and exec() - use list form or IPC::Run3 instead
+include = Hydra::ProhibitShellInvokingSystemCalls

src/lib/Hydra/Controller/API.pm

@@ -14,6 +14,7 @@ use Text::Diff;
 use IPC::Run qw(run);
 use Digest::SHA qw(hmac_sha256_hex);
 use String::Compare::ConstantTime qw(equals);
+use IPC::Run3;
 
 
 sub api : Chained('/') PathPart('api') CaptureArgs(0) {
@@ -218,8 +219,13 @@ sub scmdiff : Path('/api/scmdiff') Args(0) {
     } elsif ($type eq "git") {
         my $clonePath = getSCMCacheDir . "/git/" . sha256_hex($uri);
         die if ! -d $clonePath;
-        $diff .= `(cd $clonePath; git --git-dir .git log $rev1..$rev2)`;
-        $diff .= `(cd $clonePath; git --git-dir .git diff $rev1..$rev2)`;
+        my ($stdout1, $stderr1);
+        run3(['git', '-C', $clonePath, 'log', "$rev1..$rev2"], \undef, \$stdout1, \$stderr1);
+        $diff .= $stdout1 if $? == 0;
+
+        my ($stdout2, $stderr2);
+        run3(['git', '-C', $clonePath, 'diff', "$rev1..$rev2"], \undef, \$stdout2, \$stderr2);
+        $diff .= $stdout2 if $? == 0;
     }
 
     $c->stash->{'plain'} = { data => (scalar $diff) || " " };

src/lib/Hydra/Controller/Build.pm

@@ -13,6 +13,8 @@ use Data::Dump qw(dump);
 use List::SomeUtils qw(all);
 use Encode;
 use JSON::PP;
+use IPC::Run qw(run);
+use IPC::Run3;
 use WWW::Form::UrlEncoded::PP qw();
 
 use feature 'state';
@@ -348,19 +350,21 @@ sub contents : Chained('buildChain') PathPart Args(1) {
 
     notFound($c, "Product $path has disappeared.") unless -e $path;
 
-    # Sanitize $path to prevent shell injection attacks.
-    $path =~ /^\/[\/[A-Za-z0-9_\-\.=+:]+$/ or die "Filename contains illegal characters.\n";
-
-    # FIXME: don't use shell invocations below.
-
     # FIXME: use nix store cat
 
     my $res;
 
     if ($product->type eq "nix-build" && -d $path) {
         # FIXME: use nix ls-store -R --json
-        $res = `cd '$path' && find . -print0 | xargs -0 ls -ld --`;
-        error($c, "`ls -lR' error: $?") if $? != 0;
+        # We need to use a pipe between find and xargs, so we'll use IPC::Run
+        my $error;
+        # Run find with absolute path and post-process to get relative paths
+        my $success = run(['find', $path, '-print0'], '|', ['xargs', '-0', 'ls', '-ld', '--'], \$res, \$error);
+        error($c, "`find $path -print0 | xargs -0 ls -ld --' error: $error") unless $success;
+
+        # Strip the base path to show relative paths
+        my $escaped_path = quotemeta($path);
+        $res =~ s/^(.*\s)$escaped_path(\/|$)/$1.$2/mg;
 
         #my $baseuri = $c->uri_for('/build', $c->stash->{build}->id, 'download', $product->productnr);
         #$baseuri .= "/".$product->name if $product->name;
@@ -368,34 +372,59 @@ sub contents : Chained('buildChain') PathPart Args(1) {
     }
 
     elsif ($path =~ /\.rpm$/) {
-        $res = `rpm --query --info --package '$path'`;
-        error($c, "RPM error: $?") if $? != 0;
+        my ($stdout1, $stderr1);
+        run3(['rpm', '--query', '--info', '--package', $path], \undef, \$stdout1, \$stderr1);
+        error($c, "RPM error: $stderr1") if $? != 0;
+        $res = $stdout1;
+
         $res .= "===\n";
-        $res .= `rpm --query --list --verbose --package '$path'`;
-        error($c, "RPM error: $?") if $? != 0;
+
+        my ($stdout2, $stderr2);
+        run3(['rpm', '--query', '--list', '--verbose', '--package', $path], \undef, \$stdout2, \$stderr2);
+        error($c, "RPM error: $stderr2") if $? != 0;
+        $res .= $stdout2;
     }
 
     elsif ($path =~ /\.deb$/) {
-        $res = `dpkg-deb --info '$path'`;
-        error($c, "`dpkg-deb' error: $?") if $? != 0;
+        my ($stdout1, $stderr1);
+        run3(['dpkg-deb', '--info', $path], \undef, \$stdout1, \$stderr1);
+        error($c, "`dpkg-deb' error: $stderr1") if $? != 0;
+        $res = $stdout1;
+
         $res .= "===\n";
-        $res .= `dpkg-deb --contents '$path'`;
-        error($c, "`dpkg-deb' error: $?") if $? != 0;
+
+        my ($stdout2, $stderr2);
+        run3(['dpkg-deb', '--contents', $path], \undef, \$stdout2, \$stderr2);
+        error($c, "`dpkg-deb' error: $stderr2") if $? != 0;
+        $res .= $stdout2;
     }
 
     elsif ($path =~ /\.(tar(\.gz|\.bz2|\.xz|\.lzma)?|tgz)$/ ) {
-        $res = `tar tvfa '$path'`;
-        error($c, "`tar' error: $?") if $? != 0;
+        my ($stdout, $stderr);
+        run3(['tar', 'tvfa', $path], \undef, \$stdout, \$stderr);
+        error($c, "`tar' error: $stderr") if $? != 0;
+        $res = $stdout;
     }
 
     elsif ($path =~ /\.(zip|jar)$/ ) {
-        $res = `unzip -v '$path'`;
-        error($c, "`unzip' error: $?") if $? != 0;
+        my ($stdout, $stderr);
+        run3(['unzip', '-v', $path], \undef, \$stdout, \$stderr);
+        error($c, "`unzip' error: $stderr") if $? != 0;
+        $res = $stdout;
     }
 
     elsif ($path =~ /\.iso$/ ) {
-        $res = `isoinfo -d -i '$path' && isoinfo -l -R -i '$path'`;
-        error($c, "`isoinfo' error: $?") if $? != 0;
+        # Run first isoinfo command
+        my ($stdout1, $stderr1);
+        run3(['isoinfo', '-d', '-i', $path], \undef, \$stdout1, \$stderr1);
+        error($c, "`isoinfo' error: $stderr1") if $? != 0;
+        $res = $stdout1;
+
+        # Run second isoinfo command
+        my ($stdout2, $stderr2);
+        run3(['isoinfo', '-l', '-R', '-i', $path], \undef, \$stdout2, \$stderr2);
+        error($c, "`isoinfo' error: $stderr2") if $? != 0;
+        $res .= $stdout2;
     }
 
     else {

src/lib/Hydra/Controller/Root.pm

@@ -14,6 +14,7 @@ use Encode;
 use File::Basename;
 use JSON::MaybeXS;
 use HTML::Entities;
+use IPC::Run3;
 use List::Util qw[min max];
 use List::SomeUtils qw{any};
 use Net::Prometheus;
@@ -177,8 +178,14 @@ sub queue_runner_status_GET {
     my ($self, $c) = @_;
 
     #my $status = from_json($c->model('DB::SystemStatus')->find('queue-runner')->status);
-    my $status = decode_json(`hydra-queue-runner --status`);
-    if ($?) { $status->{status} = "unknown"; }
+    my ($stdout, $stderr);
+    run3(['hydra-queue-runner', '--status'], \undef, \$stdout, \$stderr);
+    my $status;
+    if ($? != 0) {
+        $status = { status => "unknown" };
+    } else {
+        $status = decode_json($stdout);
+    }
     my $json = JSON->new->pretty()->canonical();
 
     $c->stash->{template} = 'queue-runner-status.tt';

src/lib/Hydra/Helper/Nix.pm

@@ -12,12 +12,14 @@ use Nix::Store;
 use Encode;
 use Sys::Hostname::Long;
 use IPC::Run;
+use IPC::Run3;
 use LWP::UserAgent;
 use JSON::MaybeXS;
 use UUID4::Tiny qw(is_uuid4_string);
 
 our @ISA = qw(Exporter);
 our @EXPORT = qw(
+    addToStore
     cancelBuilds
     constructRunCommandLogPath
     findLog
@@ -614,4 +616,14 @@ sub constructRunCommandLogPath {
     return "$hydra_path/runcommand-logs/$bucket/$uuid";
 }
 
+
+sub addToStore {
+    my ($path) = @_;
+
+    my ($stdout, $stderr);
+    run3(['nix-store', '--add', $path], \undef, \$stdout, \$stderr);
+    die "cannot add path $path to the Nix store: $stderr\n" if $? != 0;
+    return trim($stdout);
+}
+
 1;

src/lib/Hydra/Plugin/BitBucketPulls.pm

@@ -7,8 +7,10 @@ use HTTP::Request;
 use LWP::UserAgent;
 use JSON::MaybeXS;
 use Hydra::Helper::CatalystUtils;
+use Hydra::Helper::Nix;
 use File::Temp;
 use POSIX qw(strftime);
+use IPC::Run qw(run);
 
 sub supportedInputTypes {
     my ($self, $inputTypes) = @_;
@@ -47,10 +49,8 @@ sub fetchInput {
     open(my $fh, ">", $filename) or die "Cannot open $filename for writing: $!";
     print $fh encode_json \%pulls;
     close $fh;
-    system("jq -S . < $filename > $tempdir/bitbucket-pulls-sorted.json");
-    my $storePath = trim(`nix-store --add "$tempdir/bitbucket-pulls-sorted.json"`
-        or die "cannot copy path $filename to the Nix store.\n");
-    chomp $storePath;
+    run(["jq", "-S", "."], '<', $filename, '>', "$tempdir/bitbucket-pulls-sorted.json") or die "jq command failed: $?";
+    my $storePath = addToStore("$tempdir/bitbucket-pulls-sorted.json");
     my $timestamp = time;
     return { storePath => $storePath, revision => strftime "%Y%m%d%H%M%S", gmtime($timestamp) };
 }

src/lib/Hydra/Plugin/DarcsInput.pm

@@ -7,6 +7,7 @@ use Digest::SHA qw(sha256_hex);
 use File::Path;
 use Hydra::Helper::Exec;
 use Hydra::Helper::Nix;
+use IPC::Run3;
 
 sub supportedInputTypes {
     my ($self, $inputTypes) = @_;
@@ -70,8 +71,11 @@ sub fetchInput {
         (system "darcs", "get", "--lazy", $clonePath, "$tmpDir/export", "--quiet",
                 "--to-match", "hash $revision") == 0
             or die "darcs export failed";
-        $revCount = `darcs changes --count --repodir $tmpDir/export`; chomp $revCount;
-        die "darcs changes --count failed" if $? != 0;
+        my ($stdout, $stderr);
+        run3(['darcs', 'changes', '--count', '--repodir', "$tmpDir/export"], \undef, \$stdout, \$stderr);
+        die "darcs changes --count failed: $stderr\n" if $? != 0;
+        $revCount = $stdout;
+        chomp $revCount;
 
         system "rm", "-rf", "$tmpDir/export/_darcs";
         $storePath = $MACHINE_LOCAL_STORE->addToStore("$tmpDir/export", 1, "sha256");

src/lib/Hydra/Plugin/GithubPulls.pm

@@ -7,6 +7,7 @@ use HTTP::Request;
 use LWP::UserAgent;
 use JSON::MaybeXS;
 use Hydra::Helper::CatalystUtils;
+use Hydra::Helper::Nix;
 use File::Temp;
 use POSIX qw(strftime);
 
@@ -58,9 +59,7 @@ sub fetchInput {
     print $fh JSON->new->utf8->canonical->encode(\%pulls);
     close $fh;
 
-    my $storePath = trim(`nix-store --add "$filename"`
-        or die "cannot copy path $filename to the Nix store.\n");
-    chomp $storePath;
+    my $storePath = addToStore($filename);
     my $timestamp = time;
     return { storePath => $storePath, revision => strftime "%Y%m%d%H%M%S", gmtime($timestamp) };
 }

src/lib/Hydra/Plugin/GithubRefs.pm

@@ -7,8 +7,10 @@ use HTTP::Request;
 use LWP::UserAgent;
 use JSON::MaybeXS;
 use Hydra::Helper::CatalystUtils;
+use Hydra::Helper::Nix;
 use File::Temp;
 use POSIX qw(strftime);
+use IPC::Run qw(run);
 
 =head1 NAME
 
@@ -114,10 +116,8 @@ sub fetchInput {
     open(my $fh, ">", $filename) or die "Cannot open $filename for writing: $!";
     print $fh encode_json \%refs;
     close $fh;
-    system("jq -S . < $filename > $tempdir/github-refs-sorted.json");
-    my $storePath = trim(qx{nix-store --add "$tempdir/github-refs-sorted.json"}
-        or die "cannot copy path $filename to the Nix store.\n");
-    chomp $storePath;
+    run(["jq", "-S", "."], '<', $filename, '>', "$tempdir/github-refs-sorted.json") or die "jq command failed: $?";
+    my $storePath = addToStore("$tempdir/github-refs-sorted.json");
     my $timestamp = time;
     return { storePath => $storePath, revision => strftime "%Y%m%d%H%M%S", gmtime($timestamp) };
 }

src/lib/Hydra/Plugin/GitlabPulls.pm

@@ -21,8 +21,10 @@ use HTTP::Request;
 use LWP::UserAgent;
 use JSON::MaybeXS;
 use Hydra::Helper::CatalystUtils;
+use Hydra::Helper::Nix;
 use File::Temp;
 use POSIX qw(strftime);
+use IPC::Run qw(run);
 
 sub supportedInputTypes {
     my ($self, $inputTypes) = @_;
@@ -85,10 +87,8 @@ sub fetchInput {
     open(my $fh, ">", $filename) or die "Cannot open $filename for writing: $!";
     print $fh encode_json \%pulls;
     close $fh;
-    system("jq -S . < $filename > $tempdir/gitlab-pulls-sorted.json");
-    my $storePath = trim(`nix-store --add "$tempdir/gitlab-pulls-sorted.json"`
-        or die "cannot copy path $filename to the Nix store.\n");
-    chomp $storePath;
+    run(["jq", "-S", "."], '<', $filename, '>', "$tempdir/gitlab-pulls-sorted.json") or die "jq command failed: $?";
+    my $storePath = addToStore("$tempdir/gitlab-pulls-sorted.json");
     my $timestamp = time;
     return { storePath => $storePath, revision => strftime "%Y%m%d%H%M%S", gmtime($timestamp) };
 }

src/lib/Hydra/Plugin/PathInput.pm

@@ -5,6 +5,7 @@ use warnings;
 use parent 'Hydra::Plugin';
 use POSIX qw(strftime);
 use Hydra::Helper::Nix;
+use IPC::Run3;
 
 sub supportedInputTypes {
     my ($self, $inputTypes) = @_;
@@ -37,11 +38,16 @@ sub fetchInput {
 
         print STDERR "copying input ", $name, " from $uri\n";
         if ( $uri =~ /^\// ) {
-            $storePath = `nix-store --add "$uri"`
-                or die "cannot copy path $uri to the Nix store.\n";
+            $storePath = addToStore($uri);
         } else {
-            $storePath = `PRINT_PATH=1 nix-prefetch-url "$uri" | tail -n 1`
-                or die "cannot fetch $uri to the Nix store.\n";
+            # Run nix-prefetch-url with PRINT_PATH=1
+            my ($stdout, $stderr);
+            local $ENV{PRINT_PATH} = 1;
+            run3(['nix-prefetch-url', $uri], \undef, \$stdout, \$stderr);
+            die "cannot fetch $uri to the Nix store: $stderr\n" if $? != 0;
+            # Get the last line (which is the store path)
+            my @output_lines = split /\n/, $stdout;
+            $storePath = $output_lines[-1] if @output_lines;
         }
         chomp $storePath;
 

src/lib/Hydra/Plugin/S3Backup.pm

@@ -7,6 +7,8 @@ use File::Temp;
 use File::Basename;
 use Fcntl;
 use IO::File;
+use IPC::Run qw(run);
+use IPC::Run3;
 use Net::Amazon::S3;
 use Net::Amazon::S3::Client;
 use Digest::SHA;
@@ -27,11 +29,11 @@ my %compressors = ();
 $compressors{"none"} = "";
 
 if (defined($Nix::Config::bzip2)) {
-    $compressors{"bzip2"} = "| $Nix::Config::bzip2",
+    $compressors{"bzip2"} = "$Nix::Config::bzip2",
 }
 
 if (defined($Nix::Config::xz)) {
-    $compressors{"xz"} = "| $Nix::Config::xz",
+    $compressors{"xz"} = "$Nix::Config::xz",
 }
 
 my $lockfile = Hydra::Model::DB::getHydraPath . "/.hydra-s3backup.lock";
@@ -111,7 +113,16 @@ sub buildFinished {
             }
             next unless @incomplete_buckets;
             my $compressor = $compressors{$compression_type};
-            system("$Nix::Config::binDir/nix-store --dump $path $compressor > $tempdir/nar") == 0 or die;
+            if ($compressor eq "") {
+                # No compression - use IPC::Run3 to redirect stdout to file
+                run3(["$Nix::Config::binDir/nix-store", "--dump", $path],
+                     \undef, "$tempdir/nar", \undef) or die "nix-store --dump failed: $!";
+            } else {
+                # With compression - use IPC::Run to pipe nix-store output to compressor
+                my $dump_cmd = ["$Nix::Config::binDir/nix-store", "--dump", $path];
+                my $compress_cmd = [$compressor];
+                run($dump_cmd, '|', $compress_cmd, '>', "$tempdir/nar") or die "Pipeline failed: $?";
+            }
             my $digest = Digest::SHA->new(256);
             $digest->addfile("$tempdir/nar");
             my $file_hash = $digest->hexdigest;

src/lib/Perl/Critic/Policy/Hydra/ProhibitShellInvokingSystemCalls.pm

@@ -0,0 +1,103 @@
+package Perl::Critic::Policy::Hydra::ProhibitShellInvokingSystemCalls;
+
+use strict;
+use warnings;
+use constant;
+
+use Perl::Critic::Utils qw{ :severities :classification :ppi };
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '1.000';
+
+use constant DESC => q{Shell-invoking system calls are prohibited};
+use constant EXPL => q{Use list form system() or IPC::Run3 for better security. String form invokes shell and is vulnerable to injection};
+
+sub supported_parameters { return ()                         }
+sub default_severity     { return $SEVERITY_HIGHEST         }
+sub default_themes       { return qw( hydra security )       }
+sub applies_to           { return 'PPI::Token::Word'         }
+
+sub violates {
+    my ( $self, $elem, undef ) = @_;
+
+    # Only check system() and exec() calls
+    return () unless $elem->content() =~ /^(system|exec)$/;
+    return () unless is_function_call($elem);
+
+    # Skip method calls (->system or ->exec)
+    my $prev = $elem->sprevious_sibling();
+    return () if $prev && $prev->isa('PPI::Token::Operator') && $prev->content() eq '->';
+
+    # Get first argument after function name, skipping whitespace
+    my $args = $elem->snext_sibling();
+    return () unless $args;
+    $args = $args->snext_sibling() while $args && $args->isa('PPI::Token::Whitespace');
+
+    # For parenthesized calls, look inside
+    my $search_elem = $args;
+    if ($args && $args->isa('PPI::Structure::List')) {
+        $search_elem = $args->schild(0);
+        return () unless $search_elem;
+    }
+
+    # Check if it's list form (has comma)
+    my $current = $search_elem;
+    if ($current && $current->isa('PPI::Statement')) {
+        # Look through statement children
+        for my $child ($current->schildren()) {
+            return () if $child->isa('PPI::Token::Operator') && $child->content() eq ',';
+        }
+    } else {
+        # Look through siblings for non-parenthesized calls
+        while ($current) {
+            return () if $current->isa('PPI::Token::Operator') && $current->content() eq ',';
+            last if $current->isa('PPI::Token::Structure') && $current->content() eq ';';
+            $current = $current->snext_sibling();
+        }
+    }
+
+    # Check if first arg is array variable
+    my $first = $search_elem->isa('PPI::Statement') ?
+                $search_elem->schild(0) : $search_elem;
+    return () if $first && $first->isa('PPI::Token::Symbol') && $first->content() =~ /^[@]/;
+
+    # Check if it's a safe single-word command
+    if ($first && $first->isa('PPI::Token::Quote')) {
+        my $content = $first->string();
+        return () if $content =~ /^[a-zA-Z0-9_\-\.\/]+$/;
+    }
+
+    return $self->violation( DESC, EXPL, $elem );
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::Hydra::ProhibitShellInvokingSystemCalls - Prohibit shell-invoking system() and exec() calls
+
+=head1 DESCRIPTION
+
+This policy prohibits the use of C<system()> and C<exec()> functions when called with a single string argument,
+which invokes the shell and is vulnerable to injection attacks.
+
+The list form (e.g., C<system('ls', '-la')>) is allowed as it executes directly without shell interpretation.
+For better error handling and output capture, consider using C<IPC::Run3>.
+
+=head1 CONFIGURATION
+
+This Policy is not configurable except for the standard options.
+
+=head1 AUTHOR
+
+Hydra Development Team
+
+=head1 COPYRIGHT
+
+Copyright (c) 2025 Hydra Development Team. All rights reserved.
+
+=cut

src/script/hydra-send-stats

@@ -9,6 +9,7 @@ use Net::Statsd;
 use File::Slurper qw(read_text);
 use JSON::MaybeXS;
 use Getopt::Long qw(:config gnu_getopt);
+use IPC::Run3;
 
 STDERR->autoflush(1);
 binmode STDERR, ":encoding(utf8)";
@@ -25,10 +26,11 @@ sub gauge {
 }
 
 sub sendQueueRunnerStats {
-    my $s = `hydra-queue-runner --status`;
-    die "cannot get queue runner stats\n" if $? != 0;
+    my ($stdout, $stderr);
+    run3(['hydra-queue-runner', '--status'], \undef, \$stdout, \$stderr);
+    die "cannot get queue runner stats: $stderr\n" if $? != 0;
 
-    my $json = decode_json($s) or die "cannot decode queue runner status";
+    my $json = decode_json($stdout) or die "cannot decode queue runner status";
 
     gauge("hydra.queue.up", $json->{status} eq "up" ? 1 : 0);
 

t/Hydra/Plugin/gitea.t

@@ -50,7 +50,7 @@ my $pid;
 if (!defined($pid = fork())) {
     die "Cannot fork(): $!";
 } elsif ($pid == 0) {
-    exec("python3 $ctx{jobsdir}/server.py $filename");
+    exec("python3", "$ctx{jobsdir}/server.py", $filename);
 } else {
     my $newbuild = $db->resultset('Builds')->find($build->id);
     is($newbuild->finished, 1, "Build should be finished.");

t/perlcritic.pl

@@ -10,4 +10,7 @@ my $dirname = abs_path(dirname(__FILE__) . "/..");
 print STDERR "Executing perlcritic against $dirname\n";
 chdir($dirname) or die "Failed to enter $dirname\n";
 
-exec("perlcritic", ".") or die "Failed to execute perlcritic.";
+# Add src/lib to PERL5LIB so perlcritic can find our custom policies
+$ENV{PERL5LIB} = "src/lib" . ($ENV{PERL5LIB} ? ":$ENV{PERL5LIB}" : "");
+
+exec("perlcritic", "--quiet", ".") or die "Failed to execute perlcritic.";

t/s3-backup-test.pl

@@ -19,11 +19,11 @@ my $jobsetinput;
 
 $jobsetinput = $jobset->jobsetinputs->create({name => "jobs", type => "path"});
 $jobsetinput->jobsetinputalts->create({altnr => 0, value => getcwd . "/jobs"});
-system("hydra-eval-jobset " . $jobset->project->name . " " . $jobset->name);
+system("hydra-eval-jobset", $jobset->project->name, $jobset->name);
 
 my $successful_hash;
 foreach my $build ($jobset->builds->search({finished => 0})) {
-    system("hydra-build " . $build->id);
+    system("hydra-build", $build->id);
     my @outputs = $build->buildoutputs->all;
     my $hash = substr basename($outputs[0]->path), 0, 32;
     if ($build->job->name eq "job") {