# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
#
# This Source Code Form is "Incompatible With Secondary Licenses", as
# defined by the Mozilla Public License, v. 2.0.

package Bugzilla::Install::Requirements;

# NOTE: This package MUST NOT "use" any Bugzilla modules other than
# Bugzilla::Constants, anywhere. We may "use" standard perl modules.
#
# Subroutines may "require" and "import" from modules, but they
# MUST NOT "use."

use 5.14.0;
use strict;
use warnings;

use Bugzilla::Constants;
use Bugzilla::Install::Util qw(install_string bin_loc success
  extension_requirement_packages);
use List::Util qw(max);
use Term::ANSIColor;
use CPAN::Meta;
use CPAN::Meta::Prereqs;
use CPAN::Meta::Requirements;
use Module::Metadata;

use parent qw(Exporter);
use autodie;

our @EXPORT = qw(
  FEATURE_FILES

  load_cpan_meta
  check_cpan_requirements
  check_cpan_feature
  check_all_cpan_features
  check_webdotbase
  check_font_file
  map_files_to_features
);

our $checking_for_indent = 0;

# This is how many *'s are in the top of each "box" message printed
# by checksetup.pl.
use constant TABLE_WIDTH => 71;

# Optional Apache modules that have no Perl component to them.
# If these are installed, Bugzilla has additional functionality.
#
# The keys are the names of the modules, the values are what the module
# is called in the output of "apachectl -t -D DUMP_MODULES".
use constant APACHE_MODULES => {
  mod_headers => 'headers_module',
  mod_env     => 'env_module',
  mod_expires => 'expires_module',
  mod_rewrite => 'rewrite_module',
  mod_version => 'version_module'
};

# These are all of the binaries that we could possibly use that can
# give us info about which Apache modules are installed.
# If we can't use "apachectl", the "httpd" binary itself takes the same
# parameters. Note that on Debian and Gentoo, there is an "apache2ctl",
# but it takes different parameters on each of those two distros, so we
# don't use apache2ctl.
use constant APACHE => qw(apachectl httpd apache2 apache);

# If we don't find any of the above binaries in the normal PATH,
# these are extra places we look.
use constant APACHE_PATH => [
  qw(
    /usr/sbin
    /usr/local/sbin
    /usr/libexec
    /usr/local/libexec
    )
];

# This maps features to the files that require that feature in order
# to compile. It is used by t/001compile.t and mod_perl.pl.
use constant FEATURE_FILES => (
  jsonrpc => ['Bugzilla/WebService/Server/JSONRPC.pm', 'jsonrpc.cgi'],
  xmlrpc  => [
    'Bugzilla/WebService/Server/XMLRPC.pm', 'xmlrpc.cgi',
    'Bugzilla/WebService.pm',               'Bugzilla/WebService/*.pm'
  ],
  csp           => ['Bugzilla/CGI/ContentSecurityPolicy.pm'],
  psgi          => ['app.psgi'],
  moving        => ['importxml.pl'],
  auth_ldap     => ['Bugzilla/Auth/Verify/LDAP.pm'],
  auth_radius   => ['Bugzilla/Auth/Verify/RADIUS.pm'],
  documentation => ['docs/makedocs.pl'],
  inbound_email => ['email_in.pl'],
  jobqueue      => [
    'Bugzilla/Job/*',      'Bugzilla/JobQueue.pm',
    'Bugzilla/JobQueue/*', 'jobqueue.pl'
  ],
  patch_viewer    => ['Bugzilla/Attachment/PatchReader.pm'],
  updates         => ['Bugzilla/Update.pm'],
  markdown        => ['Bugzilla/Markdown.pm', 't/100markdown.t'],
  memcached       => ['Bugzilla/Memcache.pm'],
  auth_delegation => ['auth.cgi'],
);

sub load_cpan_meta {
  my $dir = bz_locations()->{libpath};
  my @meta_json
    = map { File::Spec->catfile($dir, $_) } qw( MYMETA.json META.json );
  my ($file) = grep { -f $_ } @meta_json;

  if ($file) {
    open my $meta_fh, '<', $file or die "unable to open $file: $!";
    my $str = do { local $/ = undef; scalar <$meta_fh> };

    # detaint
    $str =~ /^(.+)$/s;
    $str = $1;
    close $meta_fh;

    return CPAN::Meta->load_json_string($str);
  }
  else {
    ThrowCodeError('cpan_meta_missing');
  }
}

sub check_all_cpan_features {
  my ($meta, $dirs, $output) = @_;
  my %report;

  local $checking_for_indent = 2;

  print "\nOptional features:\n" if $output;
  my @features = sort { $a->identifier cmp $b->identifier } $meta->features;
  foreach my $feature (@features) {
    next if $feature->identifier eq 'features';
    printf "Feature '%s': %s\n", $feature->identifier, $feature->description
      if $output;
    my $result = check_cpan_feature($feature, $dirs, $output);
    print "\n" if $output;

    $report{$feature->identifier}
      = {description => $feature->description, result => $result,};
  }

  print install_string('all_optional_features_require'), "\n" if $output;
  my $features = check_cpan_feature($meta->feature('features'), $dirs, $output);
  print "\n" if $output;

  $report{features} = {
    description => $meta->feature('features')->description,
    result      => $features,
  };

  return \%report;
}

sub check_cpan_feature {
  my ($feature, $dirs, $output) = @_;

  return _check_prereqs($feature->prereqs, $dirs, $output);
}

sub check_cpan_requirements {
  my ($meta, $dirs, $output) = @_;

  my $result = _check_prereqs($meta->effective_prereqs, $dirs, $output);
  print colored(install_string('installation_failed'), COLOR_ERROR), "\n"
    if !$result->{ok} && $output;
  return $result;
}

sub _check_prereqs {
  my ($prereqs, $dirs, $output) = @_;
  $dirs //= \@INC;
  my $reqs
    = $prereqs->merged_requirements(['configure', 'runtime'], ['requires']);
  my @found;
  my @missing;

  foreach my $module (sort $reqs->required_modules) {
    my $ok = _check_module($reqs, $module, $dirs, $output);
    if ($ok) {
      push @found, $module;
    }
    else {
      push @missing, $module;
    }
  }

  return {ok => (@missing == 0), found => \@found, missing => \@missing};
}

sub _check_module {
  my ($reqs, $module, $dirs, $output) = @_;
  my $required_version = $reqs->requirements_for_module($module);

  if ($module eq 'perl') {
    my $ok = $reqs->accepts_module($module, $]);
    _checking_for(
      {package => "perl", found => $], wanted => $required_version, ok => $ok})
      if $output;
    return $ok;
  }
  else {
    my $metadata = Module::Metadata->new_from_module($module, inc => $dirs);
    my $version = eval { $metadata->version };
    my $ok = $metadata && $version && $reqs->accepts_module($module, $version || 0);
    _checking_for({
      package => $module,
      $version ? (found => $version) : (),
      wanted => $required_version,
      ok     => $ok
    })
      if $output;

    return $ok;
  }
}


sub _get_apachectl {
  foreach my $bin_name (APACHE) {
    my $bin = bin_loc($bin_name);
    return $bin if $bin;
  }

  # Try again with a possibly different path.
  foreach my $bin_name (APACHE) {
    my $bin = bin_loc($bin_name, APACHE_PATH);
    return $bin if $bin;
  }
  return undef;
}

sub check_webdotbase {
  my ($output) = @_;

  my $webdotbase = Bugzilla->localconfig->{'webdotbase'};
  return 1 if $webdotbase =~ /^https?:/;

  my $return;
  $return = 1 if -x $webdotbase;

  if ($output) {
    _checking_for({package => 'GraphViz', ok => $return});
  }

  if (!$return) {
    print install_string('bad_executable', {bin => $webdotbase}), "\n";
  }

  my $webdotdir = bz_locations()->{'webdotdir'};

  # Check .htaccess allows access to generated images
  if (-e "$webdotdir/.htaccess") {
    my $htaccess = new IO::File("$webdotdir/.htaccess", 'r')
      || die "$webdotdir/.htaccess: " . $!;
    if (!grep(/ \\\.png\$/, $htaccess->getlines)) {
      print STDERR install_string('webdot_bad_htaccess', {dir => $webdotdir}), "\n";
    }
    $htaccess->close;
  }

  return $return;
}

sub check_font_file {
  my ($output) = @_;

  my $font_file = Bugzilla->localconfig->{'font_file'};

  my $readable;
  $readable = 1 if -r $font_file;

  my $ttf;
  $ttf = 1 if $font_file =~ /\.(ttf|otf)$/;

  if ($output) {
    _checking_for({package => 'Font file', ok => $readable && $ttf});
  }

  if (!$readable) {
    print install_string('bad_font_file', {file => $font_file}), "\n";
  }
  elsif (!$ttf) {
    print install_string('bad_font_file_name', {file => $font_file}), "\n";
  }

  return $readable && $ttf;
}

sub _checking_for {
  my ($params) = @_;
  my ($package, $ok, $wanted, $blocklisted, $found)
    = @$params{qw(package ok wanted blocklisted found)};

  my $ok_string = $ok ? install_string('module_ok') : '';

  # If we're actually checking versions (like for Perl modules), then
  # we have some rather complex logic to determine what we want to
  # show. If we're not checking versions (like for GraphViz) we just
  # show "ok" or "not found".
  if (exists $params->{found}) {
    my $found_string;

    # We do a string compare in case it's non-numeric. We make sure
    # it's not a version object as negative versions are forbidden.
    if ($found && !ref($found) && $found eq '-1') {
      $found_string = install_string('module_not_found');
    }
    elsif ($found) {
      $found_string = install_string('module_found', {ver => $found});
    }
    else {
      $found_string = install_string('module_unknown_version');
    }
    $ok_string = $ok ? "$ok_string: $found_string" : $found_string;
  }
  elsif (!$ok) {
    $ok_string = install_string('module_not_found');
  }

  my $block_string = $blocklisted ? install_string('blocklisted') : '';
  my $want_string = $wanted ? "$wanted" : install_string('any');

  my $str = sprintf "%s %20s %-11s $ok_string $block_string\n",
    (' ' x $checking_for_indent) . install_string('checking_for'), $package,
    "($want_string)";
  print $ok ? $str : colored($str, COLOR_ERROR);
}

# This does a reverse mapping for FEATURE_FILES.
sub map_files_to_features {
  my %features = FEATURE_FILES;
  my %files;
  foreach my $feature (keys %features) {
    my @my_files = @{$features{$feature}};
    foreach my $pattern (@my_files) {
      foreach my $file (glob $pattern) {
        $files{$file} = $feature;
      }
    }
  }
  return \%files;
}

1;

__END__

=head1 NAME

Bugzilla::Install::Requirements - Functions and variables dealing
  with Bugzilla's perl-module requirements.

=head1 DESCRIPTION

This module is used primarily by C<checksetup.pl> to determine whether
or not all of Bugzilla's prerequisites are installed. (That is, all the
perl modules it requires.)

=head1 CONSTANTS

=over

=item C<FEATURE_FILES>

A hashref that describes what files should only be compiled if a certain
feature is enabled. The feature is the key, and the values are arrayrefs
of file names (which are passed to C<glob>, so shell patterns work).

=back

=head1 SUBROUTINES

=over 4

=item C<check_cpan_requirements>

=over

=item B<Description>

This checks what required perl modules are installed, like
C<checksetup.pl> does.

=item B<Params>

=over

=item C<$meta> - A C<CPAN::Meta> object.

=item C<$dirs> - the include dirs to search for modules, defaults to @INC.

=item C<$output> - C<true> if you want the function to print out information
about what it's doing, and the versions of everything installed.

=back

=item B<Returns>

A hashref containing these values:

=over

=item C<ok> - if all the requirements are met, this is true.

=item C<found> - an arrayref of found modules

=item C<missing> - an arrayref of missing modules

=back

=back

=item C<check_cpan_feature>

=over

=item B<Description>

This checks that the optional Perl modules required for a feature are installed.

=item B<Params>

=over

=item C<$feature> - A C<CPAN::Meta::Feature> object.

=item C<$dirs> - the include dirs to search for modules, defaults to @INC.

=item C<$output> - C<true> if you want the function to print out information about what it's doing, and the versions of everything installed.

=back

=item B<Returns>

A hashref containing these values:

=over

=item C<ok> - if all the requirements are met, this is true.

=item C<found> - an arrayref of found modules

=item C<missing> - an arrayref of missing modules

=back

=item C<check_all_cpan_features>

=over

=item B<Description>

This checks which optional Perl modules are currently installed which can enable optional features.

=item B<Params>

=over

=item C<$meta> - A C<CPAN::Meta> object.

=item C<$dirs> - the include dirs to search for modules, defaults to @INC.

=item C<$output> - C<true> if you want the function to print out information
about what it's doing, and the versions of everything installed.

=back

=item B<Returns>

A hashref keyed on the feature name. The values
are hashrefs containing C<description> and C<result> keys.

C<description> is the English description of the feature.

C<result> is a hashref in the same format as the return value of C<check_cpan_requirements()>,
described previously.

=back

=item C<check_webdotbase($output)>

Description: Checks if the graphviz binary specified in the
  C<webdotbase> parameter is a valid binary, or a valid URL.

Params:      C<$output> - C<$true> if you want the function to
                 print out information about what it's doing.

Returns:     C<1> if the check was successful, C<0> otherwise.

=item C<check_font_file($output)>

Description: Checks if the font file specified in the C<font_type> parameter
  is a valid-looking font file.

Params:      C<$output> - C<$true> if you want the function to
                 print out information about what it's doing.

Returns:     C<1> if the check was successful, C<0> otherwise.

=item C<map_files_to_features>

Returns a hashref where file names are the keys and the value is the feature
that must be enabled in order to compile that file.

=item C<load_cpan_meta>

Load MYMETA.json or META.json from the bugzilla directory, and a return a L<CPAN::Meta> object.

=back

=back

