#!/usr/bin/perl -w
#
# Tests for the wallet-report dispatch code.
#
# Written by Russ Allbery <eagle@eyrie.org>
# Copyright 2018 Russ Allbery <eagle@eyrie.org>
# Copyright 2008-2010
#     The Board of Trustees of the Leland Stanford Junior University
#
# SPDX-License-Identifier: MIT

use strict;
use Test::More tests => 48;

# Create a dummy class for Wallet::Report that prints what method was called
# with its arguments and returns data for testing.
package Wallet::Report;

use vars qw($empty $error);
$error = 0;
$empty = 0;

sub error {
    if ($error) {
        return "some error";
    } else {
        return;
    }
}

sub new {
    print "new\n";
    return bless ({}, 'Wallet::Report');
}

sub acls {
    shift;
    print "acls @_\n";
    return if ($error or $empty);
    return ([ qw/d1 d2 d3/ ], [ qw/o1 o2/ ]) if (@_ && $_[0] eq 'duplicate');
    return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]);
}

sub audit {
    shift;
    print "audit @_\n";
    return if ($error or $empty);
    if ($_[0] eq 'objects') {
        return ([ file => 'unix-wallet-password' ]);
    } elsif ($_[0] eq 'acls') {
        return ([ 2, 'group/admins' ]);
    } else {
        return;
    }
}

sub objects {
    shift;
    print "objects @_\n";
    return if ($error or $empty);
    return ([ keytab => 'host/windlord.stanford.edu' ],
            [ file   => 'unix-wallet-password' ]);
}

sub owners {
    shift;
    print "owners @_\n";
    return if ($error or $empty);
    return ([ krb5 => 'admin@EXAMPLE.COM' ]);
}

# Back to the main package and the actual test suite.  Lie about whether the
# Wallet::Report package has already been loaded.
package main;
$INC{'Wallet/Report.pm'} = 'FAKE';
eval { do "$ENV{C_TAP_SOURCE}/../server/wallet-report" };

# Run the wallet report client.  This fun hack takes advantage of the fact
# that the wallet report client is written in Perl so that we can substitute
# our own Wallet::Report class.
sub run_report {
    my (@args) = @_;
    my $result = '';
    open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n";
    select OUTPUT;
    local $| = 1;
    eval { command (@args) };
    my $error = $@;
    select STDOUT;
    return ($result, $error);
}

# Now for the actual tests.  First check for unknown commands.
my ($out, $err) = run_report ('foo');
is ($err, "unknown command foo\n", 'Unknown command');
is ($out, "new\n", ' and nothing ran');

# Check too few and too many arguments for every command.
my %commands = (acls    => [0, 3],
                audit   => [2, 2],
                objects => [0, 2],
                owners  => [2, 2]);
for my $command (sort keys %commands) {
    my ($min, $max) = @{ $commands{$command} };
    if ($min > 0) {
        ($out, $err) = run_report ($command, ('foo') x ($min - 1));
        is ($err, "too few arguments to $command\n",
            "Too few arguments for $command");
        is ($out, "new\n", ' and nothing ran');
    }
    if ($max >= 0) {
        ($out, $err) = run_report ($command, ('foo') x ($max + 1));
        is ($err, "too many arguments to $command\n",
            "Too many arguments for $command");
        is ($out, "new\n", ' and nothing ran');
    }
}

# Test the report methods.
($out, $err) = run_report ('acls');
is ($err, '', 'List succeeds for ACLs');
is ($out, "new\nacls \n"
    . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n",
    ' and returns the right output');
($out, $err) = run_report ('acls', 'duplicate');
is ($err, '', 'Duplicate report succeeds for ACLs');
is ($out, "new\nacls duplicate\nd1 d2 d3\no1 o2\n",
    ' and returns the right output');
($out, $err) = run_report ('acls', 'entry', 'foo', 'foo');
is ($err, '', 'List succeeds for ACLs');
is ($out, "new\nacls entry foo foo\n"
    . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n",
    ' and returns the right output');
($out, $err) = run_report ('audit', 'objects', 'name');
is ($err, '', 'Object audit report succeeds');
is ($out, "new\naudit objects name\nfile unix-wallet-password\n",
    ' and returns the right output');
($out, $err) = run_report ('audit', 'acls', 'name');
is ($err, '', 'ACL audit report succeeds');
is ($out, "new\naudit acls name\ngroup/admins (ACL ID: 2)\n",
    ' and returns the right output');
($out, $err) = run_report ('objects');
is ($err, '', 'List succeeds for objects');
is ($out, "new\nobjects \n"
    . "keytab host/windlord.stanford.edu\nfile unix-wallet-password\n",
    ' and returns the right output');
($out, $err) = run_report ('objects', 'type', 'foo');
is ($err, '', 'List succeeds for objects type foo');
is ($out, "new\nobjects type foo\n"
    . "keytab host/windlord.stanford.edu\nfile unix-wallet-password\n",
    ' and returns the right output');
($out, $err) = run_report ('owners', '%', '%');
is ($err, '', 'Report succeeds for owners');
is ($out, "new\nowners % %\nkrb5 admin\@EXAMPLE.COM\n",
    ' and returns the right output');

# Test error handling.
$Wallet::Report::error = 1;
($out, $err) = run_report ('acls');
is ($err, "some error\n", 'Error handling succeeds for acls');
is ($out, "new\nacls \n", ' and calls the right methods');
($out, $err) = run_report ('audit', 'objects', 'name');
is ($err, "some error\n", 'Error handling succeeds for audit');
is ($out, "new\naudit objects name\n", ' and calls the right methods');
($out, $err) = run_report ('objects');
is ($err, "some error\n", 'Error handling succeeds for objects');
is ($out, "new\nobjects \n", ' and calls the right methods');
($out, $err) = run_report ('owners', 'foo', 'bar');
is ($err, "some error\n", 'Error handling succeeds for owners');
is ($out, "new\nowners foo bar\n", ' and calls the right methods');

# Test empty lists.
$Wallet::Report::error = 0;
$Wallet::Report::empty = 1;
($out, $err) = run_report ('acls');
is ($err, '', 'acls runs with an empty list and no errors');
is ($out, "new\nacls \n", ' and calls the right methods');
($out, $err) = run_report ('acls', 'duplicate');
is ($err, '', 'acls duplicate runs with an empty list and no errors');
is ($out, "new\nacls duplicate\n", ' and calls the right methods');
($out, $err) = run_report ('audit', 'objects', 'name');
is ($err, '', 'audit runs with an empty list and no errors');
is ($out, "new\naudit objects name\n", ' and calls the right methods');
($out, $err) = run_report ('objects');
is ($err, '', 'objects runs with an empty list with no errors');
is ($out, "new\nobjects \n", ' and calls the right methods');
($out, $err) = run_report ('owners', 'foo', 'bar');
is ($err, '', 'owners runs with an empty list and no errors');
is ($out, "new\nowners foo bar\n", ' and calls the right methods');