#!/usr/bin/env perl
use strict;
use warnings;

use File::Copy qw(copy);
use File::Path qw(make_path);
use File::Slurper qw(read_text write_text);
use File::Spec;
use File::Temp qw(tempdir);
use FindBin;
use Fcntl qw(S_IMODE);
use lib "$FindBin::Bin/../lib";
use Test::More;

use XCAT::Test::File qw(repo_path slurp_repo_file);

my $sync_helper = repo_path('build-utils/sync-xcat-apache-configs');
ok( -x $sync_helper, 'the Apache configuration sync helper is executable' );
is( system( 'sh', '-n', $sync_helper ), 0,
    'the Apache configuration sync helper has POSIX shell syntax' );

my ( $status, $output ) = run_command( {}, $sync_helper, '--check' );
is( $status, 0, 'the committed service-node configurations are current' )
  or diag($output);
is( $output, '', 'a successful repository check is quiet' );

my @config_pairs = (
    [ 'xCAT/xcat.conf',          'xCATsn/xcat.conf' ],
    [ 'xCAT/xcat.conf.apach24', 'xCATsn/xcat.conf.apach24' ],
);
for my $pair (@config_pairs) {
    my ( $source, $generated ) = @{$pair};
    my $generated_path = repo_path($generated);
    ok( !-l $generated_path, "$generated is a regular tracked file" );
    is( slurp_repo_file($generated), slurp_repo_file($source),
        "$generated is generated byte-for-byte from $source" );
    is( sprintf( '%04o', S_IMODE( ( stat($generated_path) )[2] ) ), '0644',
        "$generated has the required tracked mode" );
}

my $fixture_root = tempdir( CLEANUP => 1 );
my $fixture_helper = stage_sync_fixture($fixture_root);
write_text( File::Spec->catfile( $fixture_root, 'xCAT', 'xcat.conf' ),
    "apache22 canonical\n" );
write_text( File::Spec->catfile( $fixture_root, 'xCAT', 'xcat.conf.apach24' ),
    "apache24 canonical\n" );
write_text( File::Spec->catfile( $fixture_root, 'xCATsn', 'xcat.conf' ),
    "apache22 stale\n" );
write_text( File::Spec->catfile( $fixture_root, 'xCATsn', 'xcat.conf.apach24' ),
    "apache24 stale\n\n" );

( $status, $output ) = run_command( {}, $fixture_helper, '--check' );
is( $status, 1, '--check rejects drift in generated configurations' );
like( $output, qr{^xCATsn/xcat\.conf is out of date;}m,
    '--check identifies the stale Apache 2.2 copy' );
like( $output, qr{^xCATsn/xcat\.conf\.apach24 is out of date;}m,
    '--check identifies the stale Apache 2.4 copy' );

( $status, $output ) = run_command( {}, $fixture_helper, '--write' );
is( $status, 0, '--write refreshes generated configurations' )
  or diag($output);
like( $output, qr{^updated xCATsn/xcat\.conf$}m,
    '--write reports the refreshed Apache 2.2 copy' );
like( $output, qr{^updated xCATsn/xcat\.conf\.apach24$}m,
    '--write reports the refreshed Apache 2.4 copy' );

for my $pair (@config_pairs) {
    my ( $source, $generated ) = @{$pair};
    my $source_path = File::Spec->catfile( $fixture_root, split( '/', $source ) );
    my $generated_path =
      File::Spec->catfile( $fixture_root, split( '/', $generated ) );
    is( read_text($generated_path), read_text($source_path),
        "--write makes $generated byte-identical to its canonical source" );
    is( sprintf( '%04o', S_IMODE( ( stat($generated_path) )[2] ) ), '0644',
        "--write gives $generated a deterministic file mode" );
}

( $status, $output ) = run_command( {}, $fixture_helper, '--write' );
is( $status, 0, '--write accepts already-current configurations' );
is( $output, '', '--write does not rewrite or report current configurations' );
my $current_generated =
  File::Spec->catfile( $fixture_root, 'xCATsn', 'xcat.conf' );
chmod 0600, $current_generated
  or die "Unable to change $current_generated mode: $!";
( $status, $output ) = run_command( {}, $fixture_helper, '--check' );
is( $status, 1, '--check rejects mode drift in generated configurations' );
like( $output, qr{^xCATsn/xcat\.conf is out of date;}m,
    '--check identifies the generated configuration with mode drift' );
( $status, $output ) = run_command( {}, $fixture_helper, '--write' );
is( $status, 0, '--write repairs mode drift on current configurations' );
is( sprintf( '%04o', S_IMODE( ( stat($current_generated) )[2] ) ), '0644',
    '--write normalizes a current generated configuration to mode 0644' );
is( $output, '', 'mode-only repair does not report a content update' );

my $symlink_victim = File::Spec->catfile( $fixture_root, 'symlink-victim' );
write_text( $symlink_victim, "apache22 canonical\n" );
unlink($current_generated) or die "Unable to remove $current_generated: $!";
symlink( $symlink_victim, $current_generated )
  or die "Unable to create $current_generated symlink: $!";
( $status, $output ) = run_command( {}, $fixture_helper, '--check' );
is( $status, 1, '--check rejects a generated configuration symlink' );
like( $output, qr{^xCATsn/xcat\.conf is out of date;}m,
    '--check identifies the generated configuration symlink' );
( $status, $output ) = run_command( {}, $fixture_helper, '--write' );
is( $status, 0, '--write replaces a generated configuration symlink' );
ok( !-l $current_generated,
    '--write leaves a regular generated configuration behind' );
is( read_text($current_generated), "apache22 canonical\n",
    '--write restores canonical content after replacing a symlink' );
is( read_text($symlink_victim), "apache22 canonical\n",
    '--write does not modify the former symlink target' );

my $missing_generated =
  File::Spec->catfile( $fixture_root, 'xCATsn', 'xcat.conf.apach24' );
unlink($missing_generated) or die "Unable to remove $missing_generated: $!";
( $status, $output ) = run_command( {}, $fixture_helper, '--check' );
is( $status, 1, '--check rejects a missing generated configuration' );
like( $output, qr{^xCATsn/xcat\.conf\.apach24 is out of date;}m,
    '--check identifies the missing generated configuration' );
( $status, $output ) = run_command( {}, $fixture_helper, '--write' );
is( $status, 0, '--write recreates a missing generated configuration' )
  or diag($output);
is( read_text($missing_generated), "apache24 canonical\n",
    '--write preserves the canonical final newline exactly' );
is( sprintf( '%04o', S_IMODE( ( stat($missing_generated) )[2] ) ), '0644',
    '--write recreates a generated configuration with mode 0644' );

my $staging_directory = tempdir( CLEANUP => 1 );
my $staging_victim = File::Spec->catfile( $fixture_root, 'staging-victim' );
write_text( $staging_victim, "do not overwrite\n" );
symlink( $staging_victim,
    File::Spec->catfile( $staging_directory, 'xcat.conf' ) )
  or die 'Unable to create staging symlink fixture';
( $status, $output ) =
  run_command( {}, $fixture_helper, '--stage', $staging_directory );
is( $status, 0, '--stage copies canonical configurations for package builds' )
  or diag($output);
is( $output, '', 'successful package staging is quiet' );
for my $name ( 'xcat.conf', 'xcat.conf.apach24' ) {
    my $staged = File::Spec->catfile( $staging_directory, $name );
    my $canonical = File::Spec->catfile( $fixture_root, 'xCAT', $name );
    ok( !-l $staged, "--stage creates a regular $name file" );
    is( read_text($staged), read_text($canonical),
        "--stage copies canonical $name content" );
    is( sprintf( '%04o', S_IMODE( ( stat($staged) )[2] ) ), '0644',
        "--stage gives $name the required package mode" );
}
is( read_text($staging_victim), "do not overwrite\n",
    '--stage replaces a destination symlink without touching its target' );

my $directory_target = File::Spec->catfile( $staging_directory, 'xcat.conf' );
unlink($directory_target) or die "Unable to remove $directory_target: $!";
mkdir($directory_target) or die "Unable to create $directory_target: $!";
( $status, $output ) =
  run_command( {}, $fixture_helper, '--stage', $staging_directory );
is( $status, 1, '--stage refuses to replace a destination directory' );
like( $output, qr{ cannot replace a directory$}m,
    '--stage identifies the destination directory' );
rmdir($directory_target) or die "Unable to remove $directory_target: $!";

my $canonical_path = File::Spec->catfile( $fixture_root, 'xCAT', 'xcat.conf' );
my $canonical_contents = read_text($canonical_path);
my $canonical_symlink_target =
  File::Spec->catfile( $fixture_root, 'canonical-symlink-target' );
write_text( $canonical_symlink_target, $canonical_contents );
unlink($canonical_path) or die "Unable to remove $canonical_path: $!";
symlink( $canonical_symlink_target, $canonical_path )
  or die "Unable to create $canonical_path symlink: $!";
( $status, $output ) = run_command( {}, $fixture_helper, '--check' );
is( $status, 1, '--check rejects a canonical configuration symlink' );
like( $output, qr{^xCAT/xcat\.conf must be a regular file$}m,
    '--check identifies the canonical configuration symlink' );
unlink($canonical_path) or die "Unable to remove $canonical_path: $!";
write_text( $canonical_path, $canonical_contents );

for my $arguments (
    [], ['--invalid'], [ '--check', '--write' ], ['--stage'],
    [ '--stage', $staging_directory, 'extra' ]
  )
{
    ( $status, $output ) = run_command( {}, $fixture_helper, @{$arguments} );
    is( $status, 2, 'invalid invocation exits with usage status 2' );
    like( $output,
        qr{^Usage: sync-xcat-apache-configs --check\|--write\|--stage DIRECTORY$}m,
        'invalid invocation prints concise usage' );
}
( $status, $output ) = run_command( {}, $fixture_helper, '--stage',
    File::Spec->catdir( $fixture_root, 'missing-stage-directory' ) );
is( $status, 1, '--stage rejects a missing destination directory' );
like( $output, qr{ is not a directory$}m,
    '--stage identifies the invalid destination directory' );

my $rpm_fixture = tempdir( CLEANUP => 1 );
my $rpm_root = stage_makerpm_fixture($rpm_fixture);
my $fake_bin = File::Spec->catdir( $rpm_fixture, 'fake-bin' );
make_path($fake_bin);
write_executable(
    File::Spec->catfile( $fake_bin, 'uname' ),
    "#!/bin/sh\nprintf '%s\\n' Linux\n"
);
write_executable(
    File::Spec->catfile( $fake_bin, 'rpmbuild' ),
    <<'EOF'
#!/bin/sh
case ${1:-} in
    --version)
        exit 0
        ;;
    --eval)
        printf '%s\n' "$FAKE_RPMROOT"
        exit 0
        ;;
esac
printf 'build\n' >>"$FAKE_RPMBUILD_LOG"
exit 0
EOF
);

my $rpm_build_log = File::Spec->catfile( $rpm_fixture, 'rpmbuild.log' );
write_text( $rpm_build_log, '' );
my %rpm_environment = (
    FAKE_RPMBUILD_LOG => $rpm_build_log,
    FAKE_RPMROOT      => $rpm_root,
    PATH              => "$fake_bin:$ENV{PATH}",
);
( $status, $output ) = run_command(
    \%rpm_environment,
    File::Spec->catfile( $rpm_fixture, 'makerpm' ),
    'xCATsn', 'x86_64'
);
is( $status, 0, 'the legacy RPM builder stages service-node sources' )
  or diag($output);
is( read_text($rpm_build_log), "build\n",
    'the legacy RPM builder reaches rpmbuild after successful staging' );
for my $name ( 'xcat.conf', 'xcat.conf.apach24' ) {
    is(
        read_text( File::Spec->catfile( $rpm_root, 'SOURCES', $name ) ),
        read_text( File::Spec->catfile( $rpm_fixture, 'xCAT', $name ) ),
        "the legacy RPM builder stages canonical $name content"
    );
}

write_text( $rpm_build_log, '' );
my $rpm_canonical = File::Spec->catfile( $rpm_fixture, 'xCAT', 'xcat.conf' );
my $rpm_canonical_target =
  File::Spec->catfile( $rpm_fixture, 'invalid-canonical-target' );
write_text( $rpm_canonical_target, read_text($rpm_canonical) );
unlink($rpm_canonical) or die "Unable to remove $rpm_canonical: $!";
symlink( $rpm_canonical_target, $rpm_canonical )
  or die "Unable to create $rpm_canonical symlink: $!";
for my $name ( 'xcat.conf', 'xcat.conf.apach24' ) {
    write_text( File::Spec->catfile( $rpm_root, 'SOURCES', $name ),
        "stale $name\n" );
}
( $status, $output ) = run_command(
    \%rpm_environment,
    File::Spec->catfile( $rpm_fixture, 'makerpm' ),
    'xCATsn', 'x86_64'
);
is( $status, 1, 'the legacy RPM builder propagates staging failure' );
like( $output, qr{^xCAT/xcat\.conf must be a regular file$}m,
    'the legacy RPM builder reports the rejected canonical source' );
is( read_text($rpm_build_log), '',
    'the legacy RPM builder does not reach rpmbuild after staging failure' );
for my $name ( 'xcat.conf', 'xcat.conf.apach24' ) {
    is( read_text( File::Spec->catfile( $rpm_root, 'SOURCES', $name ) ),
        "stale $name\n",
        "failed legacy staging does not disguise the stale $name source" );
}

my $management_debian = slurp_repo_file('xCAT/debian/install');
my $service_debian = slurp_repo_file('xCATsn/debian/install');
for my $manifest (
    [ 'management',   $management_debian ],
    [ 'service-node', $service_debian ],
) {
    my ( $label, $contents ) = @{$manifest};
    like( $contents, qr{^xcat\.conf\s+etc/apache2/(?:conf\.d|conf-available)/?\s*$}m,
        "$label Debian payload includes the Apache 2.2 configuration" );
    like( $contents, qr{^xcat\.conf\.apach24\s+etc/apache2/(?:conf\.d|conf-available)/?\s*$}m,
        "$label Debian payload includes the Apache 2.4 configuration" );
}

done_testing();

sub stage_sync_fixture {
    my ($root) = @_;
    make_path(
        File::Spec->catdir( $root, 'build-utils' ),
        File::Spec->catdir( $root, 'xCAT' ),
        File::Spec->catdir( $root, 'xCATsn' ),
    );
    my $destination =
      File::Spec->catfile( $root, 'build-utils', 'sync-xcat-apache-configs' );
    copy( $sync_helper, $destination )
      or die "Unable to stage the Apache configuration sync helper: $!";
    chmod 0755, $destination
      or die "Unable to make the staged sync helper executable: $!";
    return $destination;
}

sub stage_makerpm_fixture {
    my ($root) = @_;
    copy( repo_path('makerpm'), File::Spec->catfile( $root, 'makerpm' ) )
      or die "Unable to stage makerpm: $!";
    chmod 0755, File::Spec->catfile( $root, 'makerpm' )
      or die "Unable to make staged makerpm executable: $!";
    write_text( File::Spec->catfile( $root, 'Version' ), "2.19.0\n" );

    make_path(
        File::Spec->catdir( $root, 'build-utils' ),
        File::Spec->catdir( $root, 'xCAT' ),
        File::Spec->catdir( $root, 'xCAT', 'etc', 'rsyslog.d' ),
        File::Spec->catdir( $root, 'xCAT', 'etc', 'logrotate.d' ),
        File::Spec->catdir( $root, 'xCATsn' ),
    );
    copy( $sync_helper,
        File::Spec->catfile( $root, 'build-utils', 'sync-xcat-apache-configs' ) )
      or die "Unable to stage the Apache configuration helper: $!";
    chmod 0755,
      File::Spec->catfile( $root, 'build-utils', 'sync-xcat-apache-configs' )
      or die "Unable to make the Apache configuration helper executable: $!";
    copy( repo_path('build-utils/source-only.sh'),
        File::Spec->catfile( $root, 'build-utils', 'source-only.sh' ) )
      or die "Unable to stage the source-only build helper: $!";
    write_text( File::Spec->catfile( $root, 'xCAT', 'xcat.conf' ),
        "canonical apache22\n" );
    write_text( File::Spec->catfile( $root, 'xCAT', 'xcat.conf.apach24' ),
        "canonical apache24\n" );
    write_text( File::Spec->catfile( $root, 'xCATsn', 'xcat.conf' ),
        "stale service-node apache22\n" );
    write_text( File::Spec->catfile( $root, 'xCATsn', 'xcat.conf.apach24' ),
        "stale service-node apache24\n\n" );
    write_text( File::Spec->catfile( $root, 'xCATsn', 'LICENSE.html' ),
        "fixture license\n" );
    write_text( File::Spec->catfile( $root, 'xCATsn', 'xCATSN' ),
        "fixture service-node configuration\n" );

    my $rpm_root = File::Spec->catdir( $root, 'rpmbuild' );
    make_path(
        File::Spec->catdir( $rpm_root, 'SOURCES' ),
        File::Spec->catdir( $rpm_root, 'SRPMS' ),
        File::Spec->catdir( $rpm_root, 'RPMS', 'x86_64' ),
    );
    return $rpm_root;
}

sub write_executable {
    my ( $path, $contents ) = @_;
    write_text( $path, $contents );
    chmod 0755, $path or die "Unable to make $path executable: $!";
}

sub run_command {
    my ( $environment, @command ) = @_;
    my $pid = open( my $pipe, '-|' );
    die "Unable to fork for @command: $!" unless defined($pid);
    if ( $pid == 0 ) {
        @ENV{ keys %{$environment} } = values %{$environment};
        open( STDERR, '>&', STDOUT ) or die "Unable to merge stderr: $!";
        exec { $command[0] } @command;
        die "Unable to execute @command: $!";
    }

    my $command_output = do { local $/; <$pipe> } // '';
    close($pipe);
    return ( $? >> 8, $command_output );
}