commit 8b6831b36becc697fc53e61cac058d18096ea4b9 Author: Nicolas Vigier boklm@torproject.org Date: Tue Nov 21 17:13:01 2017 +0100

Bug 24361: use Path::Tiny instead of File::Slurp

When a build script contains some wide character, rbm fails with an error: Wide character in syswrite at /usr/share/perl5/File/Slurp.pm line 506.

This is because write_file from File::Slurp which we use to write the build scripts is encoding files to latin-1 by default. While fixing this, switching to Path::Tiny instead of File::Slurp seems like a good idea: http://blogs.perl.org/users/leon_timmermans/2015/08/fileslurp-is-broken-and-...

Switching to Path::Tiny is also improving performance:

When using File::Slurp:

$ time ./rbm/rbm showconf --target alpha --target torbrowser-linux-x86_64 tor-browser var/build_id 82b8cb

real 0m28.543s user 0m24.448s sys 0m3.956s

When using Path::Tiny:

$ time ~/rbm/rbm showconf --target alpha --target torbrowser-linux-x86_64 tor-browser var/build_id 82b8cb

real 0m15.745s user 0m13.940s sys 0m1.940s

The path function in lib/RBM.pm is conflicting with the path constructor from Path::Tiny, so we rename it to rbm_path. --- lib/RBM.pm | 64 +++++++++++++++++++++++++++++++------------------------------- test.pl | 4 ++-- 2 files changed, 34 insertions(+), 34 deletions(-)

diff --git a/lib/RBM.pm b/lib/RBM.pm index 3134efe..9080ccf 100644 --- a/lib/RBM.pm +++ b/lib/RBM.pm @@ -2,6 +2,7 @@ package RBM;

use warnings; use strict; +use Path::Tiny; use Encode qw(encode); use Cwd qw(getcwd); use YAML::XS qw(LoadFile); @@ -12,7 +13,6 @@ use IO::CaptureOutput qw(capture_exec); use File::Temp; use File::Copy; use File::Copy::Recursive qw(fcopy); -use File::Slurp; use File::Path qw(make_path); use File::Basename; use String::ShellQuote; @@ -50,7 +50,7 @@ sub load_config { $config->{step} = 'rbm_init'; $config->{opt} = {}; my $pdir = $config->{projects_dir} || $config->{default}{projects_dir}; - foreach my $p (glob path($pdir) . '/*') { + foreach my $p (glob rbm_path($pdir) . '/*') { next unless -f "$p/config"; $config->{projects}{basename($p)} = load_config_file("$p/config"); } @@ -65,7 +65,7 @@ sub load_system_config { sub load_local_config { my ($project) = @_; my $cfile = project_config($project ? $project : 'undef', 'localconf_file'); - $cfile = path($cfile); + $cfile = rbm_path($cfile); $config->{local} = -f $cfile ? load_config_file($cfile) : {}; }

@@ -80,7 +80,7 @@ sub set_default_env { %ENV = (%ENV, %{$config->{ENV}}) if ref $config->{ENV} eq 'HASH'; }

-sub path { +sub rbm_path { my ($path, $basedir) = @_; $basedir //= $config->{basedir}; return ( $path =~ m|^/| ) ? $path : "$basedir/$path"; @@ -271,7 +271,7 @@ sub set_git_gpg_wrapper { my ($project) = @_; my $w = project_config($project, 'gpg_wrapper'); my (undef, $tmp) = File::Temp::tempfile(DIR => get_tmp_dir($project)); - write_file($tmp, $w); + path($tmp)->spew_utf8($w); chmod 0700, $tmp; system('git', 'config', 'gpg.program', $tmp) == 0 || exit_error 'Error setting gpg.program'; @@ -322,7 +322,7 @@ sub file_sign_id { my ($project, $options) = @_; my (undef, $gpg_wrapper) = File::Temp::tempfile(DIR => get_tmp_dir($project, $options)); - write_file($gpg_wrapper, project_config($project, 'gpg_wrapper', $options)); + path($gpg_wrapper)->spew_utf8(project_config($project, 'gpg_wrapper', $options)); chmod 0700, $gpg_wrapper; my ($stdout, $stderr, $success, $exit_code) = capture_exec($gpg_wrapper, '--verify', @@ -377,7 +377,7 @@ sub git_need_fetch {

sub git_clone_fetch_chdir { my ($project, $options) = @_; - my $clonedir = create_dir(path(project_config($project, + my $clonedir = create_dir(rbm_path(project_config($project, 'git_clone_dir', $options))); my $git_url = project_config($project, 'git_url', $options) || exit_error "git_url is undefined"; @@ -387,7 +387,7 @@ sub git_clone_fetch_chdir { @clone_submod = ('--recurse-submodules'); @fetch_submod = ('--recurse-submodules=on-demand'); } - if (!chdir path("$clonedir/$project")) { + if (!chdir rbm_path("$clonedir/$project")) { chdir $clonedir || exit_error "Can't enter directory $clonedir: $!"; if (system('git', 'clone', @clone_submod, $git_url, $project) != 0) { exit_error "Error cloning $git_url"; @@ -429,12 +429,12 @@ sub hg_need_fetch { sub hg_clone_fetch_chdir { my ($project, $options) = @_; my $hg = project_config($project, 'hg', $options); - my $clonedir = create_dir(path(project_config($project, + my $clonedir = create_dir(rbm_path(project_config($project, 'hg_clone_dir', $options))); my $hg_url = shell_quote(project_config($project, 'hg_url', $options)) || exit_error "hg_url is undefined"; my $sq_project = shell_quote($project); - if (!chdir path("$clonedir/$project")) { + if (!chdir rbm_path("$clonedir/$project")) { chdir $clonedir || exit_error "Can't enter directory $clonedir: $!"; if (system("$hg clone -q $hg_url $sq_project") != 0) { exit_error "Error cloning $hg_url"; @@ -453,7 +453,7 @@ sub run_script { my @res; if ($cmd =~ m/^#/) { my (undef, $tmp) = File::Temp::tempfile(DIR => get_tmp_dir($project)); - write_file($tmp, $cmd); + path($tmp)->spew_utf8($cmd); chmod 0700, $tmp; @res = $f->($tmp); unlink $tmp; @@ -505,7 +505,7 @@ sub gpg_id {

sub maketar { my ($project, $options, $dest_dir) = @_; - $dest_dir //= create_dir(path(project_config($project, 'output_dir'))); + $dest_dir //= create_dir(rbm_path(project_config($project, 'output_dir'))); valid_project($project); my $old_cwd = getcwd; my $commit_hash; @@ -592,9 +592,9 @@ sub maketar {

sub sha256file { CORE::state %res; - my $f = path(shift); + my $f = rbm_path(shift); return $res{$f} if exists $res{$f}; - return $res{$f} = -f $f ? sha256_hex(scalar read_file($f)) : ''; + return $res{$f} = -f $f ? sha256_hex(path($f)->slurp_raw) : ''; }

sub process_template_opt { @@ -617,8 +617,8 @@ sub process_template { } return $res; } - $dest_dir //= path(project_config($project, 'output_dir')); - my $projects_dir = path(project_config($project, 'projects_dir')); + $dest_dir //= rbm_path(project_config($project, 'output_dir')); + my $projects_dir = rbm_path(project_config($project, 'projects_dir')); my $template = Template->new( ENCODING => 'utf8', INCLUDE_PATH => "$projects_dir/$project:$projects_dir/common", @@ -636,7 +636,7 @@ sub process_template { dest_dir => $dest_dir, exit_error => &exit_error, exec => sub { execute($project, @_) }, - path => &path, + path => &rbm_path, tmpl => sub { process_template($project, $_[0], $dest_dir) }, shell_quote => &shell_quote, versioncmp => &versioncmp, @@ -655,12 +655,12 @@ sub process_template {

sub rpmspec { my ($project, $dest_dir) = @_; - $dest_dir //= create_dir(path(project_config($project, 'output_dir'))); + $dest_dir //= create_dir(rbm_path(project_config($project, 'output_dir'))); valid_project($project); my $timestamp = project_config($project, 'timestamp'); my $rpmspec = project_config($project, 'rpmspec') || exit_error "Undefined config for rpmspec"; - write_file("$dest_dir/$project.spec", $rpmspec); + path("$dest_dir/$project.spec")->spew_utf8($rpmspec); utime $timestamp, $timestamp, "$dest_dir/$project.spec" if $timestamp; }

@@ -673,7 +673,7 @@ sub copy_files { my @r; my $copy_files = project_config($project, 'copy_files'); return unless $copy_files; - my $proj_dir = path(project_config($project, 'projects_dir')); + my $proj_dir = rbm_path(project_config($project, 'projects_dir')); my $src_dir = "$proj_dir/$project"; foreach my $file (@$copy_files) { copy("$src_dir/$file", "$dest_dir/$file"); @@ -719,8 +719,8 @@ sub input_file_id_hash { my ($fname, $filename) = @_; return $filename . ':' . sha256file($fname) if -f $fname; return $filename . ':' . sha256file(readlink $fname) if -l $fname; - my @hashes = map { input_file_id_hash("$fname/$_", "$filename/$_") } - sort(read_dir($fname)); + my @subdirs = sort(map { $_->basename } path($fname)->children); + my @hashes = map { input_file_id_hash("$fname/$_", "$filename/$_") } @subdirs; return join("\n", @hashes); }

@@ -742,7 +742,7 @@ sub recursive_copy { } my @copied; mkdir "$dest_dir/$name"; - foreach my $f (read_dir($fname)) { + foreach my $f (map { $_->basename } path($fname)->children) { push @copied, recursive_copy("$fname/$f", "$name/$f", $dest_dir); } return @copied; @@ -759,7 +759,7 @@ sub input_files { $options = {$options ? %$options : ()}; my $input_files = project_config($project, 'input_files', $options); goto RETURN_RES unless $input_files; - my $proj_dir = path(project_config($project, 'projects_dir', $options)); + my $proj_dir = rbm_path(project_config($project, 'projects_dir', $options)); my $src_dir = "$proj_dir/$project"; my $old_cwd = getcwd; chdir $src_dir || exit_error "cannot chdir to $src_dir"; @@ -813,12 +813,12 @@ sub input_files { } my $proj_out_dir; if ($input_file->{project}) { - $proj_out_dir = path(project_step_config($t->('project'), 'output_dir', + $proj_out_dir = rbm_path(project_step_config($t->('project'), 'output_dir', { %$options, step => $t->('pkg_type'), origin_project => $project, output_dir => undef, %$input_file })); } else { - $proj_out_dir = path(project_config($project, 'output_dir', + $proj_out_dir = rbm_path(project_config($project, 'output_dir', { %$input_file, output_dir => undef })); } create_dir($proj_out_dir); @@ -837,7 +837,7 @@ sub input_files { my $file_gpg_id = gpg_id($t->('file_gpg_id')); if ($need_dl && (!$fname || $t->('refresh_input'))) { if ($t->('content')) { - write_file("$proj_out_dir/$name", $t->('content')); + path("$proj_out_dir/$name")->spew_utf8($t->('content')); } elsif ($t->('URL')) { urlget($project, {%$input_file, filename => $name}, 1); } elsif ($t->('exec')) { @@ -889,7 +889,7 @@ sub input_files { } exit_error "Missing file $name" unless $fname; if ($t->('sha256sum') - && $t->('sha256sum') ne sha256_hex(read_file($fname))) { + && $t->('sha256sum') ne sha256_hex(path($fname)->slurp_raw)) { exit_error "Can't have sha256sum on directory: $fname" if -d $fname; exit_error "Wrong sha256sum for $fname.\n" . "Expected sha256sum: " . $t->('sha256sum'); @@ -954,7 +954,7 @@ sub build_run { $config->{step} = $script_name; $options //= {}; my $error; - my $dest_dir = create_dir(path(project_config($project, 'output_dir', $options))); + my $dest_dir = create_dir(rbm_path(project_config($project, 'output_dir', $options))); valid_project($project); $options = { %$options, build_id => Data::UUID->new->create_str }; my $old_cwd = getcwd; @@ -1023,16 +1023,16 @@ sub build_run { @scripts = grep { $build_script{$_} } @scripts; push @cfiles, @scripts unless $use_srcdir; foreach my $s (@scripts) { - write_file("$srcdir/$s", $build_script{$s}); + path("$srcdir/$s")->spew_utf8($build_script{$s}); chmod 0700, "$srcdir/$s"; } my $build_log = project_config($project, "build_log", $options); if ($build_log ne '-') { my $append = project_config($project, "build_log_append", $options); - $build_log = path($build_log); + $build_log = rbm_path($build_log); make_path(dirname($build_log)); my $now = localtime; - write_file($build_log, {append => $append}, "Starting build: $now\n"); + path($build_log)->append_utf8("Starting build: $now\n"); print "Build log: $build_log\n"; } chdir $srcdir; diff --git a/test.pl b/test.pl index 8e842e7..dfca8ee 100755 --- a/test.pl +++ b/test.pl @@ -1,6 +1,6 @@ #!/usr/bin/perl -w use strict; -use File::Slurp; +use Path::Tiny; use Test::More tests => 29; use lib 'lib/';

@@ -207,7 +207,7 @@ foreach my $test (@tests) { if ($test->{build}) { unlink keys %{$test->{files}}; RBM::build_run(@{$test->{build}}); - my $res = grep { read_file($_) ne $test->{files}{$_} } keys %{$test->{files}}; + my $res = grep { path($_)->slurp_utf8 ne $test->{files}{$_} } keys %{$test->{files}}; ok(!$res, $test->{name}); } }