next up previous
Next: A.12 vc-event.setl Up: A. WEBeye Source Code Previous: A.10 vc-decode.setl

  
A.11 vc-do.setl

Services provided:
do, used by local clients:
vc-httpd.setl     (Section A.19 [vc-httpd.setl])
vc-jumper.setl     (Section A.25 [vc-jumper.setl])
vc-mouse.setl     (Section A.28 [vc-mouse.setl])
vc-mover.setl     (Section A.29 [vc-mover.setl])
vc-ptz.setl     (Section A.33 [vc-ptz.setl])
vc-zoomer.setl     (Section A.43 [vc-zoomer.setl])
notice, used by local clients:
vc-evjump.setl     (Section A.13 [vc-evjump.setl])
vc-evzoom.setl     (Section A.14 [vc-evzoom.setl])
vc-ptz.setl     (Section A.33 [vc-ptz.setl])

Client of service:
event    (vc-event.setl, Section A.12 [vc-event.setl])

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

Calls child program:
vc-model.setl     (Section A.27 [vc-model.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-obtain.setl     (Section A.31 [vc-obtain.setl])
vc-provide.setl     (Section A.32 [vc-provide.setl])

Source code: *

const yhwh = `vc-do.setl';
 
-- This program provides the do and notice services.
--
-- The do service is a server interface to model, a pumping
-- co-process which maintains a high-level model of the videocamera
-- control state and supports ``mid-level'' commands (requests already
-- reduced to SETL maps) to alter that state.  Besides routing such
-- commands from clients into the model subprocess, do also
-- implements a queuing policy which allows every client that cannot be
-- satisfied immediately to have a command pending, and also prevents
-- further commands from that client from being queued until the
-- pending one has been performed.
--
-- The notice service distributes ``mid-level'' events to all
-- interested clients.  These originate as low-level events generated
-- by the event service and as responses to parameter-changing
-- commands issued to the model pump.
 
const model_pump = `exec setl vc-model.setl';
 
const sigterm_fd = open (`SIGTERM', `signal');  -- catch TERM signals
 
-- Performer of mid-level commands:
const model_fd = fileno open (model_pump, `pump');
 
-- Generator of low-level events:
const event_fd = fileno obtain_service (`event');
 
const do_server_fd = fileno provide_service (`do');
const notice_server_fd = fileno provide_service (`notice');
 
var notice_clients := {};  -- map from client fd to client record
var do_clients := {};  -- map from client fd to client record
var do_queue := [ ];  -- queue of fd's of do clients awaiting service
var do_pending := false;  -- true when we await a reply from model
 
open (`SIGPIPE', `ignore');  -- as in when we write to closed observers
 
loop
  nonwaiting := domain do_clients - {do_fd : do_fd in do_queue};
  pool := if do_pending then {model_fdelse {} end if
         + {sigterm_fdevent_fddo_server_fdnotice_server_fd}
         + nonwaiting;
  [ready] := select ([pool]);
 
  if sigterm_fd in ready then
    msg (yhwh + ` (' + str pid + `) caught SIGTERM');
    quit_gracefully;
  end if;
 
  for do_fd in ready * nonwaiting loop
    -- New request from a do client.
    reada (do_fdrequest);
    if eof then
      do_clients(do_fd) := om;
      close (do_fd);
    else
      do_client := do_clients(do_fd);
      do_client.request := request;
      do_clients(do_fd) := do_client;
      do_queue with:= do_fd;
    end if;
  end loop;
 
  if do_pending and model_fd in ready then
    reada (model_fdmodel_response);
    if eof then
      msg (`EOF from '+str model_pump+` - quitting');
      quit_gracefully;
    end if;
    -- These notices can be created by the model pump to let us alert
    -- all the observers to parameter changes and special events such
    -- as initialization:
    for message in model_response.notices ? [ ] loop
      tell_observers (message);  -- tell notice clients
    end loop;
    do_fd fromb do_queue;
    do_client := do_clients(do_fd);
    request := do_client.request;
    if request.name = `Getthen
      writea (do_fdmodel_response.value);
    else
      printa (do_fd);  -- a blank line to say the command has been done
    end if;
    flush (do_fd);
    do_pending := false;
  end if;
 
  if event_fd in ready then
    reada (event_fdframe);
    if eof then
      msg (`EOF from '+filename event_fd+` - quitting');
      quit_gracefully;
    else
      message := decode frame;
      tell_observers (message);  -- tell notice clients
    end if;
  end if;
 
  if do_server_fd in ready then
    do_fd := accept (do_server_fd);
    if do_fd /= om then
      name := getname do_fd;
      if allowed (do_fdthen
        do_client := {};
        do_client.name := name;
        do_clients(do_fd) := do_client;
      else
        close (do_fd);
        msg (name+` denied access to "do" service');
      end if;
    end if;
  end if;
 
  if notice_server_fd in ready then
    notice_fd := accept (notice_server_fd);
    if notice_fd /= om then
      name := getname notice_fd;
      if allowed (notice_fdthen
        notice_client := {};
        notice_client.name := name;
        notice_clients(notice_fd) := notice_client;
      else
        close (notice_fd);
        msg (name+` denied access to "notice" service');
      end if;
    end if;
  end if;
 
  if #do_queue > 0 and not do_pending then
    do_fd := do_queue(1);
    do_client := do_clients(do_fd);
    request := do_client.request;
    writea (model_fdrequest);
    flush (model_fd);
    do_pending := true;
  end if;
 
end loop;
 
 
proc tell_observers (message);
  for notice_client = notice_clients(notice_fdloop
    clear_error;
    writea (notice_fdmessage);
    flush (notice_fd);  -- eventually causes EPIPE if client closed
    if last_error /= no_error then
      close (notice_fd);
      notice_clients(notice_fd) := om;
    end if;
  end loop;
end proc tell_observers;
 
proc quit_gracefully;
  exit_gracefully ([[str model_pumpmodel_fd]]);
end proc;
 
#include ``vc-provide.setl''
#include ``vc-obtain.setl''
#include ``vc-getname.setl''
#include ``vc-allowed.setl''
#include ``vc-decode.setl''
#include ``vc-exit.setl''
#include ``vc-msg.setl''


next up previous
Next: A.12 vc-event.setl Up: A. WEBeye Source Code Previous: A.10 vc-decode.setl
David Bacon
1999-12-10