A.34 vc-push.setl

Service provided:
push

Client of service:
image    (vc-image.setl, Section A.20 [vc-image.setl])

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

Textually #includes:
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])
webutil.setl     (Section A.44 [webutil.setl])

Source code: *

const yhwh = `vc-push.setl';
 
-- Send an infinite multi-part MIME document consisting of a stream of
-- images for the benefit of browsers that support the ``server-push''
-- model of yore.  (This has long been in Netscape, but never made it
-- into the Evil Empire Explorer.)
 
const sigterm_fd = open (`SIGTERM', `signal');  -- catch TERM signals
const server_fd = fileno provide_service (`push');
 
var clients := {};
 
loop
 
  [ready] := select ([{sigterm_fd, server_fd} + domain clients]);
 
  if sigterm_fd in ready then
    msg (yhwh + ` (' + str pid + `) caught SIGTERM');
    quit_gracefully;
  end if;
 
  for client = clients(pump_fd) | pump_fd in ready loop
    done_client (pump_fd);
  end loop;
 
  if server_fd in ready then
    fd := accept (server_fd);
    if fd  om then
      name := getname fd;
      msg (name+` accepted');
      pump_fd := pump();
      if pump_fd = -1 then
        -- child
        [uri, protocol, mime_headers] := get_request (fd);
        mu := massage_uri uri ? {};
        mu.cmd ?:= `JPEG';  -- someday we may dispatch on content type
        image_fd := obtain_service (`image');
        if image_fd = om then
          printa (fd, `HTTP/1.0 500 Sorry\r');
          printa (fd, `Server: WEBeye\r');
          printa (fd, `Content-type: text/plain\r');
          printa (fd, `\r');
          printa (fd, `JPEG source temporarily unavailable.\r');
          printa (fd, `Please try later.\r');
          stop;
        end if;
        printa (fd, `HTTP/1.0 200 OK');
        printa (fd, `Server: WEBeye');
        printa (fd, `Content-type: multipart/x-mixed-replace;boundary=EOM');
        printa (fd, `');
        printa (fd, `--EOM');
        loop doing
          printa (image_fd, `JPEG');
          reada (image_fd, n);
        while not eof do
          image := getn (image_fd, n);
          assert #image = n;
          printa (fd, `Content-type: image/jpeg');
          printa (fd, `Content-length: '+str n+`');
          printa (fd, `');
          printa (fd, image+`');
          printa (fd, `--EOM');
          flush (fd);
          if is_integer mu.rate then
            select (om, mu.rate);  -- delay for mu.rate ms
          end if;
        end loop;
        stop;
      end if;
      -- parent continues here
      close (fd);  -- the child hangs onto this
      client := {};
      client.pump_fd := pump_fd;
      client.name := name;
      clients(pump_fd) := client;
    end if;
  end if;
 
end loop;
 
proc done_client (pump_fd);
  msg (clients(pump_fd).name + ` done');
  close (pump_fd);
  clients(pump_fd) := om;
end proc done_client;
 
proc quit_gracefully;
  exit_gracefully ([[`pump for client ' + client.name, pump_fd] :
                                          client = clients(pump_fd)]);
end proc;
 
#include ``vc-provide.setl''
#include ``vc-obtain.setl''
#include ``vc-getname.setl''
#include ``vc-exit.setl''
#include ``vc-msg.setl''
#include ``webutil.setl''