Initial revision

[jog] / rxglue.c

/* -*-c-*-
 *
 * $Id: rxglue.c,v 1.1 2002/01/25 19:34:45 mdw Exp $
 *
 * REXX glue for C core functionality
 *
 * (c) 2001 Mark Wooding
 */

/*----- Licensing notice --------------------------------------------------* 
 *
 * This file is part of Jog: Programming for a jogging machine.
 *
 * Jog 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 2 of the License, or
 * (at your option) any later version.
 * 
 * Jog 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.
 * 
 * You should have received a copy of the GNU General Public License
 * along with Jog; if not, write to the Free Software Foundation,
 * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 */

/*----- Revision history --------------------------------------------------* 
 *
 * $Log: rxglue.c,v $
 * Revision 1.1  2002/01/25 19:34:45  mdw
 * Initial revision
 *
 */

/*----- Header files ------------------------------------------------------*/

#ifdef HAVE_CONFIG_H
#  include "config.h"
#endif

#include <ctype.h>
#include <errno.h>
#include <limits.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>

#include <sys/types.h>
#include <sys/time.h>
#include <unistd.h>

#define INCL_RXFUNC
#define RX_STRONGTYPING
#include <rexxsaa.h>

#include <mLib/alloc.h>
#include <mLib/dstr.h>

#include "err.h"
#include "rxglue.h"
#include "txport.h"

/*----- Static variables --------------------------------------------------*/

static txport *tx = 0;

/*----- Conversion functions ----------------------------------------------*/

/* --- @rxs_putm@ --- *
 *
 * Arguments:	@RXSTRING *x@ = pointer to REXX string structure
 *		For @rxs_putm@:
 *		  @const void *p@ = pointer to data block
 *		  @size_t sz@ = size of data
 *		For @rxs_putd@:
 *		  @const dstr *d@ = pointer to source string
 *		For @rxs_putf@ and @rxs_vputf@:
 *		  @const char *m@ = message format string
 *
 * Returns:	---
 *
 * Use:		Stashes some text in an @RXSTRING@, overwriting	whatever was
 *		there before.  We assume that the previous contents don't
 *		require freeing.
 */

#define RXS_PUTM(x, p, sz) do {						\
  RXSTRING *_x = (x);							\
  const void *_p = (p);							\
  size_t _sz = (sz);							\
  if (!_x->strptr || _x->strlength < _sz)				\
    _x->strptr = xmalloc(_sz);						\
  memcpy(_x->strptr, _p, _sz);						\
  _x->strlength = _sz;							\
} while (0)

static void rxs_putm(RXSTRING *x, const void *p, size_t sz)
{
  RXS_PUTM(x, p, sz);
}

#define RXS_PUTD(x, d) do {						\
  dstr *_d = (d);							\
  RXS_PUTM((x), _d->buf, _d->len);					\
} while (0)

static void rxs_putd(RXSTRING *x, dstr *d) { RXS_PUTD(x, d); }

static void rxs_vputf(RXSTRING *x, const char *m, va_list *ap)
{
  dstr d = DSTR_INIT;
  dstr_vputf(&d, m, ap);
  RXS_PUTD(x, &d);
  DDESTROY(&d);
}

static void rxs_putf(RXSTRING *x, const char *m, ...)
{
  va_list ap;
  dstr d = DSTR_INIT;
  va_start(ap, m);
  dstr_vputf(&d, m, &ap);
  RXS_PUTD(x, &d);
  va_end(ap);
  DDESTROY(&d);
}

/* --- @rxs_get@ --- *
 *
 * Arguments:	@const RXSTRING *x@ = pointer to a REXX string
 *		@dstr *d@ = where to put it
 *
 * Returns:	---
 *
 * Use:		Pulls a REXX string out and puts it in a dynamic string.
 */

#define RXS_GET(x, d) do {						\
  const RXSTRING *_x = (x);						\
  dstr *_dd = (d);							\
  DPUTM(_dd, _x->strptr, _x->strlength);				\
  DPUTZ(_dd);								\
} while (0)

static void rxs_get(const RXSTRING *x, dstr *d) { RXS_GET(x, d); }

/* --- @rxs_tol@ --- *
 *
 * Arguments:	@const RXSTRING *x@ = pointer to a REXX string
 *		@long *ii@ = where to put the answer
 *
 * Returns:	Zero on success, or nonzero on error.
 *
 * Use:		Fetches an integer from a REXX string.  This doesn't cope
 *		with multiprecision integers or similar silliness.
 */

static int rxs_tol(const RXSTRING *x, long *ii)
{
  long i = 0;
  const char *p = x->strptr, *l = p + x->strlength;
  unsigned f = 0;

#define f_neg 1u
#define f_ok 2u

#define MINR (LONG_MIN/10)
#define MIND (LONG_MIN%10)

  while (p < l && isspace((unsigned char)*p))
    p++;
  if (p >= l)
    return (-1);
  if (*p == '+')
    p++;
  else if (*p == '-') {
    f |= f_neg;
    p++;
  }
  while (p < l && isspace((unsigned char)*p))
    p++;
  while (p < l && isdigit((unsigned char)*p)) {
    int j = *p++ - '0';
    if (i < MINR || (i == MINR && -j < MIND))
      return (-1);
    i = (i * 10) - j;
    f |= f_ok;
  }
  while (p < l && isspace((unsigned char)*p))
    p++;
  if (p < l || !(f & f_ok))
    return (-1);
  if (!(f & f_neg)) {
    if (i < -LONG_MAX)
      return (-1);
    i = -i;
  }
  *ii = i;
  return (0);

#undef MINR
#undef MIND

#undef f_neg
#undef f_ok
}

/* --- @rxs_block@ --- *
 *
 * Arguments:	@const RXSTRING *x@ = a REXX string
 *		@unsigned long *t@ = where to put the block spec
 *
 * Returns:	Zero if OK, nonzero on error.
 *
 * Use:		Picks out a blockingness spec.
 */

static int rxs_block(const RXSTRING *x, unsigned long *t)
{
  long i;

  if (!x->strptr || x->strlength < 1)
    return (-1);
  switch (x->strptr[0]) {
    case 'f':
    case 'F':
      *t = FOREVER;
      break;
    default:
      if (rxs_tol(x, &i) || i < 0)
	return (-1);
      *t = i;
      break;
  }
  return (0);
}

/*----- REXX functions ----------------------------------------------------*/

static APIRET APIENTRY rxfn_test(unsigned char *fn, ULONG ac, RXSTRING *av,
				 char *sn, RXSTRING *r)
{
  ULONG i;

  printf("test entry\n"
	 "  fn = `%s'\n", fn);
  for (i = 0; i < ac; i++) {
    long l;

    printf("  av[%lu] = `", i);
    fwrite(av[i].strptr, 1, av[i].strlength, stdout);
    if (rxs_tol(&av[i], &l))
      printf("'\n");
    else
      printf("' (%ld)\n", l);
  }
  printf("tx = `%s'; f = `%s'; c = `%s'.", txname, txfile, txconf);
  rxs_putf(r, "function `%s' completed ok", fn);
  return (0);
}

/* --- @txname()@ ---
 *
 * Arguments:	---
 *
 * Returns:	The currently-selected transport name.
 */

static APIRET APIENTRY rxfn_txname(unsigned char *fn, ULONG ac, RXSTRING *av,
				   char *sn, RXSTRING *r)
{
  if (ac)
    return (-1);
  rxs_putf(r, "%s", txname);
  return (0);
}

/* --- @txfile()@ ---
 *
 * Arguments:	---
 *
 * Returns:	The currently-selected transport filename.
 */

static APIRET APIENTRY rxfn_txfile(unsigned char *fn, ULONG ac, RXSTRING *av,
				   char *sn, RXSTRING *r)
{
  if (ac)
    return (-1);
  rxs_putf(r, "%s", txfile ? txfile : "");
  return (0);
}

/* --- @txfile()@ ---
 *
 * Arguments:	---
 *
 * Returns:	The currently-selected transport configuration string.
 */

static APIRET APIENTRY rxfn_txconf(unsigned char *fn, ULONG ac, RXSTRING *av,
				   char *sn, RXSTRING *r)
{
  if (ac)
    return (-1);
  rxs_putf(r, "%s", txconf ? txconf : "");
  return (0);
}
  
/* --- @txinit([NAME], [FILE], [CONFIG])@ ---
 *
 * Arguments:	@NAME@ = transport name to select
 *		@FILE@ = transport filename
 *		@CONFIG@ = transport configuration string
 *
 * Returns:	---
 *
 * Use:		Initializes a transport using the given settings.  Omitted
 *		arguments are filled in from the command line, or internal
 *		defaults.
 */

static APIRET APIENTRY rxfn_txinit(unsigned char *fn, ULONG ac, RXSTRING *av,
				   char *sn, RXSTRING *r)
{
  const char *n = txname, *f = txfile, *c = txconf;
  dstr dn = DSTR_INIT, df = DSTR_INIT, dc = DSTR_INIT;

  if (tx)
    return (-1);
  if (ac > 3)
    return (-1);
  if (ac >= 1 && av[0].strptr) {
    rxs_get(&av[0], &dn);
    n = dn.buf;
  }
  if (ac >= 2 && av[1].strptr) {
    rxs_get(&av[1], &df);
    f = df.buf;
  }
  if (ac >= 3 && av[2].strptr) {
    rxs_get(&av[2], &dn);
    c = dc.buf;
  }
  tx = tx_create(n, f, c);
  dstr_destroy(&dn);
  dstr_destroy(&df);
  dstr_destroy(&dc);
  if (!tx)
    return (-1);
  return (0);
}

/* --- @txsend(STRING)@ --- *
 *
 * Arguments:	@STRING@ = string to send
 *
 * Returns:	---
 *
 * Use:		Sends a string (exactly as written) to the transport.
 */

static APIRET APIENTRY rxfn_txsend(unsigned char *fn, ULONG ac, RXSTRING *av,
				   char *sn, RXSTRING *r)
{
  if (ac != 1 || !tx || !av[0].strptr)
    return (-1);
  tx_write(tx, av[0].strptr, av[0].strlength);
  return (0);
}

/* --- @txrecv([MILLIS])@ --- *
 *
 * Arguments:	@MILLIS@ = how long (in milliseconds) to wait, or `forever'
 *
 * Returns:	The string read (may be null if nothing available -- sorry).
 *
 * Use:		Reads the next line from the transport.  If @MILLIS@ is an
 *		integer, then give up after that many milliseconds of
 *		waiting; if it is `forever' (or anything beginning with an
 *		`f') then don't give up.  The default is to wait forever.
 */

static APIRET APIENTRY rxfn_txrecv(unsigned char *fn, ULONG ac, RXSTRING *av,
				   char *sn, RXSTRING *r)
{
  txline *l;
  unsigned long t = FOREVER;

  if (ac > 1 || !tx)
    return (-1);
  if (ac >= 1 && rxs_block(&av[0], &t))
    return (-1);

  l = tx_read(tx, t);
  if (!l)
    r->strlength = 0;
  else {
    rxs_putm(r, l->s, l->len);
    tx_freeline(l);
  }
  return (0);
}

/* --- @TXEOF()@ --- *
 *
 * Arguments:	---
 *
 * Returns:	True if end-of-file has been seen on the transport, otherwise
 *		false.
 */

static APIRET APIENTRY rxfn_txeof(unsigned char *fn, ULONG ac,
				  RXSTRING *av, char *sn, RXSTRING *r)
{
  if (ac || !tx)
    return (-1);
  rxs_putf(r, "%d", tx->s == TX_CLOSED && !tx->ll);
  return (0);
}

/* --- @txready([MILLIS])@ --- *
 *
 * Arguments:	@MILLIS@ = how long (in milliseconds) to wait, or `forever'
 *
 * Returns:	True if a line is ready, otherwise false.
 *
 * Use:		Returns whether the transport is ready for reading.  If
 *		@MILLIS@ is an integer, then wait for at most that many
 *		milliseconds before returning.  If @MILLIS@ is `forever' (or
 *		anything beginning with `f') then wait forever for
 *		readiness.  This isn't useless: it can trip the end-of-file
 *		detector.  If @MILLIS@ is omitted, return immediately (as if
 *		0 had been specified).
 */

static APIRET APIENTRY rxfn_txready(unsigned char *fn, ULONG ac,
				    RXSTRING *av, char *sn, RXSTRING *r)
{
  unsigned long t = 0;

  if (ac > 1 || !tx)
    return (-1);
  if (ac >= 1 && rxs_block(&av[0], &t))
    return (-1);
  rxs_putf(r, "%d", !!tx_read(tx, t));
  return (0);
}

/* --- @MILLIWAIT(MILLIS)@ --- *
 *
 * Arguments:	@MILLIS@ = how long (in milliseconds) to wait
 *
 * Returns:	---
 *
 * Use:		Waits for @MILLIS@ milliseconds.  Always.
 */

static APIRET APIENTRY rxfn_milliwait(unsigned char *fn, ULONG ac,
				      RXSTRING *av, char *sn, RXSTRING *r)
{
  long l;
  struct timeval tv;

  if (ac != 1 || !av[0].strptr)
    return (-1);
  if (rxs_tol(&av[0], &l) || l < 0)
    return (-1);
  tv.tv_sec = l / 1000;
  tv.tv_usec = (l % 1000) * 1000;
  select(0, 0, 0, 0, &tv);
  return (0);
}

/*----- Initialization ----------------------------------------------------*/

struct rxfntab { char *name; RexxFunctionHandler *fn; };

static const struct rxfntab rxfntab[] = {
  { "test",	rxfn_test },
  { "txname",	rxfn_txname },
  { "txfile",	rxfn_txfile },
  { "txconf",	rxfn_txconf },
  { "txinit",	rxfn_txinit },
  { "txsend",	rxfn_txsend },
  { "txrecv",	rxfn_txrecv },
  { "txeof",	rxfn_txeof },
  { "txready",	rxfn_txready },
  { "milliwait", rxfn_milliwait },
  { 0,		0 }
};

/* --- @rx_init@ --- *
 *
 * Arguments:	---
 *
 * Returns:	---
 *
 * Use:		Initializes the REXX external functions.
 */

void rx_init(void)
{
  const struct rxfntab *f;
  int rc;

  for (f = rxfntab; f->fn; f++) {
    if ((rc = RexxRegisterFunctionExe(f->name, f->fn)) != 0) {
      err_report(ERR_RXGLUE, ERRRX_INIT, rc,
		 "couldn't register function `%s' (code %d)", f->name, rc);
      abort();
    }
  }
}

/*----- Running REXX programs ---------------------------------------------*/

/* --- @rx_run@ --- *
 *
 * Arguments:	@const char *name@ = pointer to filename (or null)
 *		@const void *p@ = pointer to program text
 *		@size_t sz@ = size of program text
 *		@int ac@ = number of arguments
 *		@const char *const *av@ = vector of command-line arguments
 *
 * Returns:	Exit code from program.
 *
 * Use:		Runs a REXX script from memory.
 */

int rx_run(const char *name, const void *p, size_t sz,
	   int ac, const char *const *av)
{
  RXSTRING prog[2];
  RXSTRING *argv;
  RXSTRING res;
  dstr d = DSTR_INIT;
  short badrc;
  int rc;
  int i;

  /* --- Set things up --- */

  if (!name)
    name = "incore";
  MAKERXSTRING(prog[0], (void *)p, sz);
  MAKERXSTRING(prog[1], 0, 0);
  argv = xmalloc(ac * sizeof(*argv));
  for (i = 0; i < ac; i++)
    MAKERXSTRING(argv[i], (char *)av[i], strlen(av[i]));

  /* --- Run the script --- */

  MAKERXSTRING(res, 0, 0);
  rc = RexxStart(ac, argv, (char *)name, prog,
		 "CMD", RXCOMMAND, 0, &badrc, &res);
  if (rc) {
    free(RXSTRPTR(res));
    if (rc < 0)
      err_report(ERR_RXERR, 0, -rc, "rexx error from script `%s'", name);
    else
      err_report(ERR_RXGLUE, ERRRX_INTERP, rc, "intepreter internal error");
    return (-1);
  }

  /* --- Pick apart the results --- */

  dstr_putm(&d, RXSTRPTR(res), RXSTRLEN(res));
  free(RXSTRPTR(res));
  dstr_putz(&d);
  rc = atoi(d.buf);
  dstr_destroy(&d);
  return (rc);
}

/* --- @rx_runfile@ --- *
 *
 * Arguments:	@const char *name@ = pointer to filename
 *		@int ac@ = number of command-line arguments
 *		@const char *const *av@ = vector of command-line arguments
 *
 * Returns:	Exit code from program.
 *
 * Use:		Runs a REXX script from a file, given its name.
 */

int rx_runfile(const char *name, int ac, const char *const *av)
{
  FILE *fp;
  dstr d = DSTR_INIT;
  char buf[BUFSIZ];
  size_t n;
  int rc;

  /* --- Read the file into memory --- *
   *
   * This way avoids any crapness in the REXX implementation and means we can
   * report errors in a more sensible way.
   */

  if ((fp = fopen(name, "r")) == 0)
    goto fail_0;
  do {
    n = fread(buf, 1, sizeof(buf), fp);
    DPUTM(&d, buf, n);
  } while (n == sizeof(buf));
  if (ferror(fp))
    goto fail_1;
  fclose(fp);

  /* --- Now do the from-memory thing --- */

  rc = rx_run(name, d.buf, d.len, ac, av);
  dstr_destroy(&d);
  return (rc);

  /* --- Tidy up on errors --- */

fail_1:
  dstr_destroy(&d);
  fclose(fp);
fail_0:
  err_report(ERR_RXGLUE, ERRRX_SCRIPTREAD, errno,
	     "couldn't read script `%s': %s", name, strerror(errno));
  return (-1);
}

/*----- That's all, folks -------------------------------------------------*/