#!/usr/bin/perl

#%# Copyright (C) 2014-2017 Christoph Biedl <debian.axhn@manchmal.in-ulm.de>
#%# License: GPL-2.0-only

use 5.010;
use strict;
use warnings;

use Test::More;
use Test::Command;
use Test::Differences;

use File::Slurp;

my %status_mapping = (
    'ioi' => 'install ok installed',
    'doc' => 'deinstall ok config-files',
);

# awk alternatives to test against
my @AWKs = qw(gawk mawk original-awk);

# works around features missing in Test::Command before 0.11
sub stdout_n_stderr ($) {
    my $run = shift;    # a Test::Command object
    return (
        $run->can ('stdout_value') ? $run->stdout_value :
            scalar read_file ($run->{'result'}{'stdout_file'}),
        $run->can ('stderr_value') ? $run->stderr_value :
            scalar read_file ($run->{'result'}{'stderr_file'}),
    );
}

# creates a file that looks like the output of
# (squeeze)
# dpkg --query --show-format '${Status}\t${Package}\t${Version}\t${Source}\n'
# (wheezy or later)
# dpkg --query --show-format '${Status}\t${binary:Package}\t${Version}\t${Source}\n'

# parameters:
# - file name to write
# - list of lists, where each list has
#   - status (short form, see %status_mapping above)
#   - other fields as plain text

sub mock_query_list ($$) {
    my ($file_name, $listref) = @_;

    my $buffer;
    my $fh;
    open ($fh, '>', \$buffer);
    foreach my $elem (@$listref) {
        my ($status_short, @elems) = @$elem;
        if (!exists ($status_mapping{$status_short})) {
            fail ("BUG: No status mapping for '$status_short'");
            exit 1;
        }
        print $fh join (
            "\t",
            $status_mapping{$status_short},
            @elems,
        ), "\n";
    }
    close ($fh);
    write_file ($file_name, $buffer);
}

package Testbed;

use 5.010;
use strict;
use warnings;

use Test::More;

use File::Slurp;
use File::Temp qw(tempdir);
use Template;

my $temp_dir;
my $temp_dir_nr = 0;

# creates object, no parameters
sub new {
    my ($class, $dpkg_version) = @_;

    $temp_dir //= tempdir (
        "check-support-status.$$.XXXXX",
        'TMPDIR' => 1,
        'CLEANUP' => 1,
    ) or BAIL_OUT ('Cannot get a temporary directory');

    my $temp = sprintf ('%s/%03d', $temp_dir, $temp_dir_nr++);
    mkdir ($temp) or
        BAIL_OUT ("Cannot create directory '$temp': $!");
    my $dss_list = "$temp/security-support";
    write_file ($dss_list, '');

    my $self = {
        'DIR' => $temp,
        'LIST' => $dss_list,
        'DPKG-VERSION' => $dpkg_version,
    };
    return bless ($self, $class);
}

# returns
# * list file name
# * file for mocked dpkg-query result
# * c-s-s status file
# also prepares dpkg-query run
sub files {
    my $self = shift;

    my $temp = $self->{'DIR'};

    my $query_list = "$temp/query-list";
    $ENV{'DPKG_QUERY_LIST'} = $query_list;
    my $query_version = "$temp/query-version";
    $ENV{'DPKG_QUERY_VERSION'} = $query_version;
    write_file (
        $query_version,
        $self->{'DPKG-VERSION'},
    );
    my $statusdb_file = "$temp/status-db";

    return (
        $self->{'LIST'},
        $query_list,
        $statusdb_file,
    );
}

# parameters:
# * awk program (an @AWKs list element)
# * c-s-s parameters (list reference)
# returns:
# * c-s-s command (list reference)
sub exe {
    my ($self, $awk, $params) = @_;

    my $temp = $self->{'DIR'};

    my $exe = "$temp/$awk";

    my $engine = Template->new;
    my $vars = {
        'DPKG_QUERY' => 't/data/dpkg-query',
        'AWK' => "/usr/bin/$awk",
        'LIST' => $self->{'LIST'},
    };
    $engine->process (
        'check-support-status.in',
        $vars,
        $exe,
        {
            'TRIM' => 1,
        },
    ) or die ('Cannot fill template: ' . $engine->error);
    chmod (0755, $exe);

    return [
        $exe,
        @$params,
    ];
}

package main;

my $dpkg_version;
{
    # get dpkg version
    my $run = Test::Command->new ('cmd' => [qw(dpkg-query -f ${Version} -W dpkg)]);
    $run->run;
    $run->exit_is_num (0);
    my ($stdout, $stderr) = stdout_n_stderr ($run);
    if ($stdout) {
        $dpkg_version = (split (/\n/, $stdout))[0];
    }
    $dpkg_version or
        die ('Failed to get dpkg version number');
    diag ("dpkg version is $dpkg_version");
}

diag ('full check');

foreach my $awk (@AWKs) {
    my $tb = Testbed->new ($dpkg_version);
    my ($dss_list, $query_list, $statusdb_file) = $tb->files;
    my $exe = $tb->exe (
        $awk,
        [
            '--no-heading',
            '--status-db', $statusdb_file,
        ],
    );

    write_file ($dss_list, <<__EOS__);
iceweasel       non-supported    3.5.16-20       2013-05-01
base-files      non-supported    6.0squeeze9     2014-05-01  Some spaced  explanation
debconf         non-supported    1.5.36.0        2014-05-02
node-.*         non-supported    0               2020-02-20  https://www.debian.org/releases/stretch/amd64/release-notes/ch-information.en.html#libv8
openjdk-6       non-supported    6b35-1.13.7-1~deb7u1    2031-05-23  No perpetual term support
rust-.*         limited     Statically-linked ecosystems have limitations in support
php5            limited     See README.Debian.security for the PHP security policy
gobgp           limited     binNMU'ed package from a statically linked ecosystem
rust-sequoia-sqv    supported  sqv is fully supported
__EOS__
    mock_query_list (
        $query_list,
        [
            [ 'ioi', 'base-files', '6.0squeeze9' ],
            [ 'ioi', 'debconf', '1.5.36.1' ],
            [ 'ioi', 'debconf-i18n', '1.5.36.1', 'debconf' ],
            [ 'ioi', 'php5', '5.3.3-7+squeeze19' ],
            [ 'ioi', 'openjdk-6-jre', '6b35-1.13.7-1~deb7u1', 'openjdk-6' ],
            [ 'ioi', 'supported-package', '1.0-1' ],
            [ 'ioi', 'supported-package-bin2', '1.0-1', 'supported-package' ],
            [ 'ioi', 'libjs-marked', '0.3.2+dfsg-1', 'node-marked' ],
            [ 'ioi', 'gobgpd', '3.10.0-1+b4', 'gobgp' ],
            [ 'ioi', 'sqv', '1.3.0-3', 'rust-sequoia-sqv' ],
        ],
    );

    # run a first time
    my $run = Test::Command->new ('cmd' => $exe);
    $run->run;
    $run->exit_is_num (0);

    my ($stdout, $stderr) = stdout_n_stderr ($run);
    $stderr and diag ("stderr:\n" . $stderr);
    my $expect_stdout = <<__EOS__;

* Source:base-files, ended on 2014-05-01 at version 6.0squeeze9
  Details: Some spaced  explanation
  Affected binary package:
  - base-files (installed version: 6.0squeeze9)

* Source:debconf, ended on 2014-05-02 at version 1.5.36.0
  Affected binary packages:
  - debconf (installed version: 1.5.36.1)
  - debconf-i18n (installed version: 1.5.36.1)

* Source:node-marked, ended on 2020-02-20 at version 0
  Details: https://www.debian.org/releases/stretch/amd64/release-notes/ch-information.en.html#libv8
  Affected binary package:
  - libjs-marked (installed version: 0.3.2+dfsg-1)


* Source:gobgp
  Details: binNMU'ed package from a statically linked ecosystem
  Affected binary package:
  - gobgpd (installed version: 3.10.0-1+b4)

* Source:php5
  Details: See README.Debian.security for the PHP security policy
  Affected binary package:
  - php5 (installed version: 5.3.3-7+squeeze19)


* Source:openjdk-6, will end on 2031-05-23
  Details: No perpetual term support
  Affected binary package:
  - openjdk-6-jre (installed version: 6b35-1.13.7-1~deb7u1)
__EOS__
    eq_or_diff (
        $stdout,
        $expect_stdout,
        'stdout'
    );

    if (ok (-f $statusdb_file, 'status db file was created')) {
        my $got = read_file ($statusdb_file);
        my $expect = <<__EOS__;
base-files/6.0squeeze9
debconf/1.5.36.1
debconf-i18n/1.5.36.1
libjs-marked/0.3.2+dfsg-1
gobgpd/3.10.0-1+b4
php5/5.3.3-7+squeeze19
openjdk-6-jre/6b35-1.13.7-1~deb7u1
__EOS__
        eq_or_diff (
            $got,
            $expect,
            'status db file content',
        );
    }
}


diag ('security support ended checks');

foreach my $awk (@AWKs) {
    # a single binary package, binary name = source name
    diag ("Basic test ($awk)");

    my $tb = Testbed->new ($dpkg_version);
    my ($dss_list, $query_list, $statusdb_file) = $tb->files;
    my $exe = $tb->exe (
        $awk,
        [
            '--type', 'ended',
            '--no-heading',
            '--list', $dss_list,
            '--status-db', $statusdb_file,
        ],
    );

    write_file ($dss_list, <<__EOS__);
iceweasel       non-supported    3.5.16-20       2013-05-01
base-files      non-supported    6.0squeeze9     2014-05-01  Some spaced  explanation
debconf         non-supported    1.5.36.0        2014-05-02
__EOS__
    mock_query_list (
        $query_list,
        [
            [ 'ioi', 'base-files', '6.0squeeze9' ],
            [ 'ioi', 'supported-package', '1.0-1' ],
            [ 'ioi', 'supported-package-bin2', '1.0-1', 'supported-package' ],
        ],
    );

    # run a first time
    my $run = Test::Command->new ('cmd' => $exe);
    $run->run;
    $run->exit_is_num (0);

    my ($stdout, $stderr) = stdout_n_stderr ($run);
    $stderr and diag ("stderr:\n" . $stderr);
    my $expect_stdout = <<__EOS__;

* Source:base-files, ended on 2014-05-01 at version 6.0squeeze9
  Details: Some spaced  explanation
  Affected binary package:
  - base-files (installed version: 6.0squeeze9)
__EOS__
    eq_or_diff (
        $stdout,
        $expect_stdout,
        'stdout'
    );

    if (ok (-f $statusdb_file, 'status db file was created')) {
        my $got = read_file ($statusdb_file);
        my $expect = "base-files/6.0squeeze9\n";
        eq_or_diff (
            $got,
            $expect,
            'status db file content',
        );
    }

    ## run a second time
    $run->run;
    $run->exit_is_num (0);

    ($stdout, $stderr) = stdout_n_stderr ($run);
    $stderr and diag ("stderr:\n" . $stderr);
    eq_or_diff (
        $stdout,
        '',
        'stdout'
    );

    # status db file should be unchanged
    if (ok (-f $statusdb_file, 'status db file exists')) {
        my $got = read_file ($statusdb_file);
        my $expect = <<__EOS__;
base-files/6.0squeeze9
__EOS__
        eq_or_diff (
            $got,
            $expect,
            'status db file content',
        );
    }

    ## run a third time

    # but create fake records in the status db file
    write_file ($statusdb_file, <<__EOS__);
base-files/6.0squeeze7
base-files/6.0squeeze8
__EOS__

    $run->run;
    $run->exit_is_num (0);

    ($stdout, $stderr) = stdout_n_stderr ($run);
    $stderr and diag ("stderr:\n" . $stderr);
    eq_or_diff (
        $stdout,
        $expect_stdout,
        'stdout'
    );

    # status db file should have one line now
    if (ok (-f $statusdb_file, 'status db file exists')) {
        my $got = read_file ($statusdb_file);
        my $expect = "base-files/6.0squeeze9\n";
        eq_or_diff (
            $got,
            $expect,
            'status db file content',
        );
    }
}

foreach my $awk (@AWKs) {
    # several binary packages from same source
    diag ("several binary packages ($awk)");

    my $tb = Testbed->new ($dpkg_version);
    my ($dss_list, $query_list, $statusdb_file) = $tb->files;
    my $exe = $tb->exe (
        $awk,
        [
            '--type', 'ended',
            '--no-heading',
            '--list', $dss_list,
            '--status-db', $statusdb_file,
        ],
    );

    write_file ($dss_list, <<__EOS__);
# comments are allowed, too
iceweasel       non-supported    3.5.16-20       2013-05-01
debconf         non-supported    1.5.36.1        2014-05-02
__EOS__
    mock_query_list (
        $query_list,
        [
            [ 'ioi', 'base-files', '6.0squeeze9' ],
            [ 'ioi', 'debconf', '1.5.36.1' ],
            [ 'ioi', 'debconf-i18n', '1.5.36.1', 'debconf' ],
        ],
    );

    # run a first time
    my $run = Test::Command->new ('cmd' => $exe);
    $run->run;
    $run->exit_is_num (0);

    my ($stdout, $stderr) = stdout_n_stderr ($run);
    $stderr and diag ("stderr:\n" . $stderr);
    my $expect_stdout = <<__EOS__;

* Source:debconf, ended on 2014-05-02 at version 1.5.36.1
  Affected binary packages:
  - debconf (installed version: 1.5.36.1)
  - debconf-i18n (installed version: 1.5.36.1)
__EOS__
    eq_or_diff (
        $stdout,
        $expect_stdout,
        'stdout'
    );

    if (ok (-f $statusdb_file, 'status db file was created')) {
        my $got = read_file ($statusdb_file);
        my $expect = <<__EOS__;
debconf/1.5.36.1
debconf-i18n/1.5.36.1
__EOS__
        eq_or_diff (
            $got,
            $expect,
            'status db file content',
        );
    }
}

foreach my $awk (@AWKs) {
    diag ("Spacing in explanation ($awk)");

    # Assert any kind of spacing at the beginning the the explanative
    # is handled as expected

    my $tb = Testbed->new ($dpkg_version);
    my ($dss_list, $query_list, $statusdb_file) = $tb->files;
    my $exe = $tb->exe (
        $awk,
        [
            '--type', 'ended',
            '--no-heading',
            '--list', $dss_list,
            '--status-db', $statusdb_file,
        ],
    );

    mock_query_list (
        $query_list,
        [
            [ 'ioi', 'openswan', '1:2.6.28+dfsg-5+squeeze2' ],
        ],
    );
    my %tests = (
        'space1' =>
"openswan non-supported 1:2.6.28+dfsg-5+squeeze2 2014-05-31 Not supported in squeeze LTS\n",
        'space2' =>
"openswan non-supported 1:2.6.28+dfsg-5+squeeze2 2014-05-31  Not supported in squeeze LTS\n",
        'space2' =>
"openswan non-supported 1:2.6.28+dfsg-5+squeeze2 2014-05-31   Not supported in squeeze LTS\n",
        'tabbed' =>
"openswan non-supported 1:2.6.28+dfsg-5+squeeze2 2014-05-31\tNot supported in squeeze LTS\n",
        'tabbed2' =>
"openswan non-supported 1:2.6.28+dfsg-5+squeeze2 2014-05-31\t\tNot supported in squeeze LTS\n",
    );

    for my $test_name (sort keys %tests) {
        unlink ($statusdb_file);
        write_file ($dss_list, $tests{$test_name});

        my $run = Test::Command->new ('cmd' => $exe);
        $run->run;
        $run->exit_is_num (0);

        my ($stdout, $stderr) = stdout_n_stderr ($run);
        $stderr and diag ("stderr:\n" . $stderr);
        my $expect_stdout = <<__EOS__;

* Source:openswan, ended on 2014-05-31 at version 1:2.6.28+dfsg-5+squeeze2
  Details: Not supported in squeeze LTS
  Affected binary package:
  - openswan (installed version: 1:2.6.28+dfsg-5+squeeze2)
__EOS__

        eq_or_diff (
            $stdout,
            $expect_stdout,
            "$test_name, stdout",
        );
    }
}

foreach my $awk (@AWKs) {
    diag ("not-purged ($awk)");

    # Packages uninstalled but not purge should be ignored. #749551

    my $tb = Testbed->new ($dpkg_version);
    my ($dss_list, $query_list, $statusdb_file) = $tb->files;
    my $exe = $tb->exe (
        $awk,
        [
            '--type', 'ended',
            '--no-heading',
            '--list', $dss_list,
            '--status-db', $statusdb_file,
        ],
    );

    write_file ($dss_list, <<__EOS__);
iceweasel       non-supported    3.5.16-20       2013-05-01
base-files      non-supported    6.0squeeze9     2014-05-01  Some spaced  explanation
debconf         non-supported    1.5.36.0        2014-05-02
__EOS__
    mock_query_list (
        $query_list,
        [
            [ 'doc', 'base-files', '6.0squeeze9' ],
            [ 'ioi', 'supported-package', '1.0-1' ],
            [ 'ioi', 'supported-package-bin2', '1.0-1', 'supported-package' ],
        ],
    );

    my $run = Test::Command->new ('cmd' => $exe);
    $run->run;
    $run->exit_is_num (0);

    my ($stdout, $stderr) = stdout_n_stderr ($run);
    $stderr and diag ("stderr:\n" . $stderr);
    my $expect_stdout = '';
    eq_or_diff (
        $stdout,
        $expect_stdout,
        'stdout'
    );
}


diag ('implicit --list parameter'); # #749894

{
    my $tb = Testbed->new ($dpkg_version);
    my ($dss_list, $query_list, $statusdb_file) = $tb->files;
    my $exe = $tb->exe (
        $AWKs[0],
        [
            '--type', 'ended',
            '--no-heading',
            '--status-db', $statusdb_file,
        ],
    );

    write_file ($dss_list, <<__EOS__);
iceweasel       non-supported    3.5.16-20       2013-05-01
base-files      non-supported    6.0squeeze9     2014-05-01  Some spaced  explanation
debconf         non-supported    1.5.36.0        2014-05-02
__EOS__
    mock_query_list (
        $query_list,
        [
            [ 'ioi', 'base-files', '6.0squeeze9' ],
            [ 'ioi', 'supported-package', '1.0-1' ],
            [ 'ioi', 'supported-package-bin2', '1.0-1', 'supported-package' ],
        ],
    );

    # run a first time
    my $run = Test::Command->new ('cmd' => $exe);
    $run->run;
    $run->exit_is_num (0);

    my ($stdout, $stderr) = stdout_n_stderr ($run);
    $stderr and diag ("stderr:\n" . $stderr);
    my $expect_stdout = <<__EOS__;

* Source:base-files, ended on 2014-05-01 at version 6.0squeeze9
  Details: Some spaced  explanation
  Affected binary package:
  - base-files (installed version: 6.0squeeze9)
__EOS__
    eq_or_diff (
        $stdout,
        $expect_stdout,
        'stdout'
    );

    if (ok (-f $statusdb_file, 'status db file was created')) {
        my $got = read_file ($statusdb_file);
        my $expect = "base-files/6.0squeeze9\n";
        eq_or_diff (
            $got,
            $expect,
            'status db file content',
        );
    }
}


diag ('limited support checks');

foreach my $awk (@AWKs) {
    diag ("simple ($awk)");

    my $tb = Testbed->new ($dpkg_version);
    my ($dss_list, $query_list, $statusdb_file) = $tb->files;
    my $exe = $tb->exe (
        $awk,
        [
            '--type', 'limited',
            '--no-heading',
            '--list', $dss_list,
            '--status-db', $statusdb_file,
        ],
    );

    write_file ($dss_list, <<__EOS__);
php5    limited     See README.Debian.security for the PHP security policy
__EOS__
    mock_query_list (
        $query_list,
        [
            [ 'ioi', 'php5', '5.3.3-7+squeeze19' ],
        ],
    );

    # run a first time
    my $run = Test::Command->new ('cmd' => $exe);
    $run->run;
    $run->exit_is_num (0);

    my ($stdout, $stderr) = stdout_n_stderr ($run);
    $stderr and diag ("stderr:\n" . $stderr);
    my $expect_stdout = <<__EOS__;

* Source:php5
  Details: See README.Debian.security for the PHP security policy
  Affected binary package:
  - php5 (installed version: 5.3.3-7+squeeze19)
__EOS__
    eq_or_diff (
        $stdout,
        $expect_stdout,
        'stdout'
    );

    if (ok (-f $statusdb_file, 'status db file was created')) {
        my $got = read_file ($statusdb_file);
        my $expect = <<__EOS__;
php5/5.3.3-7+squeeze19
__EOS__
        eq_or_diff (
            $got,
            $expect,
            'status db file content',
        );
    }
}

foreach my $awk (@AWKs) {
    diag ("Spacing in explanation ($awk)");

    # Assert any kind of spacing at the beginning the the explanative
    # is handled as expected

    my $tb = Testbed->new ($dpkg_version);
    my ($dss_list, $query_list, $statusdb_file) = $tb->files;
    my $exe = $tb->exe (
        $awk,
        [
            '--type', 'limited',
            '--no-heading',
            '--list', $dss_list,
            '--status-db', $statusdb_file,
        ],
    );

    mock_query_list (
        $query_list,
        [
            [ 'ioi', 'php5', '5.3.3-7+squeeze19' ],
        ],
    );
    my %tests = (
        'space1' =>
"php5 limited See README.Debian.security for the PHP security policy\n",
        'space2' =>
"php5 limited  See README.Debian.security for the PHP security policy\n",
        'space3' =>
"php5 limited   See README.Debian.security for the PHP security policy\n",
        'tabbed' =>
"php5 limited \tSee README.Debian.security for the PHP security policy\n",
        'tabbed2' =>
"php5 limited \t\tSee README.Debian.security for the PHP security policy\n",
    );

    for my $test_name (sort keys %tests) {
        unlink ($statusdb_file);
        write_file ($dss_list, $tests{$test_name});

        my $run = Test::Command->new ('cmd' => $exe);
        $run->run;
        $run->exit_is_num (0);

        my ($stdout, $stderr) = stdout_n_stderr ($run);
        $stderr and diag ("stderr:\n" . $stderr);
        my $expect_stdout = <<__EOS__;

* Source:php5
  Details: See README.Debian.security for the PHP security policy
  Affected binary package:
  - php5 (installed version: 5.3.3-7+squeeze19)
__EOS__
        eq_or_diff (
            $stdout,
            $expect_stdout,
            "$test_name, stdout",
        );
    }
}

diag ('early end support checks');

foreach my $awk (@AWKs) {
    diag ("Early end ($awk)");

    my $tb = Testbed->new ($dpkg_version);
    my ($dss_list, $query_list, $statusdb_file) = $tb->files;
    my $exe = $tb->exe (
        $awk,
        [
            '--type', 'earlyend',
            '--no-heading',
            '--list', $dss_list,
            '--status-db', $statusdb_file,
        ],
    );

    write_file ($dss_list, <<__EOS__);
iceweasel       non-supported    3.5.16-20       2013-05-01
base-files      non-supported    6.0squeeze9     2014-05-01  Some spaced  explanation
debconf         non-supported    1.5.36.0        2014-05-02
openjdk-6       non-supported    6b35-1.13.7-1~deb7u1    2031-05-23  No perpetual term support
__EOS__
    mock_query_list (
        $query_list,
        [
            [ 'ioi', 'base-files', '6.0squeeze9' ],
            [ 'ioi', 'openjdk-6-jre', '6b35-1.13.7-1~deb7u1', 'openjdk-6' ],
            [ 'ioi', 'supported-package', '1.0-1' ],
            [ 'ioi', 'supported-package-bin2', '1.0-1', 'supported-package' ],
        ],
    );

    # run a first time
    my $run = Test::Command->new ('cmd' => $exe);
    $run->run;
    $run->exit_is_num (0);

    my ($stdout, $stderr) = stdout_n_stderr ($run);
    $stderr and diag ("stderr:\n" . $stderr);
    my $expect_stdout = <<__EOS__;

* Source:openjdk-6, will end on 2031-05-23
  Details: No perpetual term support
  Affected binary package:
  - openjdk-6-jre (installed version: 6b35-1.13.7-1~deb7u1)
__EOS__
    eq_or_diff (
        $stdout,
        $expect_stdout,
        'stdout'
    );

    if (ok (-f $statusdb_file, 'status db file was created')) {
        my $got = read_file ($statusdb_file);
        my $expect = "openjdk-6-jre/6b35-1.13.7-1~deb7u1\n";
        eq_or_diff (
            $got,
            $expect,
            'status db file content',
        );
    }
}

diag ('empty report');

foreach my $awk (@AWKs) {
    my $tb = Testbed->new ($dpkg_version);
    my ($dss_list, $query_list, $statusdb_file) = $tb->files;
    my $exe = $tb->exe (
        $awk,
        [
            '--no-heading',
            '--status-db', $statusdb_file,
        ],
    );

    write_file ($dss_list, <<__EOS__);
iceweasel       non-supported    3.5.16-20       2013-05-01
base-files      non-supported    6.0squeeze9     2014-05-01  Some spaced  explanation
debconf         non-supported    1.5.36.0        2014-05-02
openjdk-6       non-supported    6b35-1.13.7-1~deb7u1    2031-05-23  No perpetual term support
php5            limited          See README.Debian.security for the PHP security policy
__EOS__
    mock_query_list (
        $query_list,
        [
            [ 'ioi', 'supported-package', '1.0-1' ],
            [ 'ioi', 'supported-package-bin2', '1.0-1', 'supported-package' ],
        ],
    );

    # run a first time
    my $run = Test::Command->new ('cmd' => $exe);
    $run->run;
    $run->exit_is_num (0);

    my ($stdout, $stderr) = stdout_n_stderr ($run);
    $stderr and diag ("stderr:\n" . $stderr);
    my $expect_stdout = <<__EOS__;
__EOS__
    eq_or_diff (
        $stdout,
        $expect_stdout,
        'stdout'
    );
}

diag ('exempt packages from listing');

foreach my $awk (@AWKs) {
    diag ("exempt ($awk)");

    my $tb = Testbed->new ($dpkg_version);
    my ($dss_list, $query_list, $statusdb_file) = $tb->files;
    my $exe = $tb->exe (
        $awk,
        [
            '--type', 'limited',
            '--no-heading',
            '--list', $dss_list,
            '--status-db', $statusdb_file,
            '--except', 'hello,binutils-common',
        ],
    );

    write_file ($dss_list, <<__EOS__);
binutils    limited     lorem ipsum dolor sit amet
php5        limited     See README.Debian.security for the PHP security policy
__EOS__
    mock_query_list (
        $query_list,
        [
            [ 'ioi', 'binutils', '2.34-2' ],
            [ 'ioi', 'binutils-common:amd64', '2.34-2', 'binutils' ],
            [ 'ioi', 'php5', '5.3.3-7+squeeze19' ],
        ],
    );

    # run a first time
    my $run = Test::Command->new ('cmd' => $exe);
    $run->run;
    $run->exit_is_num (0);

    my ($stdout, $stderr) = stdout_n_stderr ($run);
    $stderr and diag ("stderr:\n" . $stderr);
    my $expect_stdout = <<__EOS__;

* Source:binutils
  Details: lorem ipsum dolor sit amet
  Affected binary package:
  - binutils (installed version: 2.34-2)

* Source:php5
  Details: See README.Debian.security for the PHP security policy
  Affected binary package:
  - php5 (installed version: 5.3.3-7+squeeze19)
__EOS__
    eq_or_diff (
        $stdout,
        $expect_stdout,
        'stdout'
    );

    if (ok (-f $statusdb_file, 'status db file was created')) {
        my $got = read_file ($statusdb_file);
        my $expect = <<__EOS__;
binutils/2.34-2
php5/5.3.3-7+squeeze19
__EOS__
        eq_or_diff (
            $got,
            $expect,
            'status db file content',
        );
    }
}

done_testing;

exit 0;