Commit 842ac464 authored by Vitaly Belekhov's avatar Vitaly Belekhov Committed by Dylan William Hardison

Bug 1301887 - File::Slurp triggers warnings on perl 5.24 (#53)

* Bug 1301887 - File::Slurp triggers warnings on perl 5.24 and it is recommended to not use it (#21) r=mtyson * Fix for vrite in aa735d4 * Added https://gitweb.gentoo.org/proj/gentoo-bugzilla.git/commit/?id=ca7bfc9c485c959fad2aee1f7c1dbc0fb484553b
parent 726dbd97
...@@ -16,10 +16,9 @@ use autodie qw(:default); ...@@ -16,10 +16,9 @@ use autodie qw(:default);
use Bugzilla::Constants; use Bugzilla::Constants;
use Bugzilla::Hook; use Bugzilla::Hook;
use Bugzilla::Util qw(trick_taint); use Bugzilla::Util qw(trick_taint read_text write_text);
use JSON::XS; use JSON::XS;
use File::Slurp;
use File::Temp; use File::Temp;
use File::Basename; use File::Basename;
...@@ -284,7 +283,7 @@ sub write_params { ...@@ -284,7 +283,7 @@ sub write_params {
my $param_file = bz_locations()->{'datadir'} . '/params.json'; my $param_file = bz_locations()->{'datadir'} . '/params.json';
my $json_data = JSON::XS->new->canonical->pretty->encode($param_data); my $json_data = JSON::XS->new->canonical->pretty->encode($param_data);
write_file($param_file, { binmode => ':utf8', atomic => 1 }, \$json_data); write_text($param_file, $json_data);
# It's not common to edit parameters and loading # It's not common to edit parameters and loading
# Bugzilla::Install::Filesystem is slow. # Bugzilla::Install::Filesystem is slow.
...@@ -301,8 +300,8 @@ sub read_param_file { ...@@ -301,8 +300,8 @@ sub read_param_file {
my $file = bz_locations()->{'datadir'} . '/params.json'; my $file = bz_locations()->{'datadir'} . '/params.json';
if (-e $file) { if (-e $file) {
my $data; my $data = read_text($file);
read_file($file, binmode => ':utf8', buf_ref => \$data); trick_taint($data);
# If params.json has been manually edited and e.g. some quotes are # If params.json has been manually edited and e.g. some quotes are
# missing, we don't want JSON::XS to leak the content of the file # missing, we don't want JSON::XS to leak the content of the file
......
...@@ -31,7 +31,6 @@ use File::Path; ...@@ -31,7 +31,6 @@ use File::Path;
use File::Basename; use File::Basename;
use File::Copy qw(move); use File::Copy qw(move);
use File::Spec; use File::Spec;
use File::Slurp;
use IO::File; use IO::File;
use POSIX (); use POSIX ();
...@@ -536,7 +535,7 @@ sub update_filesystem { ...@@ -536,7 +535,7 @@ sub update_filesystem {
# Remove old assets htaccess file to force recreation with correct values. # Remove old assets htaccess file to force recreation with correct values.
if (-e "$assetsdir/.htaccess") { if (-e "$assetsdir/.htaccess") {
if (read_file("$assetsdir/.htaccess") =~ /<FilesMatch \\\.css\$>/) { if (read_text("$assetsdir/.htaccess") =~ /<FilesMatch \\\.css\$>/) {
unlink("$assetsdir/.htaccess"); unlink("$assetsdir/.htaccess");
} }
} }
......
...@@ -156,11 +156,6 @@ sub REQUIRED_MODULES { ...@@ -156,11 +156,6 @@ sub REQUIRED_MODULES {
version => '1.0.1', version => '1.0.1',
}, },
{ {
package => 'File-Slurp',
module => 'File::Slurp',
version => '9999.13',
},
{
package => 'JSON-XS', package => 'JSON-XS',
module => 'JSON::XS', module => 'JSON::XS',
# 2.0 is the first version that will work with JSON::RPC. # 2.0 is the first version that will work with JSON::RPC.
......
...@@ -14,8 +14,8 @@ use warnings; ...@@ -14,8 +14,8 @@ use warnings;
use Bugzilla::Constants; use Bugzilla::Constants;
use Bugzilla::Error; use Bugzilla::Error;
use Bugzilla::Install::Util qw(install_string); use Bugzilla::Install::Util qw(install_string);
use Bugzilla::Util qw(read_text);
use File::Basename; use File::Basename;
use File::Slurp;
use base qw(TheSchwartz); use base qw(TheSchwartz);
use fields qw(_worker_pidfile); use fields qw(_worker_pidfile);
...@@ -124,7 +124,7 @@ sub subprocess_worker { ...@@ -124,7 +124,7 @@ sub subprocess_worker {
# And poll the PID to detect when the working has finished. # And poll the PID to detect when the working has finished.
# We do this instead of system() to allow for the INT signal to # We do this instead of system() to allow for the INT signal to
# interrup us and trigger kill_worker(). # interrup us and trigger kill_worker().
my $pid = read_file($self->{_worker_pidfile}, err_mode => 'quiet'); my $pid = read_text($self->{_worker_pidfile}, err_mode => 'quiet');
if ($pid) { if ($pid) {
sleep(3) while(kill(0, $pid)); sleep(3) while(kill(0, $pid));
} }
...@@ -139,7 +139,7 @@ sub subprocess_worker { ...@@ -139,7 +139,7 @@ sub subprocess_worker {
sub kill_worker { sub kill_worker {
my $self = Bugzilla->job_queue(); my $self = Bugzilla->job_queue();
if ($self->{_worker_pidfile} && -e $self->{_worker_pidfile}) { if ($self->{_worker_pidfile} && -e $self->{_worker_pidfile}) {
my $worker_pid = read_file($self->{_worker_pidfile}); my $worker_pid = read_text($self->{_worker_pidfile});
if ($worker_pid && kill(0, $worker_pid)) { if ($worker_pid && kill(0, $worker_pid)) {
$self->debug("Stopping worker process"); $self->debug("Stopping worker process");
system "$0 -f -p '" . $self->{_worker_pidfile} . "' stop"; system "$0 -f -p '" . $self->{_worker_pidfile} . "' stop";
......
...@@ -32,7 +32,6 @@ use Digest::MD5 qw(md5_hex); ...@@ -32,7 +32,6 @@ use Digest::MD5 qw(md5_hex);
use File::Basename qw(basename dirname); use File::Basename qw(basename dirname);
use File::Find; use File::Find;
use File::Path qw(rmtree mkpath); use File::Path qw(rmtree mkpath);
use File::Slurp;
use File::Spec; use File::Spec;
use IO::Dir; use IO::Dir;
use List::MoreUtils qw(firstidx); use List::MoreUtils qw(firstidx);
...@@ -502,7 +501,7 @@ sub _concatenate_css { ...@@ -502,7 +501,7 @@ sub _concatenate_css {
next unless -e "$cgi_path/$files{$source}"; next unless -e "$cgi_path/$files{$source}";
my $file = $skins_path . '/' . md5_hex($source) . '.css'; my $file = $skins_path . '/' . md5_hex($source) . '.css';
if (!-e $file) { if (!-e $file) {
my $content = read_file("$cgi_path/$files{$source}"); my $content = read_text("$cgi_path/$files{$source}");
# minify # minify
$content =~ s{/\*.*?\*/}{}sg; # comments $content =~ s{/\*.*?\*/}{}sg; # comments
...@@ -512,7 +511,7 @@ sub _concatenate_css { ...@@ -512,7 +511,7 @@ sub _concatenate_css {
# rewrite urls # rewrite urls
$content =~ s{url\(([^\)]+)\)}{_css_url_rewrite($source, $1)}eig; $content =~ s{url\(([^\)]+)\)}{_css_url_rewrite($source, $1)}eig;
write_file($file, "/* $files{$source} */\n" . $content . "\n"); write_text($file, "/* $files{$source} */\n" . $content . "\n");
} }
push @minified, $file; push @minified, $file;
} }
...@@ -522,9 +521,9 @@ sub _concatenate_css { ...@@ -522,9 +521,9 @@ sub _concatenate_css {
if (!-e $file) { if (!-e $file) {
my $content = ''; my $content = '';
foreach my $source (@minified) { foreach my $source (@minified) {
$content .= read_file($source); $content .= read_text($source);
} }
write_file($file, $content); write_text($file, $content);
} }
$file =~ s/^\Q$cgi_path\E\///o; $file =~ s/^\Q$cgi_path\E\///o;
...@@ -563,7 +562,7 @@ sub _concatenate_js { ...@@ -563,7 +562,7 @@ sub _concatenate_js {
next unless -e "$cgi_path/$files{$source}"; next unless -e "$cgi_path/$files{$source}";
my $file = $skins_path . '/' . md5_hex($source) . '.js'; my $file = $skins_path . '/' . md5_hex($source) . '.js';
if (!-e $file) { if (!-e $file) {
my $content = read_file("$cgi_path/$files{$source}"); my $content = read_text("$cgi_path/$files{$source}");
# minimal minification # minimal minification
$content =~ s#/\*.*?\*/##sg; # block comments $content =~ s#/\*.*?\*/##sg; # block comments
...@@ -572,7 +571,7 @@ sub _concatenate_js { ...@@ -572,7 +571,7 @@ sub _concatenate_js {
$content =~ s#\n{2,}#\n#g; # blank lines $content =~ s#\n{2,}#\n#g; # blank lines
$content =~ s#(^\s+|\s+$)##g; # whitespace at the start/end of file $content =~ s#(^\s+|\s+$)##g; # whitespace at the start/end of file
write_file($file, ";/* $files{$source} */\n" . $content . "\n"); write_text($file, ";/* $files{$source} */\n" . $content . "\n");
} }
push @minified, $file; push @minified, $file;
} }
...@@ -582,9 +581,9 @@ sub _concatenate_js { ...@@ -582,9 +581,9 @@ sub _concatenate_js {
if (!-e $file) { if (!-e $file) {
my $content = ''; my $content = '';
foreach my $source (@minified) { foreach my $source (@minified) {
$content .= read_file($source); $content .= read_text($source);
} }
write_file($file, $content); write_text($file, $content);
} }
$file =~ s/^\Q$cgi_path\E\///o; $file =~ s/^\Q$cgi_path\E\///o;
......
...@@ -24,7 +24,7 @@ use parent qw(Exporter); ...@@ -24,7 +24,7 @@ use parent qw(Exporter);
validate_email_syntax check_email_syntax clean_text validate_email_syntax check_email_syntax clean_text
get_text template_var display_value disable_utf8 get_text template_var display_value disable_utf8
detect_encoding email_filter detect_encoding email_filter
join_activity_entries); join_activity_entries read_text write_text);
use Bugzilla::Constants; use Bugzilla::Constants;
use Bugzilla::RNG qw(irand); use Bugzilla::RNG qw(irand);
...@@ -39,6 +39,8 @@ use Scalar::Util qw(tainted blessed); ...@@ -39,6 +39,8 @@ use Scalar::Util qw(tainted blessed);
use Text::Wrap; use Text::Wrap;
use Encode qw(encode decode resolve_alias); use Encode qw(encode decode resolve_alias);
use Encode::Guess; use Encode::Guess;
use File::Basename qw(dirname);
use File::Temp qw(tempfile);
sub trick_taint { sub trick_taint {
require Carp; require Carp;
...@@ -106,6 +108,29 @@ sub html_quote { ...@@ -106,6 +108,29 @@ sub html_quote {
return $var; return $var;
} }
sub read_text {
my ($filename) = @_;
open my $fh, '<:encoding(utf-8)', $filename;
local $/ = undef;
my $content = <$fh>;
close $fh;
return $content;
}
sub write_text {
my ($filename, $content) = @_;
my ($tmp_fh, $tmp_filename) = tempfile('.tmp.XXXXXXXXXX',
DIR => dirname($filename),
UNLINK => 0,
);
binmode $tmp_fh, ':encoding(utf-8)';
print $tmp_fh $content;
close $tmp_fh;
# File::Temp tries for secure files, but File::Slurp used the umask.
chmod(0666 & ~umask, $tmp_filename);
rename $tmp_filename, $filename;
}
sub html_light_quote { sub html_light_quote {
my ($text) = @_; my ($text) = @_;
# admin/table.html.tmpl calls |FILTER html_light| many times. # admin/table.html.tmpl calls |FILTER html_light| many times.
......
...@@ -49,7 +49,7 @@ graphviz patchutils gcc 'perl(Apache2::SizeLimit)' 'perl(Authen::Radius)' ...@@ -49,7 +49,7 @@ graphviz patchutils gcc 'perl(Apache2::SizeLimit)' 'perl(Authen::Radius)'
'perl(Daemon::Generic)' 'perl(Date::Format)' 'perl(DateTime)' 'perl(Daemon::Generic)' 'perl(Date::Format)' 'perl(DateTime)'
'perl(DateTime::TimeZone)' 'perl(DBI)' 'perl(Digest::SHA)' 'perl(Email::MIME)' 'perl(DateTime::TimeZone)' 'perl(DBI)' 'perl(Digest::SHA)' 'perl(Email::MIME)'
'perl(Email::Reply)' 'perl(Email::Sender)' 'perl(Encode)' 'perl(Encode::Detect)' 'perl(Email::Reply)' 'perl(Email::Sender)' 'perl(Encode)' 'perl(Encode::Detect)'
'perl(File::MimeInfo::Magic)' 'perl(File::Slurp)' 'perl(GD)' 'perl(GD::Graph)' 'perl(File::MimeInfo::Magic)' 'perl(GD)' 'perl(GD::Graph)'
'perl(GD::Text)' 'perl(HTML::FormatText::WithLinks)' 'perl(HTML::Parser)' 'perl(GD::Text)' 'perl(HTML::FormatText::WithLinks)' 'perl(HTML::Parser)'
'perl(HTML::Scrubber)' 'perl(IO::Scalar)' 'perl(JSON::RPC)' 'perl(JSON::XS)' 'perl(HTML::Scrubber)' 'perl(IO::Scalar)' 'perl(JSON::RPC)' 'perl(JSON::XS)'
'perl(List::MoreUtils)' 'perl(LWP::UserAgent)' 'perl(Math::Random::ISAAC)' 'perl(List::MoreUtils)' 'perl(LWP::UserAgent)' 'perl(Math::Random::ISAAC)'
......
...@@ -85,7 +85,6 @@ Install the following mandatory modules with: ...@@ -85,7 +85,6 @@ Install the following mandatory modules with:
* URI * URI
* List-MoreUtils * List-MoreUtils
* Math-Random-ISAAC * Math-Random-ISAAC
* File-Slurp
* JSON-XS * JSON-XS
* Win32 * Win32
* Win32-API * Win32-API
......
...@@ -174,7 +174,7 @@ ...@@ -174,7 +174,7 @@
<h3 id="req_modules">Required Perl Modules</h3> <h3 id="req_modules">Required Perl Modules</h3>
[% INCLUDE req_table reqs = REQUIRED_MODULES [% INCLUDE req_table reqs = REQUIRED_MODULES
new = ['File-Slurp','JSON-XS', 'Email-Sender'] new = ['JSON-XS', 'Email-Sender']
updated = ['DateTime', 'DateTime-TimeZone', updated = ['DateTime', 'DateTime-TimeZone',
'Template-Toolkit', 'URI'] %] 'Template-Toolkit', 'URI'] %]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment