A.12 vc-event.setl

Services provided:
event, used by local client vc-do.setl     (Section A.11 [vc-do.setl])
notify, used by local client vc-seq.setl     (Section A.39 [vc-seq.setl])

Called by parent program:
vc-toplev.setl     (Section A.42 [vc-toplev.setl])

Textually #includes:
vc-allowed.setl     (Section A.2 [vc-allowed.setl])
vc-decode.setl     (Section A.10 [vc-decode.setl])
vc-exit.setl     (Section A.15 [vc-exit.setl])
vc-getname.setl     (Section A.16 [vc-getname.setl])
vc-msg.setl     (Section A.30 [vc-msg.setl])
vc-provide.setl     (Section A.32 [vc-provide.setl])

Source code: *

const yhwh = `vc-event.setl';
 
-- Low-level event notification distributor
 
var producers, consumers;
 
const sigterm_fd = open (`SIGTERM', `signal');  -- catch TERM signals
 
-- Producers use this ``notify'' port to supply events to us:
const in_server_fd = fileno provide_service (`notify');
 
-- Consumers receive events on this ``event'' port:
const out_server_fd = fileno provide_service (`event');
 
open (`SIGPIPE', `ignore');  -- as when we write to closed consumers
 
producers := {};
consumers := {};
 
loop do
 
  [ready] := select ([{sigterm_fd, in_server_fd, out_server_fd} +
                                                  domain producers]);
 
  if sigterm_fd in ready then
    msg (yhwh + ` (' + str pid + `) caught SIGTERM');
    quit_gracefully;
  end if;
 
  for producer = producers(fd) | fd in ready loop
    reada (fd, event);
    if eof then
      close (fd);
      producers(fd) := om;
    else
      tell_consumers (event);
    end if;
  end loop;
 
  if in_server_fd in ready then
    fd := accept (in_server_fd);
    if fd  om then
      name := getname fd;
      if allowed (fd) then
        producer := {};
        producer.name := name;
        producers(fd) := producer;
      else
        msg (name+` not allowed as event producer');
        close (fd);
      end if;
    end if;
  end if;
 
  if out_server_fd in ready then
    fd := accept (out_server_fd);
    if fd  om then
      name := getname fd;
      if allowed (fd) then
        consumer := {};
        consumer.name := name;
        consumers(fd) := consumer;
      else
        msg (name+` not allowed as event consumer');
        close (fd);
      end if;
    end if;
  end if;
 
end loop;
 
proc tell_consumers (event);
  for consumer = consumers(fd) loop
    clear_error;
    writea (fd, event);
    flush (fd);  -- should eventually cause EPIPE if client closed
    if last_error  no_error then
      msg (`consumer '+consumer.name+` done');
      close (fd);
      consumers(fd) := om;
    end if;
  end loop;
end proc;
 
proc quit_gracefully;
  -- Degenerate, since we currently have no pump- or pipe-attached child
  exit_gracefully ([ ]);
end proc;
 
#include ``vc-provide.setl''
#include ``vc-getname.setl''
#include ``vc-allowed.setl''
#include ``vc-decode.setl''
#include ``vc-exit.setl''
#include ``vc-msg.setl''