view release on metacpan or  search on metacpan

t/70-async.t  view on Meta::CPAN

        next if length($p) >= ClamAV::Clamd::_sun_path_max();
        $sock = $p; last;
    }
}
unless ($sock) { done_testing; exit 0 }

my $c = ClamAV::Clamd->new(socket => $sock);
unless ($c->ping) { done_testing; exit 0 }

my $EICAR = 'X5O!P%@AP[4\PZX54(P^)7CC)7}' . '$EICAR-STANDARD-ANTIVIRUS-TEST-FILE!$H+H*';

sub write_file {
    my ($n, $b) = @_;
    my $p = "$dir/$n";
    open my $fh, '>:raw', $p or die $!;
    print {$fh} $b;
    close $fh;
    return $p;
}
my $eicar = write_file('e.txt', $EICAR);
my $clean = write_file('c.txt', 'nothing to see');

# --- THE GATE -----------------------------------------------------------
# The same scan, driven three ways, must give the same verdict. If the
# blocking and non-blocking paths can disagree then one of them is a
# second implementation of the protocol, which is exactly what this phase
# exists to prevent.
for my $case ([$eicar, 'infected'], [$clean, 'clean']) {
    my ($path, $want) = @$case;
    my $name = $path =~ /e\.txt/ ? 'eicar' : 'clean';

    my $blocking = $c->scan_path($path);
    is $blocking->state, $want, "$name: blocking gives $want";

    my $async = $c->start_scan($path, 'path');
    drive($async);
    is $async->verdict->state, $want, "$name: driven under select gives $want";
    is $async->verdict->signature, $blocking->signature,
        "$name: and the same signature";
}

# --- interleaved, in one process ----------------------------------------
# Two scans in flight at once, stepped alternately. Nothing may leak from
# one connection into the other - the failure this would show up as is a
# scan reporting the OTHER scan's verdict.
{
    my @scans = (
        $c->start_scan($eicar, 'path'),
        $c->start_scan($clean, 'path'),
        $c->start_scan($EICAR),
        $c->start_scan('harmless bytes'),
    );
    drive(@scans);

    is $scans[0]->verdict->state, 'infected', 'interleaved scan 1: infected';
    is $scans[1]->verdict->state, 'clean',    'interleaved scan 2: clean';
    is $scans[2]->verdict->state, 'infected', 'interleaved scan 3: infected';
    is $scans[3]->verdict->state, 'clean',    'interleaved scan 4: clean';
}

# --- a filehandle scan holds its source alive ---------------------------
# The handle keeps a reference, because the scan outlives the call that
# started it and reading a freed PV is not a bug that shows up locally.
{
    my $s = do {
        open my $fh, '<:raw', $eicar or die $!;
        $c->start_scan($fh, 'fd');
    };                                   # $fh out of scope, scan still live
    drive($s);
    is $s->verdict->state, 'infected', 'a scan outlives the handle it was given';
}

{
    my $s = do {
        my $bytes = $EICAR;
        $c->start_scan($bytes);
    };                                   # $bytes out of scope
    drive($s);
    is $s->verdict->state, 'infected', 'a byte scan outlives the scalar it was given';
}

done_testing;