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

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

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

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

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

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

sub destroy {
    print "destroy\n";
    return if $error;
    return 1;
}

sub initialize {
    shift;
    print "initialize @_\n";
    return if $error;
    return 1;
}

sub register_object {
    shift;
    print "register_object @_\n";
    return if $error;
    return 1;
}

sub register_verifier {
    shift;
    print "register_verifier @_\n";
    return if $error;
    return 1;
}

sub upgrade {
    print "upgrade\n";
    return if $error;
    return 1;
}

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

# Run the wallet admin client.  This fun hack takes advantage of the fact that
# the wallet admin client is written in Perl so that we can substitute our own
# Wallet::Admin class.
sub run_admin {
    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_admin ('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 = (destroy    => [0,  0],
                initialize => [1,  1],
                register   => [3,  3],
                upgrade    => [0,  0]);
for my $command (sort keys %commands) {
    my ($min, $max) = @{ $commands{$command} };
    if ($min > 0) {
        ($out, $err) = run_admin ($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_admin ($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 destroy.
my $answer = '';
close STDIN;
open (STDIN, '<', \$answer) or die "cannot reopen standard input: $!\n";
($out, $err) = run_admin ('destroy');
is ($err, "Aborted\n", 'Destroy with no answer aborts');
is ($out, "new\n" .
    'This will delete all data in the wallet database.  Are you sure (N/y)? ',
    ' and prints the right prompt');
seek (STDIN, 0, 0);
$answer = 'n';
($out, $err) = run_admin ('destroy');
is ($err, "Aborted\n", 'Destroy with negative answer answer aborts');
is ($out, "new\n" .
    'This will delete all data in the wallet database.  Are you sure (N/y)? ',
    ' and prints the right prompt');
seek (STDIN, 0, 0);
$answer = 'y';
($out, $err) = run_admin ('destroy');
is ($err, '', 'Destroy succeeds with a positive answer');
is ($out, "new\n"
    . 'This will delete all data in the wallet database.'
    . '  Are you sure (N/y)? ' . "destroy\n", ' and destroy was run');
seek (STDIN, 0, 0);

# Test initialize.
($out, $err) = run_admin ('initialize', 'rra');
is ($err, "invalid admin principal rra\n", 'Initialize requires a principal');
is ($out, "new\n", ' and nothing was run');
($out, $err) = run_admin ('initialize', 'eagle@eyrie.org');
is ($err, '', 'Initialize succeeds with a principal');
is ($out, "new\ninitialize eagle\@eyrie.org\n", ' and runs the right code');

# Test register.
($out, $err) = run_admin ('register', 'foo', 'foo', 'Foo::Bar');
is ($err, "only object or verifier is supported for register\n",
    'Register requires object or verifier');
is ($out, "new\n", ' and nothing was run');
($out, $err) = run_admin ('register', 'object', 'foo', 'Foo::Object');
is ($err, '', 'Register succeeds for object');
is ($out, "new\nregister_object foo Foo::Object\n",
    ' and returns the right outout');
($out, $err) = run_admin ('register', 'verifier', 'foo', 'Foo::Verifier');
is ($err, '', 'Register succeeds for verifier');
is ($out, "new\nregister_verifier foo Foo::Verifier\n",
    ' and returns the right outout');

# Test upgrade.
($out, $err) = run_admin ('upgrade');
is ($err, '', 'Upgrade succeeds');
is ($out, "new\nupgrade\n", ' and runs the right code');

# Test error handling.
$Wallet::Admin::error = 1;
($out, $err) = run_admin ('destroy');
is ($err, "some error\n", 'Error handling succeeds for destroy');
is ($out, "new\n"
    . 'This will delete all data in the wallet database.'
    . '  Are you sure (N/y)? ' . "destroy\n", ' and calls the right methods');
($out, $err) = run_admin ('initialize', 'eagle@eyrie.org');
is ($err, "some error\n", 'Error handling succeeds for initialize');
is ($out, "new\ninitialize eagle\@eyrie.org\n",
    ' and calls the right methods');
($out, $err) = run_admin ('register', 'object', 'foo', 'Foo::Object');
is ($err, "some error\n", 'Error handling succeeds for register object');
is ($out, "new\nregister_object foo Foo::Object\n",
    ' and calls the right methods');
($out, $err) = run_admin ('register', 'verifier', 'foo', 'Foo::Verifier');
is ($err, "some error\n", 'Error handling succeeds for register verifier');
is ($out, "new\nregister_verifier foo Foo::Verifier\n",
    ' and calls the right methods');
($out, $err) = run_admin ('upgrade');
is ($err, "some error\n", 'Error handling succeeds for initialize');
is ($out, "new\nupgrade\n", ' and calls the right methods');