<?xml?>
<!--
    GSL/sock - Socket class

    Copyright (c) 1996-2010 iMatix Corporation

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 3 of the License, or (at
    your option) any later version.

    This program is distributed in the hope that it will be useful, but
    WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    General Public License for more details.

    For information on alternative licensing for OEMs, please contact
    iMatix Corporation.
-->

<gxl script = "ggobjt.gsl" filename = "ggsock" title = "GSL/socket package" >

<startup>
    declare_smtlib_shutdown       (shutdown_event,      0);

    declare_smtsock_readh_ok      (readh_ok_event,      0);
    declare_smtsock_readh_closed  (readh_closed_event,  0);
    declare_smtsock_readh_timeout (readh_timeout_event, 0);

    declare_smtsock_connect_ok    (connect_ok_event,    0);

    declare_smtsock_ok            (ok_event,      0);
    declare_smtsock_closed        (closed_event,  0);
    declare_smtsock_timeout       (timeout_event, 0);
    declare_smtsock_error         (error_event,   0);
</startup>

<dialog>
After-Init:
    (--) Ok                                 -> Waiting
          +

Waiting:
    (--) Ok                                 ->
          + Reply-Ok-Result
          + Terminate-The-Thread
    (--) Error                              ->
          + Reply-Error-Result
          + Terminate-The-Thread
    (--) Closed                             ->
          + Reply-Closed-Result
          + Terminate-The-Thread
    (--) Timeout                            ->
          + Reply-Timeout-Result
          + Terminate-The-Thread
    (--) Connect-Ok                         ->
          + Reply-Connect-Ok-Result
          + Terminate-The-Thread
    (--) Readh-Ok                           ->
          + Reply-Readh-Ok-Result
          + Terminate-The-Thread
    (--) Readh-Closed                       ->
          + Reply-Readh-Closed-Result
          + Terminate-The-Thread
    (--) Readh-Timeout                      ->
          + Reply-Readh-Timeout-Result
          + Terminate-The-Thread
    (--) Shutdown                           ->
          + Terminate-The-Thread
</dialog>

<extra>
typedef struct {
    int
        links;
    char
        *error_msg;
} SOCK_CONTEXT;

typedef struct {
    int
        links;
    sock_t
        handle;
    char
        *error_msg;
} SOCK_HANDLE_ITEM;

typedef struct {
    THREAD
        *gsl_thread;
    RESULT_NODE
        *result,
        *buffer,
        *error;
    SOCK_HANDLE_ITEM
        *sock_handle;
    SOCK_CONTEXT
        *context;
    sock_t
        handle;
} TCB;

static TCB
    *tcb;                               /*  Address thread context block     */

static QUEUE
    *sockq = NULL;

#define QUEUE_LENGTH     10

#define SOCKET_CLOSED_MESSAGE "Socket closed"
#define TIMED_OUT_MESSAGE     "Request timed out"

static int
start_socket_agent (void)
{
    THREAD
        *thread;

    if (! sockq)
      {
        if (agent_lookup (SMT_SOCKET) == NULL)
            smtsock_init ();
        if ( (thread = thread_lookup (SMT_SOCKET, "")) != NULL )
            sockq = thread-> queue;
        else
          {
            strcpy (object_error, "Unable to start SOCK agent.");
            return -1;
          }
      }
    return 0;
}

static int
store_module_error (THREAD       *gsl_thread,
                    SOCK_CONTEXT *context,
                    RESULT_NODE  *error,
                    const char   *error_msg,
                          char   **error_text)
{
    GGCODE_TCB
        *gsl_tcb = gsl_thread-> tcb;
    VALUE
        value;

    if (error_msg)
      {
        if (! context)
            context = get_class_item (gsl_thread, SOCK_NAME);
        mem_free (context-> error_msg);
        context-> error_msg = memt_strdup (NULL, error_msg);

        if (error)
          {
            init_value (& value);
            assign_string (& value, context-> error_msg);
            if (! store_symbol_definition (& gsl_tcb-> scope_stack,
                                           gsl_tcb-> gsl-> ignorecase,
                                           error,
                                           &value,
                                           error_text))
                return -1;
          }
      }
    return 0;
}

static int
store_sock_error (SOCK_HANDLE_ITEM *sock_handle,
                  THREAD           *gsl_thread,
                  SOCK_CONTEXT     *context,
                  RESULT_NODE      *error,
                  const char       *error_msg,
                        char      **error_text)
{
    if (error_msg && sock_handle)
      {
        mem_free (sock_handle-> error_msg);
        sock_handle-> error_msg = memt_strdup (NULL, error_msg);
      }
    return store_module_error (gsl_thread, context, error,
                               error_msg, error_text);
}

static void
reply_readh_result (byte *body, char *error_msg)
{
    struct_smtsock_readh_reply
        *readh_reply;
    GGCODE_TCB
        *gsl_tcb = tcb-> gsl_thread-> tcb;
    VALUE
        value;
    char
        *error_text;

    /*  Pick up read value  */
    get_smtsock_readh_reply (body, & readh_reply);
    init_value (& value);
    if (readh_reply-> size > 0)
      {
        assign_string (& value, memt_alloc (NULL, readh_reply-> size + 1));
        memcpy (value. s, readh_reply-> data, readh_reply-> size);
        value. s [readh_reply-> size] = '\0';
      }
    /*  Store the value  */
    if (! store_symbol_definition (& gsl_tcb-> scope_stack,
                                   gsl_tcb-> gsl-> ignorecase,
                                   tcb-> buffer,
                                   &value,
                                   &error_text))
      {
        lsend_ggcode_call_error (& tcb-> gsl_thread-> queue-> qid, NULL,
                                 NULL, NULL, NULL, 0,
                                 NULL, 0,
                                 error_text);
        return;
      }
    destroy_value (& value);

    /*  Build return value  */
    assign_number (& tcb-> result-> value, readh_reply-> size);

    free_smtsock_readh_reply (& readh_reply);

    if (store_sock_error (tcb-> sock_handle,
                          tcb-> gsl_thread,
                          tcb-> context,
                          tcb-> error,
                          error_msg,
                          &error_text))
        lsend_ggcode_call_error (& tcb-> gsl_thread-> queue-> qid, NULL,
                                 NULL, NULL, NULL, 0,
                                 NULL, 0,
                                 error_text);
    else
        lsend_ggcode_call_ok (& tcb-> gsl_thread-> queue-> qid, NULL,
                              NULL, NULL, NULL, 0);
}

/*************************   INITIALISE THE THREAD   *************************/

MODULE initialise_the_thread (THREAD *thread)
{
    tcb = thread-> tcb;                 /*  Point to thread's context        */
    the_next_event = ok_event;
}


/****************************   REPLY OK RESULT   ****************************/

MODULE reply_ok_result (THREAD *thread)
{
    SOCK_HANDLE_ITEM
        *socket;
    char
        *error_text;
    int
        rc;

    tcb = thread-> tcb;                 /*  Point to thread's context        */

    /*  We rely here on tcb-> handle being the master socket for an accept   */
    /*  and zero for any other request.                                      */
    if (tcb-> handle)
      {
        socket = memt_alloc (NULL, sizeof (SOCK_HANDLE_ITEM));
        socket-> links     = 0;
        socket-> handle    = accept_socket (tcb-> handle);
        socket-> error_msg = NULL;

        assign_pointer (& tcb-> result-> value, & sock_handle_class, socket);
      }

    if (tcb-> sock_handle)
        rc = store_sock_error (tcb-> sock_handle,
                               tcb-> gsl_thread,
                               tcb-> context,
                               tcb-> error,
                               NULL,
                               &error_text);
    else
        rc = store_module_error (tcb-> gsl_thread,
                                 tcb-> context,
                                 tcb-> error,
                                 NULL,
                                 &error_text);

    if (rc)
        lsend_ggcode_call_error (& tcb-> gsl_thread-> queue-> qid, NULL,
                                 NULL, NULL, NULL, 0,
                                 NULL, 0,
                                 error_text);
    else
        lsend_ggcode_call_ok (& tcb-> gsl_thread-> queue-> qid, NULL,
                              NULL, NULL, NULL, 0);
}


/**************************   TERMINATE THE THREAD   *************************/

MODULE terminate_the_thread (THREAD *thread)
{
    tcb = thread-> tcb;                 /*  Point to thread's context        */

    the_next_event = terminate_event;
}


/***************************   REPLY ERROR RESULT   **************************/

MODULE reply_error_result (THREAD *thread)
{
    struct_smtsock_error
        *error_reply;
    char
        *error_text;
   int
        rc;

    tcb = thread-> tcb;                 /*  Point to thread's context        */

    get_smtsock_error (thread-> event-> body, & error_reply);

    if (tcb-> sock_handle)
        rc = store_sock_error (tcb-> sock_handle,
                               tcb-> gsl_thread,
                               tcb-> context,
                               tcb-> error,
                               error_reply-> message,
                               &error_text);
    else
        rc = store_module_error (tcb-> gsl_thread,
                                 tcb-> context,
                                 tcb-> error,
                                 error_reply-> message,
                                 &error_text);

    free_smtsock_error (& error_reply);

    if (rc)
        lsend_ggcode_call_error (& tcb-> gsl_thread-> queue-> qid, NULL,
                                 NULL, NULL, NULL, 0,
                                 NULL, 0,
                                 error_text);
    else
        lsend_ggcode_call_ok (& tcb-> gsl_thread-> queue-> qid, NULL,
                              NULL, NULL, NULL, 0);
}


/**************************   REPLY CLOSED RESULT   **************************/

MODULE reply_closed_result (THREAD *thread)
{
    char
        *error_text;

    tcb = thread-> tcb;                 /*  Point to thread's context        */

    if (store_sock_error (tcb-> sock_handle,
                          tcb-> gsl_thread,
                          tcb-> context,
                          tcb-> error,
                          SOCKET_CLOSED_MESSAGE,
                          &error_text))
        lsend_ggcode_call_error (& tcb-> gsl_thread-> queue-> qid, NULL,
                                 NULL, NULL, NULL, 0,
                                 NULL, 0,
                                 error_text);
    else
        lsend_ggcode_call_ok (& tcb-> gsl_thread-> queue-> qid, NULL,
                              NULL, NULL, NULL, 0);
}


/**************************   REPLY TIMEOUT RESULT   *************************/

MODULE reply_timeout_result (THREAD *thread)
{
    char
        *error_text;

    tcb = thread-> tcb;                 /*  Point to thread's context        */

    if (store_sock_error (tcb-> sock_handle,
                          tcb-> gsl_thread,
                          tcb-> context,
                          tcb-> error,
                          TIMED_OUT_MESSAGE,
                          &error_text))
        lsend_ggcode_call_error (& tcb-> gsl_thread-> queue-> qid, NULL,
                                 NULL, NULL, NULL, 0,
                                 NULL, 0,
                                 error_text);
    else
        lsend_ggcode_call_ok (& tcb-> gsl_thread-> queue-> qid, NULL,
                              NULL, NULL, NULL, 0);
}


/************************   REPLY CONNECT OK RESULT   ************************/

MODULE reply_connect_ok_result (THREAD *thread)
{
    struct_smtsock_connect_ok
        *connect_reply;
    SOCK_HANDLE_ITEM
        *socket;
    char
        *error_text;

    tcb = thread-> tcb;                 /*  Point to thread's context        */

    get_smtsock_connect_ok (thread-> event-> body, & connect_reply);

    socket = memt_alloc (NULL, sizeof (SOCK_HANDLE_ITEM));
    socket-> links     = 0;
    socket-> handle    = connect_reply-> socket;
    socket-> error_msg = NULL;

    assign_pointer (& tcb-> result-> value, & sock_handle_class, socket);

    free_smtsock_connect_ok (& connect_reply);

    if (store_module_error (tcb-> gsl_thread,
                            tcb-> context,
                            tcb-> error,
                            NULL,
                            &error_text))
        lsend_ggcode_call_error (& tcb-> gsl_thread-> queue-> qid, NULL,
                                 NULL, NULL, NULL, 0,
                                 NULL, 0,
                                 error_text);
    else
        lsend_ggcode_call_ok (& tcb-> gsl_thread-> queue-> qid, NULL,
                              NULL, NULL, NULL, 0);
}


/*************************   REPLY READH OK RESULT   *************************/

MODULE reply_readh_ok_result (THREAD *thread)
{
    tcb = thread-> tcb;                 /*  Point to thread's context        */

    reply_readh_result (thread-> event-> body, NULL);
}


/***********************   REPLY READH CLOSED RESULT   ***********************/

MODULE reply_readh_closed_result (THREAD *thread)
{
    tcb = thread-> tcb;                 /*  Point to thread's context        */

    reply_readh_result (thread-> event-> body, SOCKET_CLOSED_MESSAGE);
}


/***********************   REPLY READH TIMEOUT RESULT   **********************/

MODULE reply_readh_timeout_result (THREAD *thread)
{
    tcb = thread-> tcb;                 /*  Point to thread's context        */

    reply_readh_result (thread-> event-> body, TIMED_OUT_MESSAGE);
}

</extra>

<!-- Socket Class ---------------------------------------------------------->

<class name = "sock" title = "Socket" register = "1" >

    <initialise>
  {
    SOCK_CONTEXT
        *context;

    context = memt_alloc (NULL, sizeof (SOCK_CONTEXT));
    context-> links     = 0;
    context-> error_msg = NULL;

    *item = context;
  }
    </initialise>

    <operation type="link">
((SOCK_CONTEXT *) item)-> links++;
return 0;
    </operation>

    <operation type="destroy">
  {
    SOCK_CONTEXT
        *context = item;

    if (--context-> links == 0)
      {
        mem_free (context-> error_msg);
        mem_free (context);
      }
    return 0;
  }
    </operation>

    <operation type="get_attr">
        <start>
    SOCK_CONTEXT
        *context = item;
    static VALUE
        value;

    if (! name)
        return NULL;

    init_value (& value);
        </start>
        <attr name="error" >
        if (context-> error_msg)
            assign_string (& value, context-> error_msg);
        </attr>
        <finish>
    return & value;
        </finish>
    </operation>

    <!-------------------------------------------------------------------------->

    <function name = "passive" >
        <parameter name = "service"    pass = "value"       compulsory = "1" />
        <parameter name = "error"      pass = "reference"   compulsory = "0" />
        <body>
  {
    SOCK_HANDLE_ITEM
        *socket;
    sock_t
        handle;
    SOCK_CONTEXT
        *context = item;
    const char
        *error_msg;
    char
        *error_text;

    if (start_socket_agent ())
        return -1;

    handle = passive_TCP (string_value (& service-> value),
                          QUEUE_LENGTH);
    if (handle != INVALID_SOCKET)       /*  Success  */
      {
        socket = memt_alloc (NULL, sizeof (SOCK_HANDLE_ITEM));
        socket-> links     = 0;
        socket-> handle    = handle;
        socket-> error_msg = NULL;

        assign_pointer (& result-> value, & sock_handle_class, socket);

        error_msg = NULL;
      }
    else
        error_msg = connect_errlist [connect_error ()];

    if (store_module_error (gsl_thread,
                            context,
                            error,
                            error_msg,
                            &error_text))

      {
        strncpy (object_error, error_text, LINE_MAX);
        return -1;
      }
    else
        return 0;
  }
        </body>
    </function>

    <function name = "connect" immediate = "0" >
        <parameter name = "host"       pass = "value"       compulsory = "0" />
        <parameter name = "service"    pass = "value"       compulsory = "1" />
        <parameter name = "timeout"    pass = "value"       compulsory = "0" />
        <parameter name = "error"      pass = "reference"   compulsory = "0" />
        <body>
  {
    THREAD
        *thread;

    if (start_socket_agent ())
        return -1;

    thread = thread_create (AGENT_NAME, "");
    tcb = thread-> tcb;

    tcb-> gsl_thread  = gsl_thread;
    tcb-> result      = result;
    tcb-> buffer      = NULL;
    tcb-> error       = error;
    tcb-> sock_handle = NULL;
    tcb-> context     = item;
    tcb-> handle      = 0;

    lsend_smtsock_connect (& sockq-> qid,
                           & thread-> queue-> qid,
                           NULL, NULL, NULL, 0,
                           (word) (timeout ? number_value (& timeout-> value) : 0),
                           "tcp",
                           host ? string_value (& host-> value) : "",
                           string_value (& service-> value),
                           0, 0, 0);
    return 0;
  }
        </body>
    </function>

<!-------------------------------------------------------------------------->

</class>

<class name = "sock handle" title = "Socket handle" register = "0" >

    <operation type="link">
    if (item)
        ((SOCK_HANDLE_ITEM *) item)-> links++;
    return 0;
    </operation>

    <operation type="destroy">
    SOCK_HANDLE_ITEM
        *socket = item;

    if (socket
    &&  --socket-> links &lt;= 0)
      {
        mem_free (socket-> error_msg);
        mem_free (socket);
      }
    return 0;
    </operation>

    <operation type="get_attr">
        <start>
    SOCK_HANDLE_ITEM
        *socket = item;
    static VALUE
        value;

    if (! name)
        return NULL;

    init_value (& value);
        </start>
        <attr name = "error" >
        if (socket-> error_msg)
            assign_string (& value, socket-> error_msg);
        </attr>
        <finish>
    return & value;
        </finish>
    </operation>

<!-------------------------------------------------------------------------->

    <function name = "accept" immediate = "0" >
        <parameter name = "timeout"    pass = "value"       compulsory = "0" />
        <parameter name = "error"      pass = "reference"   compulsory = "0" />
        <body>
  {
    SOCK_HANDLE_ITEM
        *socket = item;
    THREAD
        *thread;

    if (start_socket_agent ())
        return -1;

    thread = thread_create (AGENT_NAME, "");
    tcb = thread-> tcb;

    tcb-> gsl_thread  = gsl_thread;
    tcb-> result      = result;
    tcb-> buffer      = NULL;
    tcb-> error       = error;
    tcb-> sock_handle = socket;
    tcb-> context     = NULL;
    tcb-> handle      = socket-> handle;

    lsend_smtsock_input (& sockq-> qid,
                         & thread-> queue-> qid,
                         NULL, NULL, NULL, 0,
                         (word) (timeout ? number_value (& timeout-> value) : 0),
                         socket-> handle,
                         0);

    return 0;
  }
        </body>
    </function>

    <function name = "close" immediate = "0" >
        <parameter name = "timeout"    pass = "value"       compulsory = "0" />
        <parameter name = "error"      pass = "reference"   compulsory = "0" />
        <body>
  {
    SOCK_HANDLE_ITEM
        *socket = item;
    THREAD
        *thread;

    if (start_socket_agent ())
        return -1;

    thread = thread_create (AGENT_NAME, "");
    tcb = thread-> tcb;

    tcb-> gsl_thread  = gsl_thread;
    tcb-> result      = result;
    tcb-> buffer      = NULL;
    tcb-> error       = error;
    tcb-> sock_handle = socket;
    tcb-> context     = NULL;
    tcb-> handle      = 0;

    lsend_smtsock_close (& sockq-> qid,
                         & thread-> queue-> qid,
                         NULL, NULL, NULL, 0,
                         (word) (timeout ? number_value (& timeout-> value) : 0),
                         socket-> handle,
                         TRUE,
                         0);

    return 0;
  }
        </body>
    </function>

    <function name = "read" immediate = "0" >
        <parameter name = "buffer"     pass = "reference"   compulsory = "1" />
        <parameter name = "minimum"    pass = "value"       compulsory = "0" />
        <parameter name = "timeout"    pass = "value"       compulsory = "0" />
        <parameter name = "error"      pass = "reference"   compulsory = "0" />
        <body>
  {
    SOCK_HANDLE_ITEM
        *socket = item;
    THREAD  
        *thread;

    if (start_socket_agent ())
        return -1;

    thread = thread_create (AGENT_NAME, "");
    tcb = thread-> tcb;

    tcb-> gsl_thread  = gsl_thread;
    tcb-> result      = result;
    tcb-> buffer      = buffer;
    tcb-> error       = error;
    tcb-> sock_handle = socket;
    tcb-> context     = NULL;
    tcb-> handle      = 0;

    lsend_smtsock_readh (& sockq-> qid,
                         & thread-> queue-> qid,
                         NULL, NULL, NULL, 0,
                         (word) (timeout ? number_value (&timeout-> value): 0),
                         socket-> handle,
                         (dbyte) 0xFFFF,                   /*  Maximum */
                         minimum ? (word) number_value (& minimum-> value) : 1,
                         0);

    return 0;
  }
        </body>
    </function>

    <function name = "write" immediate = "0" >
        <parameter name = "buffer"     pass = "value"       compulsory = "1" />
        <parameter name = "timeout"    pass = "value"       compulsory = "0" />
        <parameter name = "error"      pass = "reference"   compulsory = "0" />
        <body>
  {
    SOCK_HANDLE_ITEM
        *socket = item;
    THREAD  
        *thread;

    if (start_socket_agent ())
        return -1;

    thread = thread_create (AGENT_NAME, "");
    tcb = thread-> tcb;

    tcb-> gsl_thread  = gsl_thread;
    tcb-> result      = result;
    tcb-> buffer      = NULL;
    tcb-> error       = error;
    tcb-> sock_handle = socket;
    tcb-> context     = NULL;
    tcb-> handle      = 0;

    lsend_smtsock_writeh (& sockq-> qid,
                          & thread-> queue-> qid,
                          NULL, NULL, NULL, 0,
                          (word) (timeout ? number_value (& timeout-> value) : 0),
                          socket-> handle,
                          (qbyte) strlen (string_value (& buffer-> value)),
                          (byte *) buffer-> value. s,
                          TRUE,
                          0);
    return 0;
  }
        </body>
    </function>

</class>

</gxl>
