# SPDX-License-Identifier: GPL-2.0-or-later
#
# Compatibility layer providing the function-based ZMQ::LibZMQ3 API
# (as used by amavisd-new) on top of ZMQ::FFI. This lets
# the existing amavisd-new code use ZeroMQ without the long-unmaintained
# ZMQ::LibZMQ3 / libzmq3-perl packages.
#
# The module is only loaded as a fallback when neither ZMQ::LibZMQ3,
# ZMQ::LibZMQ2 nor ZeroMQ are available.

package Amavis::ZMQ::FFICompat;

use strict;
use warnings;
use Exporter qw(import);

use Time::HiRes ();
use ZMQ::FFI ();
use ZMQ::FFI::Constants qw(:all);
use ZMQ::FFI::Util ();

BEGIN {
  ZMQ::FFI::Util::zmq_soname or die "libzmq not available\n";
}

our @EXPORT = qw(
  zmq_init zmq_socket zmq_setsockopt zmq_getsockopt
  zmq_connect zmq_bind zmq_send zmq_sendstr zmq_sendmsg
  zmq_recvmsg zmq_msg_data zmq_msg_close zmq_close zmq_term zmq_poll
);

# ZMQ::FFI exposes socket options through set($opt, $type, $val) /
# get($opt, $type) rather than the zmq_setsockopt/zmq_getsockopt C API.
# Map the option constants (by their integer value) to the value type.
my %SOCKOPT_TYPE = (
  ZMQ_LINGER()        => 'int',
  ZMQ_SNDHWM()        => 'int',
  ZMQ_RCVHWM()        => 'int',
  ZMQ_HWM()           => 'int',
  ZMQ_RCVMORE()       => 'int',
  ZMQ_IPV4ONLY()      => 'int',
  ZMQ_SUBSCRIBE()     => 'string',
  ZMQ_UNSUBSCRIBE()   => 'string',
);

sub zmq_version {
  my ($major, $minor, $patch) = ZMQ::FFI::Util::zmq_version();
  return wantarray ? ($major, $minor, $patch) : "$major.$minor.$patch";
}

sub zmq_init {
  my ($io_threads) = @_;
  $io_threads = 1 if !defined $io_threads;
  ZMQ::FFI->new(threads => $io_threads);
}

sub zmq_socket {
  my ($ctx, $type) = @_;
  $ctx->socket($type);
}

sub zmq_setsockopt {
  my ($sock, $opt, $val) = @_;
  my $type = $SOCKOPT_TYPE{$opt} // 'int';
  eval { $sock->set($opt, $type, $val); 1 } ? 0 : -1;
}

sub zmq_getsockopt {
  my ($sock, $opt) = @_;
  my $type = $SOCKOPT_TYPE{$opt} // 'int';
  eval { $sock->get($opt, $type) } // -1;
}

sub zmq_connect {
  my ($sock, $endpoint) = @_;
  eval { $sock->connect($endpoint); 1 } ? 0 : -1;
}

sub zmq_bind {
  my ($sock, $endpoint) = @_;
  eval { $sock->bind($endpoint); 1 } ? 0 : -1;
}

sub zmq_send {
  my ($sock, $data, $len, $flags) = @_;
  eval { $sock->send($data, $flags // 0); 1 }
    or return -1;
  return $sock->has_error ? -1 : length($data);
}

sub zmq_sendstr {
  my ($sock, $str, $flags) = @_;
  my $rv = zmq_send($sock, $str, length($str), $flags // 0);
  return $rv == -1 ? undef : $rv;
}

sub zmq_sendmsg {
  my ($sock, $msg, $flags) = @_;
  my $data = ref($msg) ? $$msg : $msg;
  zmq_send($sock, $data, length($data), $flags // 0);
}

sub zmq_recvmsg {
  my ($sock, $flags) = @_;
  my $data = $sock->recv($flags // 0);
  return undef unless defined $data;
  bless \$data, 'Amavis::ZMQ::FFICompat::Message';
}

sub zmq_msg_data {
  my ($msg) = @_;
  return ref($msg) ? $$msg : $msg;
}

sub zmq_msg_close {
  return 0;
}

sub zmq_close {
  my ($sock) = @_;
  eval { $sock->close; 1 };
  return 0;
}

sub zmq_term {
  my ($ctx) = @_;
  eval { $ctx->destroy; 1 };
  return 0;
}

# Replacement for the C zmq_poll(): poll the supplied sockets for readability
# (ZMQ_POLLIN) until an event arrives or the timeout elapses. When a socket is
# readable its per-item callback (if any) is invoked, mirroring the behaviour
# of ZMQ::LibZMQ3's zmq_poll(). Returns the number of events handled, 0 on
# timeout, -1 on error.
#
# Waiting is done with select() on the sockets' ZMQ_FD file descriptors rather
# than a busy sleep, so an idle poll() does not burn CPU.
sub zmq_poll {
  my ($items, $timeout_ms) = @_;
  my $infinite = defined $timeout_ms && $timeout_ms < 0;
  $timeout_ms = 0  if !defined $timeout_ms;
  my $deadline = Time::HiRes::time() + $timeout_ms / 1000;
  for (;;) {
    my $n_events = 0;
    for my $it (@$items) {
      my $sock = $it->{socket};
      next unless $sock;
      next unless defined $it->{events} && ($it->{events} & ZMQ_POLLIN());
      next unless $sock->has_pollin;
      $n_events++;
      $it->{callback}->($sock)  if $it->{callback};
    }
    return $n_events  if $n_events;
    if ($infinite) {
      my $read_set = _poll_fd_set($items);
      return 0  if !length $read_set;   # nothing to wait on; avoid a busy loop
      select(my $rout = $read_set, undef, undef, undef);
    } else {
      my $remaining = $deadline - Time::HiRes::time();
      return 0  if $remaining <= 0;
      my $read_set = _poll_fd_set($items);
      select(my $rout = $read_set, undef, undef, $remaining);
    }
  }
}

# Build a select()able bit vector of the ZMQ_FD of each socket to be polled for
# readability. Returns an empty string when there is nothing to wait on.
sub _poll_fd_set {
  my ($items) = @_;
  my $read_set = '';
  for my $it (@$items) {
    my $sock = $it->{socket};
    next unless $sock;
    next unless defined $it->{events} && ($it->{events} & ZMQ_POLLIN());
    my $fd = $sock->get_fd;
    next unless defined $fd && $fd >= 0;
    vec($read_set, $fd, 1) = 1;
  }
  return $read_set;
}

1;
