const yhwh = 'vc-image.setl';

-- This server, when it has more than 0 clients connected, keeps an
-- "image pump" maximally busy making images, and sends each new image
-- out to all the ready clients as it arrives.  It also sends this
-- image to clients that become ready before the next one is made.
--
-- This server is intended for "local" use and trusts its clients
-- (probably the children of some higher-level server) to be ready to
-- take a whole image when they send a command line.  (Currently the
-- only command supported is JPEG, and takes no parameters.)  It
-- checks to make sure clients are on the local host, whence the trust.
--
-- Each image is prefaced by a single line of all decimal digits
-- stating the number of bytes in the image that follows.  The client
-- should read that count with `reada' (or fscanf in C) in case I take
-- the option of appending a newline to the image (which I currently
-- don't, but legally could).
---
--- Now that I am having vc-push.setl, for example, bash away at this
--- thing, I will temporarily (:-) start leaving the image pump open
--- "permanently".

const sigterm_fd = open ('SIGTERM', 'signal');  -- catch TERM signals
const server_fd = fileno provide_service ('image');

var image_fd := om;  -- image pump fd
var clients := {};

image_errors := 0;
awaiting_image := false;
current_image := '';
image_num := 0;

loop

  [ready] := select ([{sigterm_fd, server_fd, image_fd} +
                                                    domain clients]);

  if sigterm_fd in ready then
    msg (yhwh + ' (' + str pid + ') caught SIGTERM');
    quit_gracefully;
  end if;

  for client = clients(client_fd) | client_fd in ready loop
    if (line := getline client_fd) /= om and
       #(t := split (line)) = 1 and
       t(1) = 'JPEG' then
      n := #current_image;
      if n > 0 and client.image_num /= image_num then
        send_image (client, current_image, image_num);
      else
        client.waiting := true;
      end if;
      clients(client_fd) := client;
    else
      close (client_fd);
      name := client.name;
      image_count := client.image_count;
      -- Restore this message when we get the JPEG "streaming":
--    time_spent := (clock - client.start_time) / 1000;
--    msg(name+' done after '+fixed(time_spent,0,1)+'s '+
--          '('+fixed(image_count / time_spent,0,1)+' fps)');
      clients(client_fd) := om;
    end if;
  end loop;

  if image_fd /= om and image_fd in ready then
    reada (image_fd, n);
    if n = om then
      msg ('image error - n is OM - check /var/log/messages for clues');
      close (image_fd);
      current_image := '';  -- don't want to re-use old image after this
      if (image_errors +:= 1) < 10 then
        image_fd := open_image_pump();
        awaiting_image := false;
      else
        msg (str image_errors+' image errors in a row - bye!');
        stop image_errors;
      end if;
    else
      image := getn (image_fd, n);
      if #image /= n then
        image_errors +:= 1;
        msg ('image error - size '+str #image+' /= '+str n);
      else
        image_errors := 0;
        current_image := image;
        image_num +:= 1;
        for client = clients(client_fd) | client.waiting loop
          send_image (clients(client_fd), current_image, image_num);
        end loop;
      end if;
    end if;
    awaiting_image := false;
  end if;

  if server_fd in ready then
    client_fd := accept (server_fd);
    if client_fd /= om then
      name := getname client_fd;
      if allowed (client_fd) then
         -- Restore this message when we get the JPEG "streaming":
--      msg (name+' accepted');
        clients(client_fd) := new_client (client_fd, name);
      else
        msg ('untrusted client '+name+' refused');
        close (client_fd);
      end if;
    end if;
  end if;

  if image_fd = om and #clients > 0 then
    image_fd := open_image_pump();
    awaiting_image := false;
    -- Restore this code when we get the JPEG "streaming":
--elseif image_fd /= om and #clients = 0 then
--  msg ('closing image pump, image_fd = '+str image_fd);
--  close (image_fd);
--  image_fd := om;
--  current_image := '';  -- it is "old" or soon will be
  end if;

  if image_fd /= om and not awaiting_image then
    printa (image_fd,'JPEG');
    awaiting_image := true;
  end if;

end loop;

proc open_image_pump();
  image_fd := open ('image-pump','pump') ? open ('busy-pump','pump');
  if image_fd = om then
    msg ('cannot open image pump - bye!');
    quit_gracefully;
  end if;
  return image_fd;
end proc;

proc new_client (client_fd, name);
  client := {};
  client.client_fd := client_fd;
  client.last_num := 0;
  client.waiting := false;
  client.start_time := clock;
  client.image_count := 0;
  client.name := name;
  return client;
end proc;

proc send_image (rw client, image, image_num);
  client_fd := client.client_fd;
  printa (client_fd, #image);
  putc (client_fd, image);
  flush (client_fd);
  client.image_num := image_num;
  client.image_count +:= 1;
  client.waiting := false;
end proc;

proc quit_gracefully;
  exit_gracefully ([if image_fd = om then om
                    else [str filename image_fd, image_fd]
                    end if]);
end proc;

#include "vc-provide.setl"
#include "vc-getname.setl"
#include "vc-allowed.setl"
#include "vc-exit.setl"
#include "vc-msg.setl"