next up previous
Next: A.21 vc-init.setl Up: A. WEBeye Source Code Previous: A.19 vc-httpd.setl

  
A.20 vc-image.setl

Service provided:
image, used by local clients:
vc-push.setl     (Section A.34 [vc-push.setl])
vc-snap.setl     (Section A.41 [vc-snap.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-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-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_fdserver_fdimage_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) = `JPEGthen
      n := #current_image;
      if n > 0 and client.image_num /= image_num then
        send_image (clientcurrent_imageimage_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)+`'+
--          `('+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_fdn);
    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_fdn);
      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_imageimage_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_fdthen
         -- Restore this message when we get the JPEG ``streaming'':
--      msg (name+` accepted');
        clients(client_fd) := new_client (client_fdname);
      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_fdname);
  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 clientimageimage_num);
  client_fd := client.client_fd;
  printa (client_fd, #image);
  putc (client_fdimage);
  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_fdimage_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''


next up previous
Next: A.21 vc-init.setl Up: A. WEBeye Source Code Previous: A.19 vc-httpd.setl
David Bacon
1999-12-10