[Rt-commit] rt branch, 4.6/cpanfile, created. rt-4.4.1-115-g8782803
Alex Vandiver
alexmv at bestpractical.com
Sat Jul 23 22:22:24 EDT 2016
The branch, 4.6/cpanfile has been created
at 8782803df56fceb367c6f25af604df36d2084ead (commit)
- Log -----------------------------------------------------------------
commit a6e7e054dcb3ed211693339d5e9ba150683ed79a
Author: Alex Vandiver <alex at chmrr.net>
Date: Sat Jun 4 14:21:56 2016 -0700
Store dependencies in cpanfile
Previously, dependencies were stored in a complicated hash for unclear
reasons, and traversed in random order. Additionally, the
specification of them included unwieldy boilerplate and here-docs.
Switch to storing the dependency list in a `cpanfile`, and load it by
stubbing the small number of functions to produce a useful
datastructure. This switches the format to the more expressive '>='
and '!=' syntax used in META.yml[1] files, condensing the "AVOID"
list away.
Because at least one of the database "features" is always required,
installing directly via `cpanm --install-deps .` is not suggested or
documented at this time. Using the `cpanfile` format, however, opens
the door to using `carton` and similar toolchains to manage
dependencies.
[1] https://metacpan.org/pod/CPAN::Meta::Spec#Version-Ranges
diff --git a/Makefile.in b/Makefile.in
index 4efc2ee..a57c073 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -169,6 +169,7 @@ ETC_FILES = acl.Pg \
schema.Oracle \
schema.mysql \
schema.SQLite \
+ cpanfile \
initialdata
diff --git a/etc/cpanfile b/etc/cpanfile
new file mode 100644
index 0000000..2e5d0c4
--- /dev/null
+++ b/etc/cpanfile
@@ -0,0 +1,206 @@
+# Core dependencies
+requires 'Apache::Session', '>= 1.53';
+requires 'Business::Hours';
+requires 'CGI', ($] >= 5.019003 ? '>= 4.00' : '>= 3.38');
+requires 'CGI::Cookie', '>= 1.20';
+requires 'CGI::Emulate::PSGI';
+requires 'CGI::PSGI', '>= 0.12';
+requires 'Class::Accessor::Fast';
+requires 'Convert::Color';
+requires 'Crypt::Eksblowfish';
+requires 'CSS::Minifier::XS';
+requires 'CSS::Squish', '>= 0.06';
+requires 'Data::GUID';
+requires 'Data::ICal';
+requires 'Data::Page::Pageset';
+requires 'Date::Extract', '>= 0.02';
+requires 'Date::Manip';
+requires 'DateTime', '>= 0.44';
+requires 'DateTime::Format::Natural', '>= 0.67';
+requires 'DateTime::Locale', '>= 0.40, != 1.00, != 1.01';
+requires 'DBI', '>= 1.37';
+requires 'DBIx::SearchBuilder', '>= 1.65';
+requires 'Devel::GlobalDestruction';
+requires 'Devel::StackTrace', '>= 1.19, != 1.28, != 1.29';
+requires 'Digest::base';
+requires 'Digest::MD5', '>= 2.27';
+requires 'Digest::SHA';
+requires 'Email::Address', '>= 1.897';
+requires 'Email::Address::List', '>= 0.02';
+requires 'Encode', '>= 2.64';
+requires 'Errno';
+requires 'File::Glob';
+requires 'File::ShareDir';
+requires 'File::Spec', '>= 0.8';
+requires 'File::Temp', '>= 0.19';
+requires 'HTML::Entities';
+requires 'HTML::FormatText::WithLinks', '>= 0.14';
+requires 'HTML::FormatText::WithLinks::AndTables', '>= 0.06';
+requires 'HTML::Mason', '>= 1.43';
+requires 'HTML::Mason::PSGIHandler', '>= 0.52';
+requires 'HTML::Quoted';
+requires 'HTML::RewriteAttributes', '>= 0.05';
+requires 'HTML::Scrubber', '>= 0.08';
+requires 'HTTP::Message', '>= 6.0';
+requires 'IPC::Run3';
+requires 'JavaScript::Minifier::XS';
+requires 'JSON';
+requires 'List::MoreUtils';
+requires 'Locale::Maketext', '>= 1.06';
+requires 'Locale::Maketext::Fuzzy', '>= 0.11';
+requires 'Locale::Maketext::Lexicon', '>= 0.32';
+requires 'Log::Dispatch', '>= 2.30';
+requires 'LWP::Simple';
+requires 'Mail::Header', '>= 2.12';
+requires 'Mail::Mailer', '>= 1.57';
+requires 'MIME::Entity', '>= 5.504';
+requires 'MIME::Types';
+requires 'Module::Refresh', '>= 0.03';
+requires 'Module::Versions::Report', '>= 1.05';
+requires 'Net::CIDR';
+requires 'Net::IP';
+requires 'Plack', '>= 1.0002';
+requires 'Plack::Handler::Starlet';
+requires 'Pod::Select';
+requires 'Regexp::Common';
+requires 'Regexp::Common::net::CIDR';
+requires 'Regexp::IPv6';
+requires 'Role::Basic', '>= 0.12';
+requires 'Scalar::Util';
+requires 'Scope::Upper';
+requires 'Storable', '>= 2.08';
+requires 'Symbol::Global::Name', ($] >= 5.019003 ? '>= 0.05' : '>= 0.04');
+requires 'Sys::Syslog', '>= 0.16';
+requires 'Text::Password::Pronounceable';
+requires 'Text::Quoted', '>= 2.07';
+requires 'Text::Template', '>= 1.44';
+requires 'Text::WikiFormat', '>= 0.76';
+requires 'Text::Wrapper';
+requires 'Time::HiRes';
+requires 'Time::ParseDate';
+requires 'Tree::Simple', '>= 1.04';
+requires 'UNIVERSAL::require';
+requires 'URI', '>= 1.59';
+requires 'URI::QueryParam';
+requires 'XML::RSS', '>= 1.05';
+
+# Mailgate
+requires 'Crypt::SSLeay';
+requires 'Getopt::Long';
+requires 'LWP::Protocol::https';
+requires 'LWP::UserAgent', '>= 6.0';
+requires 'Mozilla::CA';
+requires 'Net::SSL';
+requires 'Pod::Usage';
+
+# CLI
+requires 'Getopt::Long', '>= 2.24';
+requires 'HTTP::Request::Common';
+requires 'LWP';
+requires 'Term::ReadKey';
+requires 'Term::ReadLine';
+requires 'Text::ParseWords';
+
+
+on 'develop' => sub {
+ requires 'Email::Abstract';
+ requires 'File::Find';
+ requires 'File::Which';
+ requires 'HTML::Entities';
+ requires 'Locale::PO';
+ requires 'Log::Dispatch::Perl';
+ requires 'Mojo::DOM';
+ requires 'Plack::Middleware::Test::StashWarnings', '>= 0.08';
+ requires 'Pod::Simple', '>= 3.24';
+ requires 'Set::Tiny';
+ requires 'String::ShellQuote';
+ requires 'Test::Builder', '>= 0.90';
+ requires 'Test::Deep';
+ requires 'Test::Email';
+ requires 'Test::Expect', '>= 0.31';
+ requires 'Test::LongString';
+ requires 'Test::MockTime';
+ requires 'Test::NoWarnings';
+ requires 'Test::Pod';
+ requires 'Test::Warn';
+ requires 'Test::WWW::Mechanize', '>= 1.30';
+ requires 'Test::WWW::Mechanize::PSGI';
+ requires 'WWW::Mechanize', '>= 1.52';
+ requires 'XML::Simple';
+};
+
+
+# Deployment options
+feature 'standalone' => sub {};
+
+feature 'fastcgi' => sub {
+ requires 'FCGI', '>= 0.74';
+};
+
+feature 'modperl1' => sub {
+ requires 'Apache::Request';
+};
+
+feature 'modperl2' => sub {};
+
+
+# Database options
+feature 'mysql' => sub {
+ requires 'DBD::mysql', '>= 2.1018';
+};
+
+feature 'oracle' => sub {
+ requires 'DBD::Oracle != 1.23';
+};
+
+feature 'pg' => sub {
+ requires 'DBIx::SearchBuilder', '>= 1.66';
+ requires 'DBD::Pg', '>= 1.43';
+};
+
+feature 'sqlite' => sub {
+ requires 'DBD::SQLite', '>= 1.00';
+};
+
+
+# Optional features
+feature 'gpg' => sub {
+ requires 'File::Which';
+ requires 'GnuPG::Interface';
+ requires 'PerlIO::eol';
+};
+
+feature 'smime' => sub {
+ requires 'Crypt::X509';
+ requires 'File::Which';
+ requires 'String::ShellQuote';
+};
+
+feature 'graphviz' => sub {
+ requires 'GraphViz';
+ requires 'IPC::Run', '>= 0.90';
+};
+
+feature 'gd' => sub {
+ requires 'GD';
+ requires 'GD::Graph', '>= 1.47';
+ requires 'GD::Text';
+};
+
+feature 'externalauth' => sub {
+ requires 'Net::SSLeay';
+ requires 'Net::LDAP';
+ on 'develop' => sub {
+ requires 'Net::LDAP::Server::Test';
+ };
+};
+
+
+# External attachment storage
+feature 's3' => sub {
+ requires 'Amazon::S3';
+};
+
+feature 'dropbox' => sub {
+ requires 'File::Dropbox';
+};
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index 0e57ca1..e0813c5 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -46,22 +46,19 @@
# those contributions and any derivatives thereof.
#
# END BPS TAGGED BLOCK }}}
-#
-# This is just a basic script that checks to make sure that all
-# the modules needed by RT before you can install it.
-#
use strict;
use warnings;
-no warnings qw(numeric redefine);
+
use Getopt::Long;
+
use Cwd qw(abs_path);
-my %args;
-my %deps;
+use File::Spec;
my @orig_argv = @ARGV;
# Save our path because installers or tests can change cwd
my $script_path = abs_path($0);
+my %args;
GetOptions(
\%args,
'install!',
@@ -109,231 +106,27 @@ $args{$_} = $default{$_} foreach grep {!exists $args{$_}} keys %default;
$args{'with-EXTERNALAUTH-TESTS'}
= $args{'with-EXTERNALAUTH'} && $args{'with-DEVELOPER'};
-$deps{'CORE'} = [ text_to_hash( << '.') ];
-Apache::Session 1.53
-Business::Hours
-CGI 3.38
-CGI::Cookie 1.20
-CGI::Emulate::PSGI
-CGI::PSGI 0.12
-Class::Accessor::Fast
-Convert::Color
-Crypt::Eksblowfish
-CSS::Minifier::XS
-CSS::Squish 0.06
-Data::GUID
-Data::ICal
-Data::Page::Pageset
-Date::Extract 0.02
-Date::Manip
-DateTime 0.44
-DateTime::Format::Natural 0.67
-DateTime::Locale 0.40
-DBI 1.37
-DBIx::SearchBuilder 1.65
-Devel::GlobalDestruction
-Devel::StackTrace 1.19
-Digest::base
-Digest::MD5 2.27
-Digest::SHA
-Email::Address 1.897
-Email::Address::List 0.02
-Encode 2.64
-Errno
-File::Glob
-File::ShareDir
-File::Spec 0.8
-File::Temp 0.19
-HTML::Entities
-HTML::FormatText::WithLinks 0.14
-HTML::FormatText::WithLinks::AndTables 0.06
-HTML::Mason 1.43
-HTML::Mason::PSGIHandler 0.52
-HTML::Quoted
-HTML::RewriteAttributes 0.05
-HTML::Scrubber 0.08
-HTTP::Message 6.0
-IPC::Run3
-JavaScript::Minifier::XS
-JSON
-List::MoreUtils
-Locale::Maketext 1.06
-Locale::Maketext::Fuzzy 0.11
-Locale::Maketext::Lexicon 0.32
-Log::Dispatch 2.30
-LWP::Simple
-Mail::Header 2.12
-Mail::Mailer 1.57
-MIME::Entity 5.504
-MIME::Types
-Module::Refresh 0.03
-Module::Versions::Report 1.05
-Net::CIDR
-Net::IP
-Plack 1.0002
-Plack::Handler::Starlet
-Pod::Select
-Regexp::Common
-Regexp::Common::net::CIDR
-Regexp::IPv6
-Role::Basic 0.12
-Scalar::Util
-Scope::Upper
-Storable 2.08
-Symbol::Global::Name 0.04
-Sys::Syslog 0.16
-Text::Password::Pronounceable
-Text::Quoted 2.07
-Text::Template 1.44
-Text::WikiFormat 0.76
-Text::Wrapper
-Time::HiRes
-Time::ParseDate
-Tree::Simple 1.04
-UNIVERSAL::require
-URI 1.59
-URI::QueryParam
-XML::RSS 1.05
-.
-set_dep( CORE => 'Symbol::Global::Name' => 0.05 ) if $] >= 5.019003;
-set_dep( CORE => CGI => 4.00 ) if $] > 5.019003;
-
-$deps{'MAILGATE'} = [ text_to_hash( << '.') ];
-Crypt::SSLeay
-Getopt::Long
-LWP::Protocol::https
-LWP::UserAgent 6.0
-Mozilla::CA
-Net::SSL
-Pod::Usage
-.
-
-$deps{'CLI'} = [ text_to_hash( << '.') ];
-Getopt::Long 2.24
-HTTP::Request::Common
-LWP
-Term::ReadKey
-Term::ReadLine
-Text::ParseWords
-.
-
-$deps{'DEVELOPER'} = [ text_to_hash( << '.') ];
-Email::Abstract
-File::Find
-File::Which
-HTML::Entities
-Locale::PO
-Log::Dispatch::Perl
-Mojo::DOM
-Plack::Middleware::Test::StashWarnings 0.08
-Pod::Simple 3.24
-Set::Tiny
-String::ShellQuote 0 # needed for gnupg-incoming.t
-Test::Builder 0.90 # needed for is_passing
-Test::Deep 0 # needed for shredder tests
-Test::Email
-Test::Expect 0.31
-Test::LongString
-Test::MockTime
-Test::NoWarnings
-Test::Pod
-Test::Warn
-Test::WWW::Mechanize 1.30
-Test::WWW::Mechanize::PSGI
-WWW::Mechanize 1.52
-XML::Simple
-.
-
-$deps{'FASTCGI'} = [ text_to_hash( << '.') ];
-FCGI 0.74
-.
-
-$deps{'MODPERL1'} = [ text_to_hash( << '.') ];
-Apache::Request
-.
-
-$deps{'MYSQL'} = [ text_to_hash( << '.') ];
-DBD::mysql 2.1018
-.
-
-$deps{'ORACLE'} = [ text_to_hash( << '.') ];
-DBD::Oracle
-.
-
-$deps{'PG'} = [ text_to_hash( << '.') ];
-DBIx::SearchBuilder 1.66
-DBD::Pg 1.43
-.
-
-$deps{'SQLITE'} = [ text_to_hash( << '.') ];
-DBD::SQLite 1.00
-.
-
-$deps{'GPG'} = [ text_to_hash( << '.') ];
-File::Which
-GnuPG::Interface
-PerlIO::eol
-.
-
-$deps{'SMIME'} = [ text_to_hash( << '.') ];
-Crypt::X509
-File::Which
-String::ShellQuote
-.
-
-$deps{'GRAPHVIZ'} = [ text_to_hash( << '.') ];
-GraphViz
-IPC::Run 0.90
-.
-
-$deps{'GD'} = [ text_to_hash( << '.') ];
-GD
-GD::Graph 1.47
-GD::Text
-.
-
-$deps{'EXTERNALAUTH'} = [ text_to_hash( <<'.') ];
-Net::SSLeay
-Net::LDAP
-.
-
-$deps{'EXTERNALAUTH-TESTS'} = [ text_to_hash( <<'.') ];
-Net::LDAP::Server::Test
-.
-
-$deps{'S3'} = [ text_to_hash( <<'.') ];
-Amazon::S3
-.
-
-$deps{'DROPBOX'} = [ text_to_hash( <<'.') ];
-File::Dropbox
-.
-
-my %AVOID = (
- 'DBD::Oracle' => [qw(1.23)],
- 'Devel::StackTrace' => [qw(1.28 1.29)],
- 'DateTime::Locale' => [qw(1.00 1.01)]
-);
-
+my %deps = read_deps();
check_perl_version();
check_users();
-my %Missing_By_Type = ();
-foreach my $type ( sort grep {$args{$_}} keys %args ) {
- next unless ( $type =~ /^with-(.*?)$/ ) and $deps{$1};
+test_deps();
- $type = $1;
- section("$type dependencies");
+if ($args{'install'}) {
+ for my $type ( sort keys %deps ) {
+ for my $module (sort keys %{$deps{$type}}) {
+ # Recheck if the dependency is now satisfied, either
+ # because it was pulled in as part of some other install,
+ # or if it was failing to load because of bad deps.
+ next if test_dep( $module, $deps{$type}{$module} );
- my @missing;
- my @deps = @{ $deps{$type} };
+ resolve_dep( $module );
- my %missing = test_deps(@deps);
-
- if ( $args{'install'} ) {
- for my $module ( keys %missing ) {
- resolve_dep( $module, $missing{$module}{version} );
+ # Delete the module and reload it; if it was previously
+ # installed and got upgraded, this means the new version
+ # will get loaded if some later module goes looking for it
+ # as a prereq.
my $m = $module . '.pm';
$m =~ s!::!/!g;
if ( delete $INC{$m} ) {
@@ -344,19 +137,18 @@ foreach my $type ( sort grep {$args{$_}} keys %args ) {
delete $symtab->{$symbol};
}
}
- delete $missing{$module}
- if test_dep( $module, $missing{$module}{version}, $AVOID{$module} );
+
+ # Recheck, to catch install failures and the like
+ delete $deps{$type}{$module} if test_dep( $module, $deps{$type}{$module} );
}
+ delete $deps{$type} if not keys %{$deps{$type}};
}
-
- $Missing_By_Type{$type} = \%missing if keys %missing;
+ exec( $script_path, @orig_argv, '--no-install' ) if %deps;
}
-if ( $args{'install'} && keys %Missing_By_Type ) {
- exec( $script_path, @orig_argv, '--no-install' );
-} else {
- conclude(%Missing_By_Type);
-}
+conclude();
+exit 0;
+
sub section {
my $s = shift;
@@ -376,26 +168,21 @@ sub print_found {
}
sub conclude {
- my %missing_by_type = @_;
-
- unless ( keys %missing_by_type ) {
+ unless ( keys %deps ) {
print "\nAll dependencies have been found.\n";
return;
}
print "\nSOME DEPENDENCIES WERE MISSING.\n";
- for my $type ( keys %missing_by_type ) {
- my $missing = $missing_by_type{$type};
-
+ foreach my $type ( sort keys %deps ) {
print "$type missing dependencies:\n";
- for my $name ( keys %$missing ) {
- my $module = $missing->{$name};
- my $version = $module->{version};
- my $error = $module->{error};
- print_found(
- $name . ( $version && !$error ? " >= $version" : "" ),
- 0, $module->{error} );
+ for my $module (sort keys %{$deps{$type}}) {
+ my $spec = $deps{$type}{$module};
+ my ($ok, $error) = test_dep( $module, $spec );
+ next if $ok;
+ my $msg = $module . ( $spec && !$error ? " $spec" : "" );
+ print_found( $msg, $ok, $error );
}
}
@@ -405,73 +192,87 @@ sub conclude {
exit 1;
}
-sub text_to_hash {
- my %hash;
- for my $line ( split /\n/, $_[0] ) {
- my ( $key, $value ) = $line =~ /(\S+)\s*(\S*)/;
- $value ||= '';
- $hash{$key} = $value;
- }
-
- return %hash;
-}
-
-sub set_dep {
- my ( $name, $module, $version ) = @_;
- my %list = @{ $deps{$name} };
- $list{$module} = ( $version || '' );
- $deps{$name} = [%list];
+sub read_deps {
+ my %deps;
+
+ # 'local' would be cleaner, but you can't localize lexicals. :/
+ my @section = ('CORE');
+
+ no warnings 'once';
+ local *requires = sub {
+ $deps{$section[-1]}{$_[0]} = $_[1];
+ };
+ local *on = sub {
+ return unless $_[0] eq 'develop' and $args{'with-DEVELOPER'};
+ push @section, 'DEVELOPER';
+ $_[1]->();
+ pop @section;
+ };
+ local *feature = sub {
+ return unless $args{"with-".uc($_[0])};
+ push @section, uc( $_[0] );
+ $_[-1]->();
+ pop @section;
+ };
+
+ my ($vol, $dir, $path) = File::Spec->splitpath( $script_path );
+ my $ret = do "$dir/../etc/cpanfile";
+ die "Failed to load cpanfile: @{[$@ || $!]}" if not defined $ret and ($@ or $!);
+
+ return %deps;
}
sub test_deps {
- my @deps = @_;
-
- my %missing;
- while (@deps) {
- my $module = shift @deps;
- my $version = shift @deps;
- my ( $test, $error ) = test_dep( $module, $version, $AVOID{$module} );
- my $msg = $module . ( $version && !$error ? " >= $version" : '' );
- print_found( $msg, $test, $error );
-
- $missing{$module} = { version => $version, error => $error }
- unless $test;
+ foreach my $type ( sort keys %deps ) {
+ section("$type dependencies");
+
+ for my $module (sort keys %{$deps{$type}}) {
+ my $spec = $deps{$type}{$module};
+ my ($ok, $error) = test_dep( $module, $spec );
+ my $msg = $module . ( $spec && !$error ? " $spec" : "" );
+ print_found( $msg, $ok, $error );
+ delete $deps{$type}{$module} if $ok;
+ }
+ delete $deps{$type} if not keys %{$deps{$type}};
+ print "\n";
}
-
- return %missing;
}
sub test_dep {
- my $module = shift;
- my $version = shift;
- my $avoid = shift;
+ my ($module, $version_spec) = @_;
+ my @spec_parts = split /\s*,\s*/, defined $version_spec ? $version_spec : '';
+ my @req = grep {defined} map {/>=\s*(\S+)/ ? $1 : undef} @spec_parts;
+ my @avoid = grep {defined} map {/!=\s*(\S+)/ ? $1 : undef} @spec_parts;
+ @req = ('') unless @req;
no warnings 'deprecated';
- eval "{ local \$ENV{__WARN__}; use $module $version () }";
- if ( my $error = $@ ) {
- return 0 unless wantarray;
+ for my $version (@req) {
+ eval "{ local \$ENV{__WARN__}; use $module $version () }";
+ if ( my $error = $@ ) {
+ return 0 unless wantarray;
- $error =~ s/\n(.*)$//s;
- $error =~ s/at \(eval \d+\) line \d+\.$//;
- undef $error if $error =~ /this is only/;
+ $error =~ s/\n(.*)$//s;
+ $error =~ s/at \(eval \d+\) line \d+\.$//;
+ undef $error if $error =~ /this is only/;
- my $path = $module;
- $path =~ s{::}{/}g;
- undef $error
- if defined $error
- and $error =~ /^Can't locate $path\.pm in \@INC/;
+ my $path = $module;
+ $path =~ s{::}{/}g;
+ undef $error
+ if defined $error
+ and $error =~ /^Can't locate $path\.pm in \@INC/;
- return ( 0, $error );
+ return ( 0, $error );
+ }
}
- if ($avoid) {
- my $version = $module->VERSION;
- if ( grep {$version eq $_} @$avoid ) {
- return 0 unless wantarray;
- return ( 0,
- "It's known that there are problems with RT and version '$version' of '$module' module. If it's the latest available version of the module then you have to downgrade manually."
- );
- }
+ return 1 unless @avoid;
+
+ my $version = $module->VERSION;
+ if ( grep {$version eq $_} @avoid ) {
+ return 0 unless wantarray;
+ return ( 0,
+ "It's known that there are problems with RT and version '$version' of '$module' module. If it's the latest available version of the module then you have to downgrade manually."
+ );
}
return 1;
@@ -535,7 +336,6 @@ END
sub resolve_dep {
my $module = shift;
- my $version = shift;
unless ( defined $args{siteinstall} ) {
require Config;
commit 52af5d6f3bd7d282302a1f7012ade22ff5568557
Author: Alex Vandiver <alex at chmrr.net>
Date: Sun Jun 5 11:39:26 2016 -0700
Move perl version into cpanfile
diff --git a/etc/cpanfile b/etc/cpanfile
index 2e5d0c4..354114f 100644
--- a/etc/cpanfile
+++ b/etc/cpanfile
@@ -1,3 +1,5 @@
+requires 'perl', '5.10.1';
+
# Core dependencies
requires 'Apache::Session', '>= 1.53';
requires 'Business::Hours';
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index e0813c5..ee6b609 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -389,17 +389,18 @@ sub resolve_dep {
sub check_perl_version {
section("perl");
- eval { require 5.010_001 };
+ my $require = delete $deps{CORE}{perl};
+ eval "require $require";
if ($@) {
print_found(
- "5.10.1", 0,
+ $require, 0,
sprintf(
- "RT requires Perl v5.10.1 or newer. Your current Perl is v%vd",
+ "RT requires Perl v$require or newer. Your current Perl is v%vd",
$^V )
);
exit(1);
} else {
- print_found( sprintf( ">=5.10.1(%vd)", $^V ), 1 );
+ print_found( sprintf( ">=%s(%vd)", $require, $^V ), 1 );
}
}
commit d4dbf02d93a3620e7f58ce6411f21f1615174896
Author: Alex Vandiver <alex at chmrr.net>
Date: Sun Jun 5 11:34:41 2016 -0700
Rename print_found to row
This pairs better with "section", and removes ambiguity about if it
can be called when a resource was _not_ found.
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index ee6b609..c4dea2a 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -155,7 +155,7 @@ sub section {
print "$s:\n";
}
-sub print_found {
+sub row {
my $msg = shift;
my $test = shift;
my $extra = shift;
@@ -182,7 +182,7 @@ sub conclude {
my ($ok, $error) = test_dep( $module, $spec );
next if $ok;
my $msg = $module . ( $spec && !$error ? " $spec" : "" );
- print_found( $msg, $ok, $error );
+ row( $msg, $ok, $error );
}
}
@@ -230,7 +230,7 @@ sub test_deps {
my $spec = $deps{$type}{$module};
my ($ok, $error) = test_dep( $module, $spec );
my $msg = $module . ( $spec && !$error ? " $spec" : "" );
- print_found( $msg, $ok, $error );
+ row( $msg, $ok, $error );
delete $deps{$type}{$module} if $ok;
}
delete $deps{$type} if not keys %{$deps{$type}};
@@ -392,7 +392,7 @@ sub check_perl_version {
my $require = delete $deps{CORE}{perl};
eval "require $require";
if ($@) {
- print_found(
+ row(
$require, 0,
sprintf(
"RT requires Perl v$require or newer. Your current Perl is v%vd",
@@ -400,18 +400,18 @@ sub check_perl_version {
);
exit(1);
} else {
- print_found( sprintf( ">=%s(%vd)", $require, $^V ), 1 );
+ row( sprintf( ">=%s(%vd)", $require, $^V ), 1 );
}
}
sub check_users {
section("users");
- print_found( "rt group (@RTGROUP@)", defined getgrnam("@RTGROUP@") );
- print_found( "bin owner (@BIN_OWNER@)", defined getpwnam("@BIN_OWNER@") );
- print_found( "libs owner (@LIBS_OWNER@)", defined getpwnam("@LIBS_OWNER@") );
- print_found( "libs group (@LIBS_GROUP@)", defined getgrnam("@LIBS_GROUP@") );
- print_found( "web owner (@WEB_USER@)", defined getpwnam("@WEB_USER@") );
- print_found( "web group (@WEB_GROUP@)", defined getgrnam("@WEB_GROUP@") );
+ row( "rt group (@RTGROUP@)", defined getgrnam("@RTGROUP@") );
+ row( "bin owner (@BIN_OWNER@)", defined getpwnam("@BIN_OWNER@") );
+ row( "libs owner (@LIBS_OWNER@)", defined getpwnam("@LIBS_OWNER@") );
+ row( "libs group (@LIBS_GROUP@)", defined getgrnam("@LIBS_GROUP@") );
+ row( "web owner (@WEB_USER@)", defined getpwnam("@WEB_USER@") );
+ row( "web group (@WEB_GROUP@)", defined getgrnam("@WEB_GROUP@") );
}
1;
commit 7a83e47fa2ced219e602de3de54b3a8344d2eb63
Author: Alex Vandiver <alex at chmrr.net>
Date: Sun Jun 5 11:39:16 2016 -0700
Improve horizontal and vertical spacing of output
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index c4dea2a..21d42de 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -160,23 +160,27 @@ sub row {
my $test = shift;
my $extra = shift;
- print "\t$msg ...";
- print $test ? "found" : "MISSING";
- print "\n";
+ my $dots = "." x (55 - (length $msg));
- print "\t\t$extra\n" if defined $extra;
+ if ($test) {
+ print " $msg $dots ok\n";
+ } else {
+ print " $msg $dots MISSING\n";
+ print " $extra\n" if $extra;
+ }
}
sub conclude {
+ print "\n", "-" x 75, "\n\n";
unless ( keys %deps ) {
- print "\nAll dependencies have been found.\n";
+ print "All dependencies found.\n\n";
return;
}
- print "\nSOME DEPENDENCIES WERE MISSING.\n";
+ print "SOME DEPENDENCIES WERE MISSING:\n\n";
foreach my $type ( sort keys %deps ) {
- print "$type missing dependencies:\n";
+ section("$type dependencies");
for my $module (sort keys %{$deps{$type}}) {
my $spec = $deps{$type}{$module};
my ($ok, $error) = test_dep( $module, $spec );
@@ -184,9 +188,10 @@ sub conclude {
my $msg = $module . ( $spec && !$error ? " $spec" : "" );
row( $msg, $ok, $error );
}
+ print "\n";
}
- print "\nPerl library path for @PERL@:\n";
+ print "Perl library path for @PERL@:\n";
print " $_\n" for @INC;
exit 1;
@@ -402,6 +407,7 @@ sub check_perl_version {
} else {
row( sprintf( ">=%s(%vd)", $require, $^V ), 1 );
}
+ print "\n";
}
sub check_users {
@@ -412,6 +418,7 @@ sub check_users {
row( "libs group (@LIBS_GROUP@)", defined getgrnam("@LIBS_GROUP@") );
row( "web owner (@WEB_USER@)", defined getpwnam("@WEB_USER@") );
row( "web group (@WEB_GROUP@)", defined getgrnam("@WEB_GROUP@") );
+ print "\n";
}
1;
commit 4afbfd566d4b0ba215b8cd016ea63833b4a7562c
Author: Alex Vandiver <alex at chmrr.net>
Date: Sat Jun 4 15:22:26 2016 -0700
Show current version of module, when relevant
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index 21d42de..9d56282 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -158,14 +158,17 @@ sub section {
sub row {
my $msg = shift;
my $test = shift;
+ my $have = shift;
my $extra = shift;
my $dots = "." x (55 - (length $msg));
if ($test) {
- print " $msg $dots ok\n";
+ $have = $have ? "ok ($have)" : "ok";
+ print " $msg $dots $have\n";
} else {
- print " $msg $dots MISSING\n";
+ $have = $have ? "MISSING (have $have)" : "MISSING";
+ print " $msg $dots $have\n";
print " $extra\n" if $extra;
}
}
@@ -186,7 +189,8 @@ sub conclude {
my ($ok, $error) = test_dep( $module, $spec );
next if $ok;
my $msg = $module . ( $spec && !$error ? " $spec" : "" );
- row( $msg, $ok, $error );
+ my $v = $spec && eval { local $SIG{__WARN__}; $module->VERSION };
+ row( $msg, $ok, $v, $error );
}
print "\n";
}
@@ -235,7 +239,8 @@ sub test_deps {
my $spec = $deps{$type}{$module};
my ($ok, $error) = test_dep( $module, $spec );
my $msg = $module . ( $spec && !$error ? " $spec" : "" );
- row( $msg, $ok, $error );
+ my $v = $spec && eval { local $SIG{__WARN__}; $module->VERSION };
+ row( $msg, $ok, $v, $error );
delete $deps{$type}{$module} if $ok;
}
delete $deps{$type} if not keys %{$deps{$type}};
commit 080c4ac4007d2290cb2f31d182cc2fe4b9d1de89
Author: Alex Vandiver <alex at chmrr.net>
Date: Sun Jun 5 11:45:17 2016 -0700
Use "current value" for perl check as well
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index 9d56282..4a24ded 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -402,15 +402,10 @@ sub check_perl_version {
my $require = delete $deps{CORE}{perl};
eval "require $require";
if ($@) {
- row(
- $require, 0,
- sprintf(
- "RT requires Perl v$require or newer. Your current Perl is v%vd",
- $^V )
- );
+ row( $require, 0, sprintf("%vd", $^V ) );
exit(1);
} else {
- row( sprintf( ">=%s(%vd)", $require, $^V ), 1 );
+ row( $require, 1, sprintf( "%vd", $^V ) );
}
print "\n";
}
commit b063b228ce03d44542436993182631a590276b65
Author: Alex Vandiver <alex at chmrr.net>
Date: Sun Jun 5 11:46:17 2016 -0700
Use "current value" for user / group display
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index 4a24ded..17ed6e4 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -412,12 +412,22 @@ sub check_perl_version {
sub check_users {
section("users");
- row( "rt group (@RTGROUP@)", defined getgrnam("@RTGROUP@") );
- row( "bin owner (@BIN_OWNER@)", defined getpwnam("@BIN_OWNER@") );
- row( "libs owner (@LIBS_OWNER@)", defined getpwnam("@LIBS_OWNER@") );
- row( "libs group (@LIBS_GROUP@)", defined getgrnam("@LIBS_GROUP@") );
- row( "web owner (@WEB_USER@)", defined getpwnam("@WEB_USER@") );
- row( "web group (@WEB_GROUP@)", defined getgrnam("@WEB_GROUP@") );
+
+ my $line = sub {
+ my ($type, $func, $name, $value) = @_;
+ my $id = $func->($value);
+ my $return_type = substr($type,0,1)."id";
+ row("$name $type ($value)", defined $id, defined $id ? "$return_type $id" : undef);
+ };
+ my $group = sub { $line->("group", sub {getgrnam($_[0])}, @_) };
+ my $user = sub { $line->("user", sub {getpwnam($_[0])}, @_) };
+
+ $group->( rt => "@RTGROUP@" );
+ $user->( bin => "@BIN_OWNER@" );
+ $user->( libs => "@LIBS_OWNER@" );
+ $group->( libs => "@LIBS_GROUP@" );
+ $user->( web => "@WEB_USER@" );
+ $group->( web => "@WEB_GROUP@" );
print "\n";
}
commit 7eb35c70a5bf93c9effdab64bb290e755772b4e2
Author: Alex Vandiver <alex at chmrr.net>
Date: Sun Jun 5 11:46:41 2016 -0700
Rename check_users, since it checks groups as well
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index 17ed6e4..c343316 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -109,7 +109,7 @@ $args{'with-EXTERNALAUTH-TESTS'}
my %deps = read_deps();
check_perl_version();
-check_users();
+check_users_groups();
test_deps();
@@ -410,8 +410,8 @@ sub check_perl_version {
print "\n";
}
-sub check_users {
- section("users");
+sub check_users_groups {
+ section("users / groups");
my $line = sub {
my ($type, $func, $name, $value) = @_;
commit a1eeb10a73f2d03822052cef5bc998be0b0db833
Author: Alex Vandiver <alex at chmrr.net>
Date: Sun Jun 5 11:46:58 2016 -0700
Fail-fast if the users or groups do not check out
Any failures of this information are not re-summarized after modules
are checked, which may cause it to be lost in the scrollback.
Additionally, such failures did not cause a failing exit code.
Like the perl version check, abort immediately if there are any
failures in this section.
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index c343316..d94838c 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -413,9 +413,11 @@ sub check_perl_version {
sub check_users_groups {
section("users / groups");
+ my $fails = 0;
my $line = sub {
my ($type, $func, $name, $value) = @_;
my $id = $func->($value);
+ $fails++ unless defined $id;
my $return_type = substr($type,0,1)."id";
row("$name $type ($value)", defined $id, defined $id ? "$return_type $id" : undef);
};
@@ -429,6 +431,7 @@ sub check_users_groups {
$user->( web => "@WEB_USER@" );
$group->( web => "@WEB_GROUP@" );
print "\n";
+ exit 1 if $fails;
}
1;
commit f2c4c6e6a6598b34f5c9b8f05e5fd8f7395fcf68
Author: Alex Vandiver <alex at chmrr.net>
Date: Sat Jun 4 14:24:36 2016 -0700
Show output with colors when run from a terminal
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index d94838c..fd771ce 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -150,9 +150,15 @@ conclude();
exit 0;
+sub grey { return -t STDOUT ? "\e[1;30m$_[0]\e[0m" : $_[0]; }
+sub bright_blue { return -t STDOUT ? "\e[1;34m$_[0]\e[0m" : $_[0]; }
+sub green { return -t STDOUT ? "\e[32m$_[0]\e[0m" : $_[0]; }
+sub bright_green { return -t STDOUT ? "\e[1;32m$_[0]\e[0m" : $_[0]; }
+sub bright_red { return -t STDOUT ? "\e[1;31m$_[0]\e[0m" : $_[0]; }
+
sub section {
my $s = shift;
- print "$s:\n";
+ print bright_blue("$s:\n");
}
sub row {
@@ -161,26 +167,26 @@ sub row {
my $have = shift;
my $extra = shift;
- my $dots = "." x (55 - (length $msg));
+ my $dots = grey("." x (55 - (length $msg)));
if ($test) {
- $have = $have ? "ok ($have)" : "ok";
+ $have = green($have ? "ok ($have)" : "ok");
print " $msg $dots $have\n";
} else {
- $have = $have ? "MISSING (have $have)" : "MISSING";
+ $have = bright_red($have ? "MISSING (have $have)" : "MISSING");
print " $msg $dots $have\n";
- print " $extra\n" if $extra;
+ print " ". bright_red($extra) . "\n" if $extra;
}
}
sub conclude {
print "\n", "-" x 75, "\n\n";
unless ( keys %deps ) {
- print "All dependencies found.\n\n";
+ print bright_green("All dependencies found.\n\n");
return;
}
- print "SOME DEPENDENCIES WERE MISSING:\n\n";
+ print bright_red("SOME DEPENDENCIES WERE MISSING:\n\n");
foreach my $type ( sort keys %deps ) {
section("$type dependencies");
commit 4d50869493b80efad910b49108f2b02a27bbabe9
Author: Alex Vandiver <alex at chmrr.net>
Date: Sun Jun 5 12:50:40 2016 -0700
Move database and deployment defaults into rt-test-dependencies
rt-test-dependencies is rewritten with most, but not all, of its
arguments set to their configure-time values. However, it requires
that users pass in the appropriate values for their database and
deployment method -- the two most key configuration settings. Running
rt-test-dependencies directly (instead of via `make testdeps`) can
thus lead to a false belief that all dependencies are satisfied,
because deployment and database dependencies are not being checked.
Move the dependency and deployment defaulting into
rt-test-dependencies, from the Makefile. In case rt-test-dependencies
is being called with an explicit database or deployment type, these
defaults are only set if no explicit setting is observed on the
command line.
diff --git a/Makefile.in b/Makefile.in
index a57c073..75190c0 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -265,14 +265,13 @@ upgrade-instruct:
upgrade: testdeps config-install dirs files-install fixperms upgrade-instruct
-my_with_web_handlers= $(shell $(PERL) -e 'print join " ", map "--with-$$_", grep defined && length, split /,/, "$(WEB_HANDLER)"')
testdeps:
- $(PERL) ./sbin/rt-test-dependencies --with-$(DB_TYPE) $(my_with_web_handlers)
+ $(PERL) ./sbin/rt-test-dependencies
depends: fixdeps
fixdeps:
- $(PERL) ./sbin/rt-test-dependencies --install --with-$(DB_TYPE) $(my_with_web_handlers)
+ $(PERL) ./sbin/rt-test-dependencies --install
#}}}
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index fd771ce..9e812e4 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -101,6 +101,13 @@ my %default = (
'with-S3' => (uc(q{@ATTACHMENT_STORE@}) eq 'S3'),
'with-DROPBOX' => (uc(q{@ATTACHMENT_STORE@}) eq 'DROPBOX'),
);
+
+$default{"with-".uc("@DB_TYPE@")} = 1 unless grep {$args{"with-$_"}} qw/MYSQL PG SQLITE ORACLE/;
+unless (grep {$args{"with-$_"}} qw/FASTCGI MODPERL1 MODPERL2 STANDALONE/) {
+ $default{"with-".uc($_)} = 1 for grep {defined && length} split /,/, "@WEB_HANDLER@"
+}
+
+
$args{$_} = $default{$_} foreach grep {!exists $args{$_}} keys %default;
$args{'with-EXTERNALAUTH-TESTS'}
commit caddbd6587925d973ba5aa81d7a2e393b6bf62b2
Author: Alex Vandiver <alex at chmrr.net>
Date: Thu Jun 9 14:44:16 2016 -0700
Encode::Guess is included in Encode 1.60 and above; RT requires 2.64
This is not an optional dependency; it is guaranteed to be included in
the Encode distribution that RT requires.
diff --git a/lib/RT/I18N.pm b/lib/RT/I18N.pm
index 60a6622..60ccaba 100644
--- a/lib/RT/I18N.pm
+++ b/lib/RT/I18N.pm
@@ -65,6 +65,7 @@ use base 'Locale::Maketext::Fuzzy';
use MIME::Entity;
use MIME::Head;
use File::Glob;
+use Encode::Guess;
# I decree that this project's first language is English.
@@ -506,11 +507,11 @@ sub _FindOrGuessCharset {
=head2 _GuessCharset STRING
-use Encode::Guess to try to figure it out the string's encoding.
+Use Encode::Guess, and optionally Encode::Detect::Detector, to try to
+figure it out the string's encoding.
=cut
-use constant HAS_ENCODE_GUESS => Encode::Guess->require;
use constant HAS_ENCODE_DETECT => Encode::Detect::Detector->require;
sub _GuessCharset {
@@ -551,11 +552,6 @@ sub _GuessCharset {
return $fallback;
}
- unless ( HAS_ENCODE_GUESS ) {
- $RT::Logger->error("We couldn't load Encode::Guess module, fallback to $fallback");
- return $fallback;
- }
-
Encode::Guess->set_suspects( @encodings );
my $decoder = Encode::Guess->guess( $_[0] );
unless ( defined $decoder ) {
diff --git a/t/api/i18n_guess.t b/t/api/i18n_guess.t
index 0a99011..870ab95 100644
--- a/t/api/i18n_guess.t
+++ b/t/api/i18n_guess.t
@@ -4,7 +4,6 @@ use warnings;
use RT::Test tests => 16;
-use constant HAS_ENCODE_GUESS => Encode::Guess->require;
use constant HAS_ENCODE_DETECT => Encode::Detect::Detector->require;
my $string = "\x{442}\x{435}\x{441}\x{442} \x{43f}\x{43e}\x{434}\x{434}\x{435}\x{440}\x{436}\x{43a}\x{430}";
@@ -24,7 +23,6 @@ SKIP: {
RT->Config->Set(EmailInputEncodings => qw(UTF-8 cp1251 koi8-r));
SKIP: {
- skip "No Encode::Guess", 4 unless HAS_ENCODE_GUESS;
guess('utf-8', $string);
guess('cp1251', $string);
guess('windows-1251', $string, 'cp1251');
@@ -36,7 +34,6 @@ SKIP: {
RT->Config->Set(EmailInputEncodings => qw(UTF-8 koi8-r cp1251));
SKIP: {
- skip "No Encode::Guess", 3 unless HAS_ENCODE_GUESS;
guess('utf-8', $string);
guess('koi8-r', $string);
{
@@ -49,7 +46,6 @@ SKIP: {
RT->Config->Set(EmailInputEncodings => qw(UTF-8 windows-1251 koi8-r));
RT->Config->PostLoadCheck;
SKIP: {
- skip "No Encode::Guess", 3 unless HAS_ENCODE_GUESS;
guess('utf-8', $string);
guess('cp1251', $string);
{
commit 6e68c08c38d21b33a375954aa949af64c1086cf4
Author: Alex Vandiver <alex at chmrr.net>
Date: Thu Jul 21 23:51:57 2016 -0700
Make Encode::Detect::Detector a required dependency
Encode::Detect::Detector was only used if configured in RT_Config.pm,
and if the optional dependency had been installed. Instead, always
install it as a dependency, and better document how it functions to
help administrators to understand the option. This removes a
mostly-undocumented optional dependency.
diff --git a/etc/RT_Config.pm.in b/etc/RT_Config.pm.in
index 705c6c9..0b5d1c7 100644
--- a/etc/RT_Config.pm.in
+++ b/etc/RT_Config.pm.in
@@ -2586,9 +2586,35 @@ Set(@LexiconLanguages, qw(*));
An array that contains default encodings used to guess which charset
an attachment uses, if it does not specify one explicitly. All
-options must be recognized by L<Encode::Guess>. The first element may
-also be '*', which enables encoding detection using
-L<Encode::Detect::Detector>, if installed.
+options must be recognized by L<Encode::Guess>.
+
+The first element may also be C<*>, which attempts encoding detection
+using L<Encode::Detect::Detector>. This uses Mozilla's character
+detection library to examine the bytes, and use frequency metrics to
+rank the options. This detection may fail (and fall back to other
+options in the C<@EmailInputEncodings> list) if no decoding has high
+enough confidence metrics. As of L<Encode::Detect::Detector> version
+1.01, it knows the following encodings:
+
+ big5-eten
+ cp1250
+ cp1251
+ cp1253
+ cp1255
+ cp855
+ cp866
+ euc-jp
+ euc-kr
+ euc-tw
+ gb18030
+ iso-8859-2
+ iso-8859-5
+ iso-8859-7
+ iso-8859-11
+ koi8-r
+ MacCyrillic
+ shiftjis
+ utf-8
=cut
diff --git a/etc/cpanfile b/etc/cpanfile
index 354114f..4d29848 100644
--- a/etc/cpanfile
+++ b/etc/cpanfile
@@ -30,6 +30,7 @@ requires 'Digest::SHA';
requires 'Email::Address', '>= 1.897';
requires 'Email::Address::List', '>= 0.02';
requires 'Encode', '>= 2.64';
+requires 'Encode::Detect::Detector';
requires 'Errno';
requires 'File::Glob';
requires 'File::ShareDir';
diff --git a/lib/RT/I18N.pm b/lib/RT/I18N.pm
index 60ccaba..5ae08c2 100644
--- a/lib/RT/I18N.pm
+++ b/lib/RT/I18N.pm
@@ -66,6 +66,7 @@ use MIME::Entity;
use MIME::Head;
use File::Glob;
use Encode::Guess;
+use Encode::Detect::Detector;
# I decree that this project's first language is English.
@@ -507,13 +508,11 @@ sub _FindOrGuessCharset {
=head2 _GuessCharset STRING
-Use Encode::Guess, and optionally Encode::Detect::Detector, to try to
-figure it out the string's encoding.
+Use L<Encode::Guess> and L<Encode::Detect::Detector> to try to figure it out
+the string's encoding.
=cut
-use constant HAS_ENCODE_DETECT => Encode::Detect::Detector->require;
-
sub _GuessCharset {
my $fallback = _CanonicalizeCharset('iso-8859-1');
@@ -529,21 +528,12 @@ sub _GuessCharset {
if ( $encodings[0] eq '*' ) {
shift @encodings;
- if ( HAS_ENCODE_DETECT ) {
- my $charset = Encode::Detect::Detector::detect( $_[0] );
- if ( $charset ) {
- $RT::Logger->debug("Encode::Detect::Detector guessed encoding: $charset");
- return _CanonicalizeCharset( Encode::resolve_alias( $charset ) );
- }
- else {
- $RT::Logger->debug("Encode::Detect::Detector failed to guess encoding");
- }
- }
- else {
- $RT::Logger->error(
- "You requested to guess encoding, but we couldn't"
- ." load Encode::Detect::Detector module"
- );
+ my $charset = Encode::Detect::Detector::detect( $_[0] );
+ if ( $charset ) {
+ $RT::Logger->debug("Encode::Detect::Detector guessed encoding: $charset");
+ return _CanonicalizeCharset( Encode::resolve_alias( $charset ) );
+ } else {
+ $RT::Logger->debug("Encode::Detect::Detector failed to guess encoding");
}
}
diff --git a/t/api/i18n_guess.t b/t/api/i18n_guess.t
index 870ab95..4de90cc 100644
--- a/t/api/i18n_guess.t
+++ b/t/api/i18n_guess.t
@@ -4,8 +4,6 @@ use warnings;
use RT::Test tests => 16;
-use constant HAS_ENCODE_DETECT => Encode::Detect::Detector->require;
-
my $string = "\x{442}\x{435}\x{441}\x{442} \x{43f}\x{43e}\x{434}\x{434}\x{435}\x{440}\x{436}\x{43a}\x{430}";
sub guess {
@@ -15,7 +13,6 @@ sub guess {
RT->Config->Set(EmailInputEncodings => qw(*));
SKIP: {
- skip "No Encode::Detect", 3 unless HAS_ENCODE_DETECT;
guess('utf-8', $string);
guess('cp1251', $string);
guess('koi8-r', $string);
@@ -56,7 +53,6 @@ SKIP: {
RT->Config->Set(EmailInputEncodings => qw(* UTF-8 cp1251 koi8-r));
SKIP: {
- skip "No Encode::Detect", 3 unless HAS_ENCODE_DETECT;
guess('utf-8', $string);
guess('cp1251', $string);
guess('koi8-r', $string);
commit b7cdb92a88913d11cc6ffb246f07b66b017f6ce3
Author: Alex Vandiver <alex at chmrr.net>
Date: Sat Jul 23 19:15:50 2016 -0700
Make Encode::HanExtra a required dependency
This makes RT better able to handle non-European mail. While
previously an error was placed in the logs suggesting the installation
if a message was encounted which needed it, it was already too late
for that message.
There is functionally no cost to making it a required dependency; add
it.
diff --git a/etc/cpanfile b/etc/cpanfile
index 4d29848..bb82da6 100644
--- a/etc/cpanfile
+++ b/etc/cpanfile
@@ -31,6 +31,7 @@ requires 'Email::Address', '>= 1.897';
requires 'Email::Address::List', '>= 0.02';
requires 'Encode', '>= 2.64';
requires 'Encode::Detect::Detector';
+requires 'Encode::HanExtra';
requires 'Errno';
requires 'File::Glob';
requires 'File::ShareDir';
diff --git a/lib/RT/I18N.pm b/lib/RT/I18N.pm
index 5ae08c2..f8ef86b 100644
--- a/lib/RT/I18N.pm
+++ b/lib/RT/I18N.pm
@@ -65,6 +65,7 @@ use base 'Locale::Maketext::Fuzzy';
use MIME::Entity;
use MIME::Head;
use File::Glob;
+use Encode::HanExtra;
use Encode::Guess;
use Encode::Detect::Detector;
@@ -594,12 +595,6 @@ sub _CanonicalizeCharset {
# gbk is superset of gb2312/euc-cn so it's safe
return 'gbk';
}
- elsif ( $charset =~ /^(?:(?:big5(-1984|-2003|ext|plus))|cccii|unisys|euc-tw|gb18030|(?:cns11643-\d+))$/ ) {
- unless ( Encode::HanExtra->require ) {
- RT->Logger->error("Please install Encode::HanExtra to handle $charset");
- }
- return $charset;
- }
else {
return $charset;
}
commit fdf53ec63fc76310b3c99e55db6aa04158521608
Author: Alex Vandiver <alex at chmrr.net>
Date: Thu Jul 21 21:53:13 2016 -0700
Make HTML::FormatExternal dependency required, not runtime optional
Previously, installing the optional HTML::FormatExternal dependency
altered RT's behavior when downgrading HTML-only messages (both
incoming and outgoing) into plain text, by using external programs as
rendering engines. This improved on the pure-perl
HTML::FormatText::WithLinks::AndTables greatly, especially as that
module sometimes threw exceptions and produced no output.
Make it no longer a sparsely-documented optional dependency, but
rather a core dependency.
diff --git a/etc/cpanfile b/etc/cpanfile
index bb82da6..6425c35 100644
--- a/etc/cpanfile
+++ b/etc/cpanfile
@@ -38,6 +38,7 @@ requires 'File::ShareDir';
requires 'File::Spec', '>= 0.8';
requires 'File::Temp', '>= 0.19';
requires 'HTML::Entities';
+requires 'HTML::FormatExternal';
requires 'HTML::FormatText::WithLinks', '>= 0.14';
requires 'HTML::FormatText::WithLinks::AndTables', '>= 0.06';
requires 'HTML::Mason', '>= 1.43';
diff --git a/lib/RT/Interface/Email.pm b/lib/RT/Interface/Email.pm
index 23543fc..7587f78 100644
--- a/lib/RT/Interface/Email.pm
+++ b/lib/RT/Interface/Email.pm
@@ -1456,12 +1456,6 @@ sub _HTMLFormatter {
require HTML::FormatText::WithLinks::AndTables;
$formatter = \&_HTMLFormatText;
} else {
- unless (HTML::FormatExternal->require) {
- RT->Logger->warn("HTML::FormatExternal is not installed; falling back to internal perl formatter")
- if $wanted;
- next;
- }
-
my $path = $prog =~ s{(.*/)}{} ? $1 : undef;
my $package = "HTML::FormatText::" . ucfirst($prog);
unless ($package->require) {
commit 8782803df56fceb367c6f25af604df36d2084ead
Author: Alex Vandiver <alex at chmrr.net>
Date: Thu Jul 21 22:52:34 2016 -0700
Make HTML::Gumbo required, and split scrubbing into its own class
HTML::Gumbo was previously an optional runtime dependency, which
allowed tables to not be scrubbed because it guaranteed that the
user-provided content couldn't "escape" the confines of the
transaction history.
Make HTML::Gumbo a required dependency, allowing tables in HTML for
all installations of RT. In doing so, factor out the HTML-scrubbing
code into its own class, for compartmentalization.
diff --git a/docs/UPGRADING-4.6 b/docs/UPGRADING-4.6
new file mode 100644
index 0000000..6755ffa
--- /dev/null
+++ b/docs/UPGRADING-4.6
@@ -0,0 +1,24 @@
+=head1 UPGRADING FROM RT 4.4.0 and greater
+
+The 4.6 release is a major upgrade and as such there are more changes
+than in a minor bugfix release (e.g., 4.4.0 to 4.4.1) and some of these
+changes are backward-incompatible. The following lists some of the notable
+changes, especially those that might require you to change a configuration
+option or other setting due to a change in RT. Read this section carefully
+before you upgrade and look for changes to features you currently use.
+
+See F<devel/docs/UPGRADING-4.6> for internals changes relevant to
+extension writers.
+
+=over
+
+=item *
+
+The variables which alter the set of HTML elements allowed in HTML
+scrubbing have moved; they have been renamed, and are now found under
+L<RT::Interface::Web::Scrubber>.
+
+=back
+
+=cut
+
diff --git a/etc/RT_Config.pm.in b/etc/RT_Config.pm.in
index 0b5d1c7..bf9f01e 100644
--- a/etc/RT_Config.pm.in
+++ b/etc/RT_Config.pm.in
@@ -2033,9 +2033,6 @@ multiple vectors for XSS and phishing attacks. If
L</$TrustHTMLAttachments> is enabled, the original HTML is available for
viewing via the "Download" link.
-If the optional L<HTML::Gumbo> dependency is installed, RT will leverage
-this to allow a broader set of HTML through, including tables.
-
=cut
Set($PreferRichText, 1);
diff --git a/etc/cpanfile b/etc/cpanfile
index 6425c35..59e4b3c 100644
--- a/etc/cpanfile
+++ b/etc/cpanfile
@@ -41,6 +41,7 @@ requires 'HTML::Entities';
requires 'HTML::FormatExternal';
requires 'HTML::FormatText::WithLinks', '>= 0.14';
requires 'HTML::FormatText::WithLinks::AndTables', '>= 0.06';
+requires 'HTML::Gumbo';
requires 'HTML::Mason', '>= 1.43';
requires 'HTML::Mason::PSGIHandler', '>= 0.52';
requires 'HTML::Quoted';
diff --git a/lib/RT/Interface/Web.pm b/lib/RT/Interface/Web.pm
index e3cf905..33e810d 100644
--- a/lib/RT/Interface/Web.pm
+++ b/lib/RT/Interface/Web.pm
@@ -60,6 +60,7 @@ RT::Interface::Web
use strict;
use warnings;
+use 5.010;
package RT::Interface::Web;
@@ -68,6 +69,7 @@ use RT::CustomRoles;
use URI qw();
use RT::Interface::Web::Menu;
use RT::Interface::Web::Session;
+use RT::Interface::Web::Scrubber;
use Digest::MD5 ();
use List::MoreUtils qw();
use JSON qw();
@@ -4261,129 +4263,9 @@ Removes unsafe and undesired HTML from the passed content
=cut
-my $SCRUBBER;
sub ScrubHTML {
- my $Content = shift;
- $SCRUBBER = _NewScrubber() unless $SCRUBBER;
-
- $Content = '' if !defined($Content);
- return $SCRUBBER->scrub($Content);
-}
-
-=head2 _NewScrubber
-
-Returns a new L<HTML::Scrubber> object.
-
-If you need to be more lax about what HTML tags and attributes are allowed,
-create C</opt/rt4/local/lib/RT/Interface/Web_Local.pm> with something like the
-following:
-
- package HTML::Mason::Commands;
- # Let tables through
- push @SCRUBBER_ALLOWED_TAGS, qw(TABLE THEAD TBODY TFOOT TR TD TH);
- 1;
-
-=cut
-
-our @SCRUBBER_ALLOWED_TAGS = qw(
- A B U P BR I HR BR SMALL EM FONT SPAN STRONG SUB SUP S DEL STRIKE H1 H2 H3 H4 H5
- H6 DIV UL OL LI DL DT DD PRE BLOCKQUOTE BDO
-);
-
-our %SCRUBBER_ALLOWED_ATTRIBUTES = (
- # Match http, https, ftp, mailto and relative urls
- # XXX: we also scrub format strings with this module then allow simple config options
- href => qr{^(?:https?:|ftp:|mailto:|/|__Web(?:Path|HomePath|BaseURL|URL)__)}i,
- face => 1,
- size => 1,
- color => 1,
- target => 1,
- style => qr{
- ^(?:\s*
- (?:(?:background-)?color: \s*
- (?:rgb\(\s* \d+, \s* \d+, \s* \d+ \s*\) | # rgb(d,d,d)
- \#[a-f0-9]{3,6} | # #fff or #ffffff
- [\w\-]+ # green, light-blue, etc.
- ) |
- text-align: \s* \w+ |
- font-size: \s* [\w.\-]+ |
- font-family: \s* [\w\s"',.\-]+ |
- font-weight: \s* [\w\-]+ |
-
- border-style: \s* \w+ |
- border-color: \s* [#\w]+ |
- border-width: \s* [\s\w]+ |
- padding: \s* [\s\w]+ |
- margin: \s* [\s\w]+ |
-
- # MS Office styles, which are probably fine. If we don't, then any
- # associated styles in the same attribute get stripped.
- mso-[\w\-]+?: \s* [\w\s"',.\-]+
- )\s* ;? \s*)
- +$ # one or more of these allowed properties from here 'till sunset
- }ix,
- dir => qr/^(rtl|ltr)$/i,
- lang => qr/^\w+(-\w+)?$/,
-
- # timeworked per user attributes
- 'data-ticket-id' => 1,
- 'data-ticket-class' => 1,
-);
-
-our %SCRUBBER_RULES = ();
-
-# If we're displaying images, let embedded ones through
-if (RT->Config->Get('ShowTransactionImages') or RT->Config->Get('ShowRemoteImages')) {
- $SCRUBBER_RULES{'img'} = {
- '*' => 0,
- alt => 1,
- };
-
- my @src;
- push @src, qr/^cid:/i
- if RT->Config->Get('ShowTransactionImages');
-
- push @src, $SCRUBBER_ALLOWED_ATTRIBUTES{'href'}
- if RT->Config->Get('ShowRemoteImages');
-
- $SCRUBBER_RULES{'img'}->{'src'} = join "|", @src;
-}
-
-sub _NewScrubber {
- require HTML::Scrubber;
- my $scrubber = HTML::Scrubber->new();
-
- if (HTML::Gumbo->require) {
- no warnings 'redefine';
- my $orig = \&HTML::Scrubber::scrub;
- *HTML::Scrubber::scrub = sub {
- my $self = shift;
-
- eval { $_[0] = HTML::Gumbo->new->parse( $_[0] ); chomp $_[0] };
- warn "HTML::Gumbo pre-parse failed: $@" if $@;
- return $orig->($self, @_);
- };
- push @SCRUBBER_ALLOWED_TAGS, qw/TABLE THEAD TBODY TFOOT TR TD TH/;
- $SCRUBBER_ALLOWED_ATTRIBUTES{$_} = 1 for
- qw/colspan rowspan align valign cellspacing cellpadding border width height/;
- }
-
- $scrubber->default(
- 0,
- {
- %SCRUBBER_ALLOWED_ATTRIBUTES,
- '*' => 0, # require attributes be explicitly allowed
- },
- );
- $scrubber->deny(qw[*]);
- $scrubber->allow(@SCRUBBER_ALLOWED_TAGS);
- $scrubber->rules(%SCRUBBER_RULES);
-
- # Scrubbing comments is vital since IE conditional comments can contain
- # arbitrary HTML and we'd pass it right on through.
- $scrubber->comment(0);
-
- return $scrubber;
+ state $scrubber = RT::Interface::Web::Scrubber->new;
+ return $scrubber->scrub(@_);
}
=head2 JSON
diff --git a/lib/RT/Interface/Web/Scrubber.pm b/lib/RT/Interface/Web/Scrubber.pm
new file mode 100644
index 0000000..dccc824
--- /dev/null
+++ b/lib/RT/Interface/Web/Scrubber.pm
@@ -0,0 +1,181 @@
+package RT::Interface::Web::Scrubber;
+use 5.010;
+use base qw/HTML::Scrubber/;
+
+use HTML::Gumbo;
+
+=head1 NAME
+
+RT::Interface::Web::Scrubber
+
+=head1 DESCRIPTION
+
+This is a subclass of L<HTML::Scrubber> which automatically configures
+itself with a sane and safe default set of rules. Additionally, it
+ensures that the input is balanced HTML by use of the L<HTML::Gumbo>
+on the input to L</scrub>.
+
+=head1 VARIABLES
+
+These variables can be altered by creating a C<Scrubber_Local.pm>
+file, containing something of the form:
+
+ package RT::Interface::Web::Scrubber;
+
+ # Allow the "title" attribute
+ $ALLOWED_ATTRIBUTES{title} = 1;
+
+=over
+
+=item C<@ALLOWED_TAGS>
+
+Passed to L<HTML::Scrubber/allow>.
+
+=item C<%ALLOWED_ATTRIBUTES>
+
+Passed into L<HTML::Scrubber/default>.
+
+=item C<%RULES>
+
+Passed to L<HTML::Scrubber/rules>.
+
+=back
+
+=cut
+
+our @ALLOWED_TAGS = qw(
+ A B U P BR I HR BR SMALL EM FONT SPAN STRONG SUB SUP S DEL STRIKE H1 H2 H3 H4 H5
+ H6 DIV UL OL LI DL DT DD PRE BLOCKQUOTE BDO TABLE THEAD TBODY TFOOT TR TD TH
+);
+
+our %ALLOWED_ATTRIBUTES = (
+ # Match http, https, ftp, mailto and relative urls
+ # XXX: we also scrub format strings with this module then allow simple config options
+ href => qr{^(?:https?:|ftp:|mailto:|/|__Web(?:Path|HomePath|BaseURL|URL)__)}i,
+ face => 1,
+ size => 1,
+ color => 1,
+ target => 1,
+ style => qr{
+ ^(?:\s*
+ (?:(?:background-)?color: \s*
+ (?:rgb\(\s* \d+, \s* \d+, \s* \d+ \s*\) | # rgb(d,d,d)
+ \#[a-f0-9]{3,6} | # #fff or #ffffff
+ [\w\-]+ # green, light-blue, etc.
+ ) |
+ text-align: \s* \w+ |
+ font-size: \s* [\w.\-]+ |
+ font-family: \s* [\w\s"',.\-]+ |
+ font-weight: \s* [\w\-]+ |
+
+ border-style: \s* \w+ |
+ border-color: \s* [#\w]+ |
+ border-width: \s* [\s\w]+ |
+ padding: \s* [\s\w]+ |
+ margin: \s* [\s\w]+ |
+
+ # MS Office styles, which are probably fine. If we don't, then any
+ # associated styles in the same attribute get stripped.
+ mso-[\w\-]+?: \s* [\w\s"',.\-]+
+ )\s* ;? \s*)
+ +$ # one or more of these allowed properties from here 'till sunset
+ }ix,
+ dir => qr/^(rtl|ltr)$/i,
+ lang => qr/^\w+(-\w+)?$/,
+
+ colspan => 1,
+ rowspan => 1,
+ align => 1,
+ valign => 1,
+ cellspacing => 1,
+ cellpadding => 1,
+ border => 1,
+ width => 1,
+ height => 1,
+
+ # timeworked per user attributes
+ 'data-ticket-id' => 1,
+ 'data-ticket-class' => 1,
+);
+
+our %RULES = ();
+
+=head1 METHODS
+
+=head2 new
+
+Returns a new L<RT::Interface::Web::Scrubber> object, configured with
+the above globals. Takes no arguments.
+
+=cut
+
+sub new {
+ my $class = shift;
+ $self = $class->SUPER::new(@_);
+
+ $self->default(
+ 0,
+ {
+ %ALLOWED_ATTRIBUTES,
+ '*' => 0, # require attributes be explicitly allowed
+ },
+ );
+ $self->deny(qw[*]);
+ $self->allow(@ALLOWED_TAGS);
+
+ # If we're displaying images, let embedded ones through
+ if (RT->Config->Get('ShowTransactionImages') or RT->Config->Get('ShowRemoteImages')) {
+ my @src;
+ push @src, qr/^cid:/i
+ if RT->Config->Get('ShowTransactionImages');
+
+ push @src, $ALLOWED_ATTRIBUTES{'href'}
+ if RT->Config->Get('ShowRemoteImages');
+
+ $RULES{'img'} ||= {
+ '*' => 0,
+ alt => 1,
+ src => join("|", @src),
+ };
+ }
+ $self->rules(%RULES);
+
+ # Scrubbing comments is vital since IE conditional comments can contain
+ # arbitrary HTML and we'd pass it right on through.
+ $self->comment(0);
+
+ return $self;
+}
+
+=head2 gumbo
+
+Returns a L<HTML::Gumbo> object.
+
+=cut
+
+sub gumbo {
+ my $self = shift;
+ return $self->{_gumbo} //= HTML::Gumbo->new;
+}
+
+=head2 scrub TEXT
+
+Takes a string of HTML, and returns it scrubbed, via L<HTML::Gumbo>
+then the rules. This is a more limited interface than
+L<HTML::Scrubber/scrub>.
+
+=cut
+
+sub scrub {
+ my $self = shift;
+ my $Content = shift // '';
+
+ # First pass through HTML::Gumbo to balance the tags
+ eval { $Content = $self->gumbo->parse( $Content ); chomp $Content };
+ warn "HTML::Gumbo pre-parse failed: $@" if $@;
+
+ return $self->SUPER::scrub($Content);
+}
+
+RT::Base->_ImportOverlays();
+1;
diff --git a/t/web/scrub.t b/t/web/scrub.t
index 835f412..4137986 100644
--- a/t/web/scrub.t
+++ b/t/web/scrub.t
@@ -1,10 +1,14 @@
use strict;
use warnings;
-use RT::Test nodb => 1, tests => 6;
+use RT::Test nodb => 1, tests => undef;
use RT::Interface::Web; # This gets us HTML::Mason::Commands
use Test::LongString;
+sub scrub_html {
+ return HTML::Mason::Commands::ScrubHTML(shift);
+}
+
{
my $html = 'This is a test of <span style="color: rgb(255, 0, 0); ">color</span> and <span style="font-size: 18px; "><span style="font-family: Georgia, serif; ">font</span></span> and <em><u><strike><strong>boldness</strong></strike></u></em>.';
is_string(scrub_html($html), $html, "CKEditor produced HTML sails through");
@@ -39,7 +43,10 @@ use Test::LongString;
is_string(scrub_html($html), $expected, "outlook html");
}
-sub scrub_html {
- return HTML::Mason::Commands::ScrubHTML(shift);
+{
+ my $html = q[</td></tr></table><table><td>Some content here</table>An unclosed <b>bold<b> tag.];
+ my $expected = q[<table><tbody><tr><td>Some content here</td></tr></tbody></table>An unclosed <b>bold<b> tag.</b></b>];
+ is_string(scrub_html($html), $expected, "Unbalanced tags get balanced");
}
+done_testing;
-----------------------------------------------------------------------
More information about the rt-commit
mailing list