/*
 * websock.c  (C) SOFNEC
 *
 * # WINDOWS
 * > azpc -p websock.c /i /e websock.exe /dcurses /lib ws2_32.lib 
 * # LINUX
 * > azpc -p websock.c /i /e websock /dcurses 
 */
#include <azprolog.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <stdint.h>
#include <limits.h>
#include "client.h"

#define WEBSOCK_VERSION   "0.6"

#define MAX_SUB_PROTOCOL_NUM             5
#define MAX_PATH_SIZE                  512
#define MAX_ADDR_HOST_ORIGIN_SIZE      128

#ifdef EMPTY_WRITE_SUCC
#define EMPTY_WRITE_SUCC_OR_FAIL    YIELD(DET_SUCC)
#else
#define EMPTY_WRITE_SUCC_OR_FAIL    YIELD(FAIL)
#endif


static int IETF_Version = -1; // latest

#define PARG(n,i)       (next_var_cell - n + i)

/* 2015.2.13
extern void yield_error();
#define ERROR(n)         yield_error(n)
*/

#define ALL_BEGIN(fp) \
  if (HP_GE(next_var_cell, var_bottom))	\
    LocalOverflow();			\
  fp->Local = next_var_cell;	\
  fp->Global = next_gvar_cell;	\
  fp->Trail = trail_register;	\
  fp->nVars = 0


/* client */
extern pred P1_ws_set_log_level(Frame *Env);
extern pred P1_ws_set_client_certificate_file_path(Frame *Env);
extern pred P1_ws_set_client_private_key_file_path(Frame *Env);
extern pred P3_ws_create_context(Frame* Env);
extern pred P1_ws_delete_context(Frame* Env);
extern pred P10_ws_connect(Frame* Env);
extern pred P1_ws_close(Frame* Env);
extern pred P2_ws_is_close(Frame *Env);
extern pred P2_ws_sub_protocol(Frame *Env);
extern pred P3_ws_read_text(Frame* Env);
extern pred P2_ws_write_text(Frame* Env);
extern pred P1_ws_write_pong(Frame* Env);
extern pred P3_ws_read_list(Frame* Env);
extern pred P2_ws_write_atom_list(Frame* Env);
extern pred P2_ws_write_list_binary(Frame* Env);
extern pred P1_ws_version(Frame *Env);

/* server */
extern pred P6_ws_create_server_context(Frame *Env);
extern pred P1_ws_delete_server_context(Frame *Env);
extern pred P4_ws_service(Frame *Env);

static BASEINT ATOM_LL_ERR;
static BASEINT ATOM_LL_WARN;
static BASEINT ATOM_LL_NOTICE;
static BASEINT ATOM_LL_INFO;
static BASEINT ATOM_LL_DEBUG;
static BASEINT ATOM_LL_PARSER;
static BASEINT ATOM_LL_HEADER;
static BASEINT ATOM_LL_EXT;
static BASEINT ATOM_LL_CLIENT;
static BASEINT ATOM_LL_LATENCY;

static BASEINT WEBSOCK_VERSION_ATOM;

#ifdef SUPPORT_WS_SERVER_API
static BASEINT ATOM_NORMAL;
static BASEINT ATOM_FAIL;
static BASEINT ATOM_NO_SOCKET;
static BASEINT ATOM_FORK_PARENT;
static BASEINT ATOM_FORK_CHILD;
#endif /* SUPPORT_WS_SERVER_API */

extern int initiate_websock(void)
{
  char buf[256];

  put_bltn("ws_set_log_level\0",   1, P1_ws_set_log_level);
  put_bltn("ws_set_client_certificate_file_path\0",  1,
           P1_ws_set_client_certificate_file_path);
  put_bltn("ws_set_client_private_key_file_path\0",  1,
           P1_ws_set_client_private_key_file_path);
  put_bltn("ws_create_context\0",  3, P3_ws_create_context);
  put_bltn("ws_delete_context\0",  1, P1_ws_delete_context);
  put_bltn("ws_connect\0",        10, P10_ws_connect);
  put_bltn("ws_close\0",           1, P1_ws_close);
  put_bltn("ws_is_close\0",        2, P2_ws_is_close);
  put_bltn("ws_sub_protocol\0",    2, P2_ws_sub_protocol);
  put_bltn("ws_read_text\0",       3, P3_ws_read_text);
  put_bltn("ws_write_text\0",      2, P2_ws_write_text);
  put_bltn("ws_write_pong\0",      1, P1_ws_write_pong);
  put_bltn("ws_read_list\0",       3, P3_ws_read_list);
  put_bltn("ws_write_atom_list\0",   2, P2_ws_write_atom_list);
  put_bltn("ws_write_list_binary\0", 2, P2_ws_write_list_binary);
  put_bltn("ws_version\0",           1, P1_ws_version);

  ATOM_LL_ERR     = PutAtom((Frame* )NULL, "WS_LL_ERR");
  ATOM_LL_WARN    = PutAtom((Frame* )NULL, "WS_LL_WARN");
  ATOM_LL_NOTICE  = PutAtom((Frame* )NULL, "WS_LL_NOTICE");
  ATOM_LL_INFO    = PutAtom((Frame* )NULL, "WS_LL_INFO");
  ATOM_LL_DEBUG   = PutAtom((Frame* )NULL, "WS_LL_DEBUG");
  ATOM_LL_PARSER  = PutAtom((Frame* )NULL, "WS_LL_PARSER");
  ATOM_LL_HEADER  = PutAtom((Frame* )NULL, "WS_LL_HEADER");
  ATOM_LL_EXT     = PutAtom((Frame* )NULL, "WS_LL_EXT");
  ATOM_LL_CLIENT  = PutAtom((Frame* )NULL, "WS_LL_CLIENT");
  ATOM_LL_LATENCY = PutAtom((Frame* )NULL, "WS_LL_LATENCY");

  sprintf(buf, "websock-ext: %s, libwebsockets: %s",
          WEBSOCK_VERSION, lws_get_library_version());
  WEBSOCK_VERSION_ATOM = PutAtom((Frame* )NULL, buf);


#ifdef SUPPORT_WS_SERVER_API

  ATOM_NORMAL      = PutAtom((Frame* )NULL, "WS_NORMAL");
  ATOM_FAIL        = PutAtom((Frame* )NULL, "WS_FAIL");
  ATOM_NO_SOCKET   = PutAtom((Frame* )NULL, "WS_NO_SOCKET");
  ATOM_FORK_PARENT = PutAtom((Frame* )NULL, "WS_FORK_PARENT");
  ATOM_FORK_CHILD  = PutAtom((Frame* )NULL, "WS_FORK_CHILD");

  put_bltn("ws_create_server_context\0",  6, P6_ws_create_server_context);
  put_bltn("ws_delete_server_context\0",  1, P1_ws_delete_server_context);
  put_bltn("ws_service\0",                4, P4_ws_service);

#endif /* SUPPORT_WS_SERVER_API */

  return 1;
}

static int log_level_atom_to_int(BASEINT a)
{
  if (a == ATOM_LL_ERR)
    return LLL_ERR;
  else if (a == ATOM_LL_WARN)
    return LLL_WARN;
  else if (a == ATOM_LL_NOTICE)
    return LLL_NOTICE;
  else if (a == ATOM_LL_INFO)
    return LLL_INFO;
  else if (a == ATOM_LL_DEBUG)
    return LLL_DEBUG;
  else if (a == ATOM_LL_PARSER)
    return LLL_PARSER;
  else if (a == ATOM_LL_HEADER)
    return LLL_HEADER;
  else if (a == ATOM_LL_EXT)
    return LLL_EXT;
  else if (a == ATOM_LL_CLIENT)
    return LLL_CLIENT;
  else if (a == ATOM_LL_LATENCY)
    return LLL_LATENCY;
  else {
    //fprintf(stderr, "Invalid log level atom\r\n");
    return -1;
  }
}

extern pred P1_ws_set_log_level(Frame *Env)
{
  int log_level;
  TERM *list, *my_car;
  BASEINT a;

  ALL_BEGIN(Env);

  list = PARG(1,0);

  REALVALUE(list);
  if (! IS_LIST(list))
    AZ_ERROR(9);

  log_level = 0;
  while (TRUE) {
    REALVALUE(list);
    if (TAG(list) == list_tag || TAG(list) == glist_tag) {
      list = my_car = BODY(list);
      list++;

      a = GetAtom(my_car);
      int level = log_level_atom_to_int(a);
      if (level > 0) {
        log_level |= level;
      }
      else {
        AZ_ERROR(9);
      }
    }
    else
      break;
  }		

  ws_set_log_level(log_level);
  YIELD(DET_SUCC);
}

extern pred P1_ws_set_client_certificate_file_path(Frame *Env)
{
  char buf[PATH_MAX];
  int r;
  BASEINT a;

  ALL_BEGIN(Env);

  a = GetAtom(PARG(1,0));
  if (az_get_atom_length(a) >= PATH_MAX)
    YIELD(FAIL);

  Atom2Asciz(a, buf);

  r = ws_set_client_certificate_file_path(buf);
  if (r != 0)
    YIELD(FAIL);
  else
    YIELD(DET_SUCC);
}

extern pred P1_ws_set_client_private_key_file_path(Frame *Env)
{
  char buf[PATH_MAX];
  int r;
  BASEINT a;

  ALL_BEGIN(Env);

  a = GetAtom(PARG(1,0));
  if (az_get_atom_length(a) >= PATH_MAX)
    YIELD(FAIL);

  Atom2Asciz(a, buf);

  r = ws_set_client_private_key_file_path(buf);
  if (r != 0)
    YIELD(FAIL);
  else
    YIELD(DET_SUCC);
}

/* ?-ws_create_context(+SUB_PROTOCOLS, +DEFAULT_SUB_PROTOCOL_INDEX, -CONTEXT). */
extern pred P3_ws_create_context(Frame *Env)
{
  int r, i;
  int sub_protocol_num;
  int default_sub_protocol;
  struct libwebsocket_context* context;
  const char sub_protocols[MAX_SUB_PROTOCOL_NUM][WS_SUB_PROTOCOL_NAME_MAX_SIZE];
  TERM* arg;

  ALL_BEGIN(Env);

  arg = PARG(3,0);
  sub_protocol_num = az_list_len(arg);
  if (sub_protocol_num > MAX_SUB_PROTOCOL_NUM || sub_protocol_num <= 0)
    AZ_ERROR(9);

  i = 0;
  while (TRUE) {
    REALVALUE(arg);
    if (! IS_LIST(arg)) break;

    arg = BODY(arg);
    Atom2Asciz(GetAtom(arg), (char* )sub_protocols[i++]);
    arg++;
  }		

  default_sub_protocol = GetInt(PARG(3,1));
  r = ws_create_context(sub_protocol_num, sub_protocols, default_sub_protocol,
                        &context);
  if (r != 0)
    YIELD(FAIL);
  else
    YIELD(UnifyInt(PARG(3,2), (BASEINT )context) != 0 ? DET_SUCC : FAIL);
}

/* ?-ws_delete_context(+CONTEXT). */
extern pred P1_ws_delete_context(Frame *Env)
{
  int r;
  struct libwebsocket_context* context;

  ALL_BEGIN(Env);

  context = (struct libwebsocket_context* )GetInt(PARG(1,0));

  r =  ws_delete_context(context);
  if (r != 0)
    YIELD(FAIL);
  else
	YIELD(DET_SUCC);
}

/* ?- ws_connect(+Timeout, +CONTEXT, +SUB_PROTOCOL, +ADDRESS, +PORT, +SSL, +PATH, +HOST, +ORIGIN, -SESSION). */
extern pred P10_ws_connect(Frame *Env)
{
  int timeout, port, ssl;
  PER_SESSION_DATA* psd;
  struct libwebsocket_context* context;
  char buf[AZ_MAX_ATOM_LENGTH];
  char* sub_protocol = buf;
  char path[MAX_PATH_SIZE];
  char addr[MAX_ADDR_HOST_ORIGIN_SIZE];
  char host[MAX_ADDR_HOST_ORIGIN_SIZE];
  char origin[MAX_ADDR_HOST_ORIGIN_SIZE];

  ALL_BEGIN(Env);

  timeout = GetInt(PARG(10,0));
  context = (struct libwebsocket_context* )GetInt(PARG(10,1));
  port = GetInt(PARG(10,4));
  ssl  = GetInt(PARG(10,5));

  Atom2Asciz(GetAtom(PARG(10,6)), buf);
  if (strlen(buf) >= MAX_PATH_SIZE)
    YIELD(FAIL);
  strcpy(path, buf);

  Atom2Asciz(GetAtom(PARG(10,3)), buf);
  if (strlen(buf) >= MAX_ADDR_HOST_ORIGIN_SIZE)
    YIELD(FAIL);
  strcpy(addr, buf);

  Atom2Asciz(GetAtom(PARG(10,7)), buf);
  if (strlen(buf) >= MAX_ADDR_HOST_ORIGIN_SIZE)
    YIELD(FAIL);
  strcpy(host, buf);

  Atom2Asciz(GetAtom(PARG(10,8)), buf);
  if (strlen(buf) >= MAX_ADDR_HOST_ORIGIN_SIZE)
    YIELD(FAIL);
  strcpy(origin, buf);

  Atom2Asciz(GetAtom(PARG(10,2)), sub_protocol);

  psd = ws_connect(timeout, context, sub_protocol, addr, port, ssl, path, host, origin, IETF_Version);
  if (psd == 0)
    YIELD(FAIL);
  else {
    YIELD(UnifyInt(PARG(10,9), (BASEINT )psd) != 0 ? DET_SUCC : FAIL);
  }
}

/* ?- ws_close(+SESSION). */
extern pred P1_ws_close(Frame *Env)
{
  PER_SESSION_DATA* psd;
  int r;

  ALL_BEGIN(Env);

  psd = (PER_SESSION_DATA* )GetInt(PARG(1,0));
  r = ws_close(psd);
  if (r != 0)
    YIELD(FAIL);
  else
    YIELD(DET_SUCC);
}

/* ?- ws_is_close(+SESSION, +TIMEOUT). */
extern pred P2_ws_is_close(Frame *Env)
{
  PER_SESSION_DATA* psd;
  int r;
  int timeout;

  ALL_BEGIN(Env);

  timeout = GetInt(PARG(2,0));
  psd = (PER_SESSION_DATA* )GetInt(PARG(2,0));

  r = ws_is_close(psd, timeout);
  YIELD(r != 0 ? DET_SUCC : FAIL);
}



/* ?- ws_read(+Timeout, +SESSION, -DATA_ATOM). */
extern pred P3_ws_read_text(Frame *Env)
{
  int timeout;
  PER_SESSION_DATA* psd;
  char buf[AZ_MAX_ATOM_LENGTH];
  int r;

  ALL_BEGIN(Env);

  timeout = GetInt(PARG(3,0));
  psd = (PER_SESSION_DATA* )GetInt(PARG(3,1));

  r = ws_read(timeout, psd, buf, sizeof(buf));
  //fprintf(stderr, "ws_read: %d\r\n", r);
  if (r < 0)
    YIELD(FAIL);
  else if (r == 0) // timeout
    YIELD(FAIL);
  else
    YIELD(unify_atom(PARG(3,2), PutAtom(Env, buf)) != 0 ? DET_SUCC : FAIL);
}

/* ?-ws_write_text(+SESSION, +DATA_ATOM). */
extern pred P2_ws_write_text(Frame *Env)
{
  int r;
  char s[AZ_MAX_ATOM_LENGTH];

  ALL_BEGIN(Env);

  PER_SESSION_DATA* ps = (PER_SESSION_DATA* )GetInt(PARG(2,0));
  Atom2Asciz(GetAtom(PARG(2,1)), s);

  r = ws_write_text(ps, s, strlen(s));
  if (r != 0)
    YIELD(FAIL);
  else
	YIELD(DET_SUCC);
}

/* ?-ws_write_pong(+SESSION). */
extern pred P1_ws_write_pong(Frame *Env)
{
  int r;

  ALL_BEGIN(Env);

  PER_SESSION_DATA* ps = (PER_SESSION_DATA* )GetInt(PARG(1,0));

  r = ws_write_pong(ps, NULL, 0);
  if (r != 0)
    YIELD(FAIL);
  else
	YIELD(DET_SUCC);
}

/* ?-ws_sub_protocol(+SESSION, -SUB_PROTOCOL). */
extern pred P2_ws_sub_protocol(Frame *Env)
{
  const char* name;

  ALL_BEGIN(Env);

  PER_SESSION_DATA* ps = (PER_SESSION_DATA* )GetInt(PARG(2,0));

  name = ws_session_protocol(ps);
  if (name == NULL) {
    char s[2];
    s[0] = '\0';
    YIELD(unify_atom(PARG(2,1), PutAtom(Env, s)) != 0 ? DET_SUCC : FAIL);
  }
  else {
    YIELD(unify_atom(PARG(2,1), PutAtom(Env, (char* )name)) != 0 ? DET_SUCC : FAIL);
  }
}


/* ?- ws_read_list(+Timeout, +SESSION, -DATA_LIST). */
extern pred P3_ws_read_list(Frame *Env)
{
  int timeout;
  PER_SESSION_DATA* psd;
  char *p;
  int r;

  ALL_BEGIN(Env);

  timeout = GetInt(PARG(3, 0));
  psd = (PER_SESSION_DATA* )GetInt(PARG(3, 1));

  r = ws_read_ready(timeout, psd, (void** )&p);
  if (r < 0)
    YIELD(FAIL);
  else if (r == 0) // timeout
    YIELD(FAIL);
  else {
    int rec_size, gvar_size, count = 0;
    TERM *List_top;
    unsigned char dum_int;

    rec_size = r;
    gvar_size = (BASEINT )(gvar_bottom - next_gvar_cell)/2;	
    if (gvar_size < rec_size) {
      P0_s_greclaim(Env);
      gvar_size = (BASEINT)(gvar_bottom - next_gvar_cell)/2;	
      if (gvar_size < rec_size) YIELD(FAIL);
    }

    List_top = next_gvar_cell;
    while (rec_size--) {
      SETTAG(next_gvar_cell, list_tag);
      BODY(next_gvar_cell) = next_gvar_cell+1;
      next_gvar_cell++;
      dum_int = p[count++];
      PUTINT(dum_int, next_gvar_cell);
      next_gvar_cell++;
    }
    SETTAG(next_gvar_cell, atom_tag);
    INT_BODY(next_gvar_cell++) = ATOM_NIL;

    ws_read_finish(psd);

    YIELD(unify(List_top, PARG(3, 2)) != 0 ? DET_SUCC : FAIL);
  }
}

/* ?- ws_write_atom_list(+SESSION, +DATA_ATOM_LIST). */
pred P2_ws_write_atom_list(Frame *Env)
{
  PER_SESSION_DATA* psd;
  TERM *alist, *my_car;
  int list_len;
  int total_len;
  int r, n;
  char *buf, *p;

  ALL_BEGIN(Env);

  psd = (PER_SESSION_DATA* )GetInt(PARG(2, 0));
  alist = PARG(2, 1);

  list_len = az_list_len(alist);
  if (list_len <= 0)
    EMPTY_WRITE_SUCC_OR_FAIL;

  buf = (char* )malloc(AZ_MAX_ATOM_LENGTH * list_len + 1);
  if (buf == 0) {
    YIELD(FAIL);
  }

  p = buf;
  total_len = 0;
  while (TRUE) {
    REALVALUE(alist);
    if (TAG(alist) == list_tag || TAG(alist) == glist_tag) {
      alist = my_car = BODY(alist);
      alist++;

      Atom2Asciz(GetAtom(my_car), p);
      n = strlen(p);
      p += n;
      total_len += n;
    }
    else
      break;
  }		
  buf[total_len] = '\0';

  if (total_len > 0) {
    r = ws_write_text(psd, buf, total_len);
    free(buf);
    if (r != 0)
      YIELD(FAIL);
    else
      YIELD(DET_SUCC);
  }
  else {
    free(buf);
    EMPTY_WRITE_SUCC_OR_FAIL;
  }
}

/* ?- ws_write_list_binary(+SESSION, +DATA_LIST). */
pred P2_ws_write_list_binary(Frame *Env)
{
  PER_SESSION_DATA* psd;
  TERM *list, *my_car;
  int list_len;
  int total_len;
  int r, c;
  unsigned char *buf, *p;

  ALL_BEGIN(Env);

  psd = (PER_SESSION_DATA* )GetInt(PARG(2, 0));
  list = PARG(2, 1);

  list_len = az_list_len(list);
  if (list_len <= 0)
    EMPTY_WRITE_SUCC_OR_FAIL;

  buf = (unsigned char* )malloc(list_len + 1);
  if (buf == 0) {
    YIELD(FAIL);
  }

  p = buf;
  while (TRUE) {
    REALVALUE(list);
    if (TAG(list) == list_tag || TAG(list) == glist_tag) {
      list = my_car = BODY(list);
      list++;

      c = GetInt(my_car);
      if (c < 0 || c >= 256) {
        YIELD(FAIL);
      }

      *p++ = (unsigned char )c;
    }
    else
      break;
  }		

  total_len = (int )((intptr_t )p - (intptr_t )buf);
  buf[total_len] = '\0';

  if (total_len > 0) {
    r = ws_write_binary(psd, buf, total_len);
    free(buf);
    if (r != 0)
      YIELD(FAIL);
    else
      YIELD(DET_SUCC);
  }
  else {
    free(buf);
    EMPTY_WRITE_SUCC_OR_FAIL;
  }
}

/* ?-ws_version(-VERSION). */
extern pred
P1_ws_version(Frame *Env)
{
  ALL_BEGIN(Env);

  if (UnifyAtom(PARG(1,0), WEBSOCK_VERSION_ATOM) == 0)
    YIELD(FAIL);

	YIELD(DET_SUCC);
}


#ifdef SUPPORT_WS_SERVER_API

#include "server_side.h"

/* ?-ws_create_server_context(+SUB_PROTOCOLS, +PORT, +CERT_PATH, +KEY_PATH,
   +DEFAULT_SUB_PROTOCOL, -CONTEXT). */
extern pred P6_ws_create_server_context(Frame *Env)
{
  int r, i;
  int port;
  int sub_protocol_num;
  int default_sub_protocol;
  struct libwebsocket_context* context;
  const char sub_protocols[MAX_SUB_PROTOCOL_NUM][WS_SUB_PROTOCOL_NAME_MAX_SIZE];
  char cert_path[PATH_MAX];
  char key_path[PATH_MAX];
  TERM* arg;

  ALL_BEGIN(Env);

  arg = PARG(6,0);
  sub_protocol_num = az_list_len(arg);
  if (sub_protocol_num > MAX_SUB_PROTOCOL_NUM || sub_protocol_num <= 0)
    AZ_ERROR(9);

  i = 0;
  while (TRUE) {
    REALVALUE(arg);
    if (! IS_LIST(arg)) break;

    arg = BODY(arg);
    Atom2Asciz(GetAtom(arg), sub_protocols[i++]);
    arg++;
  }		

  default_sub_protocol = GetInt(PARG(6,1));
  port = GetInt(PARG(6,2));
  Atom2Asciz(GetAtom(PARG(6,3)), cert_path);
  Atom2Asciz(GetAtom(PARG(6,4)), key_path);
  r = ws_create_server_context(sub_protocol_num, sub_protocols, port,
                               cert_path, key_path,
                               default_sub_protocol, &context);

  if (r != 0)
    YIELD(FAIL);
  else
    YIELD(UnifyInt(PARG(6,5), (BASEINT )context) != 0 ? DET_SUCC : FAIL);
}

/* ?-ws_delete_server_context(+CONTEXT). */
extern pred P1_ws_delete_server_context(Frame *Env)
{
  int r;
  struct libwebsocket_context* context;

  ALL_BEGIN(Env);

  context = (struct libwebsocket_context* )GetInt(PARG(1,0));

  r =  ws_delete_server_context(context);
  if (r != 0)
    YIELD(FAIL);
  else
	YIELD(DET_SUCC);
}

/* ?-ws_service(+TIMEOUT, +CONTEXT). */
extern pred P4_ws_service(Frame *Env)
{
  int r;
  int timeout;
  struct libwebsocket_context* context;
  struct libwebsocket_service_result_info info;

  ALL_BEGIN(Env);

  timeout = GetInt(PARG(4,0));
  context = (struct libwebsocket_context* )GetInt(PARG(4,1));

  r = ws_service(timeout, context, &info);
  if (r < 0) {
    YIELD(unify_atom(PARG(4,2), ATOM_FAIL) != 0 ? DET_SUCC : FAIL);
  }
  else if (r == LWS_SERVICE_RETURN_NO_SOCK) {
    YIELD(unify_atom(PARG(4,2), ATOM_NO_SOCKET) != 0 ? DET_SUCC : FAIL);
  }
  else if (r == LWS_SERVICE_RETURN_PARENT) {
    /* parent child relation is removed.
       return 0, is not child process id. */
    /* info.num: child process id */
    r = UnifyInt(PARG(4,3), (BASEINT )info.num);
    if (r == 0) YIELD(FAIL);
    YIELD(unify_atom(PARG(4,2), ATOM_FORK_PARENT) != 0 ? DET_SUCC : FAIL);
  }
  else if (r == LWS_SERVICE_RETURN_CHILD) {
    /* info.p: NEW SESSION */
    r = UnifyInt(PARG(4,3), (BASEINT )info.p);
    if (r == 0) YIELD(FAIL);
    YIELD(unify_atom(PARG(4,2), ATOM_FORK_CHILD) != 0 ? DET_SUCC : FAIL);
  }
  else {
    YIELD(unify_atom(PARG(4,2), ATOM_NORMAL) != 0 ? DET_SUCC : FAIL);
  }
}

#endif /* SUPPORT_WS_SERVER_API */
