chiark - git - mdw - jog/blob - rxglue.c

   1 /* -*-c-*-
   2  *
   3  * $Id: rxglue.c,v 1.2 2002/01/30 09:22:48 mdw Exp $
   4  *
   5  * REXX glue for C core functionality
   6  *
   7  * (c) 2001 Mark Wooding
   8  */
   9
  10 /*----- Licensing notice --------------------------------------------------*
  11  *
  12  * This file is part of Jog: Programming for a jogging machine.
  13  *
  14  * Jog is free software; you can redistribute it and/or modify
  15  * it under the terms of the GNU General Public License as published by
  16  * the Free Software Foundation; either version 2 of the License, or
  17  * (at your option) any later version.
  18  *
  19  * Jog is distributed in the hope that it will be useful,
  20  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  21  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22  * GNU General Public License for more details.
  23  *
  24  * You should have received a copy of the GNU General Public License
  25  * along with Jog; if not, write to the Free Software Foundation,
  26  * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  27  */
  28
  29 /*----- Revision history --------------------------------------------------*
  30  *
  31  * $Log: rxglue.c,v $
  32  * Revision 1.2  2002/01/30 09:22:48  mdw
  33  * Use memory-allocation functions provided by the REXX interpreter.
  34  * Now that configuration can be applied after initialization, allow
  35  * @txconf@ to set parameters.  Make @txsend@ add a newline to its output,
  36  * unless forbidden.
  37  *
  38  * Revision 1.1  2002/01/25 19:34:45  mdw
  39  * Initial revision
  40  *
  41  */
  42
  43 /*----- Header files ------------------------------------------------------*/
  44
  45 #ifdef HAVE_CONFIG_H
  46 #  include "config.h"
  47 #endif
  48
  49 #include <ctype.h>
  50 #include <errno.h>
  51 #include <limits.h>
  52 #include <stdarg.h>
  53 #include <stdio.h>
  54 #include <stdlib.h>
  55 #include <string.h>
  56 #include <time.h>
  57
  58 #include <sys/types.h>
  59 #include <sys/time.h>
  60 #include <unistd.h>
  61
  62 #define INCL_RXFUNC
  63 #define RX_STRONGTYPING
  64 #include <rexxsaa.h>
  65
  66 #include <mLib/alloc.h>
  67 #include <mLib/exc.h>
  68 #include <mLib/dstr.h>
  69
  70 #include "err.h"
  71 #include "rxglue.h"
  72 #include "txport.h"
  73
  74 /*----- Static variables --------------------------------------------------*/
  75
  76 static txport *tx = 0;
  77
  78 /*----- Memory allocation functions ---------------------------------------*/
  79
  80 static void *rx_alloc(size_t sz)
  81 {
  82   void *p = RexxAllocateMemory(sz);
  83   if (!p)
  84     THROW(EXC_NOMEM);
  85   return (p);
  86 }
  87
  88 static void rx_free(void *p)
  89 {
  90   RexxFreeMemory(p);
  91 }
  92
  93 /*----- Conversion functions ----------------------------------------------*/
  94
  95 /* --- @rxs_putm@ --- *
  96  *
  97  * Arguments:   @RXSTRING *x@ = pointer to REXX string structure
  98  *              For @rxs_putm@:
  99  *                @const void *p@ = pointer to data block
 100  *                @size_t sz@ = size of data
 101  *              For @rxs_putd@:
 102  *                @const dstr *d@ = pointer to source string
 103  *              For @rxs_putf@ and @rxs_vputf@:
 104  *                @const char *m@ = message format string
 105  *
 106  * Returns:     ---
 107  *
 108  * Use:         Stashes some text in an @RXSTRING@, overwriting whatever was
 109  *              there before.  We assume that the previous contents don't
 110  *              require freeing.
 111  */
 112
 113 #define RXS_PUTM(x, p, sz) do {                                         \
 114   RXSTRING *_x = (x);                                                   \
 115   const void *_p = (p);                                                 \
 116   size_t _sz = (sz);                                                    \
 117   if (!_x->strptr || _x->strlength < _sz)                               \
 118     _x->strptr = rx_alloc(_sz);                                         \
 119   memcpy(_x->strptr, _p, _sz);                                          \
 120   _x->strlength = _sz;                                                  \
 121 } while (0)
 122
 123 static void rxs_putm(RXSTRING *x, const void *p, size_t sz)
 124 {
 125   RXS_PUTM(x, p, sz);
 126 }
 127
 128 #define RXS_PUTD(x, d) do {                                             \
 129   dstr *_d = (d);                                                       \
 130   RXS_PUTM((x), _d->buf, _d->len);                                      \
 131 } while (0)
 132
 133 static void rxs_putd(RXSTRING *x, dstr *d) { RXS_PUTD(x, d); }
 134
 135 static void rxs_vputf(RXSTRING *x, const char *m, va_list *ap)
 136 {
 137   dstr d = DSTR_INIT;
 138   dstr_vputf(&d, m, ap);
 139   RXS_PUTD(x, &d);
 140   DDESTROY(&d);
 141 }
 142
 143 static void rxs_putf(RXSTRING *x, const char *m, ...)
 144 {
 145   va_list ap;
 146   dstr d = DSTR_INIT;
 147   va_start(ap, m);
 148   dstr_vputf(&d, m, &ap);
 149   RXS_PUTD(x, &d);
 150   va_end(ap);
 151   DDESTROY(&d);
 152 }
 153
 154 /* --- @rxs_get@ --- *
 155  *
 156  * Arguments:   @const RXSTRING *x@ = pointer to a REXX string
 157  *              @dstr *d@ = where to put it
 158  *
 159  * Returns:     ---
 160  *
 161  * Use:         Pulls a REXX string out and puts it in a dynamic string.
 162  */
 163
 164 #define RXS_GET(x, d) do {                                              \
 165   const RXSTRING *_x = (x);                                             \
 166   dstr *_dd = (d);                                                      \
 167   DPUTM(_dd, _x->strptr, _x->strlength);                                \
 168   DPUTZ(_dd);                                                           \
 169 } while (0)
 170
 171 static void rxs_get(const RXSTRING *x, dstr *d) { RXS_GET(x, d); }
 172
 173 /* --- @rxs_tol@ --- *
 174  *
 175  * Arguments:   @const RXSTRING *x@ = pointer to a REXX string
 176  *              @long *ii@ = where to put the answer
 177  *
 178  * Returns:     Zero on success, or nonzero on error.
 179  *
 180  * Use:         Fetches an integer from a REXX string.  This doesn't cope
 181  *              with multiprecision integers or similar silliness.
 182  */
 183
 184 static int rxs_tol(const RXSTRING *x, long *ii)
 185 {
 186   long i = 0;
 187   const char *p = x->strptr, *l = p + x->strlength;
 188   unsigned f = 0;
 189
 190 #define f_neg 1u
 191 #define f_ok 2u
 192
 193 #define MINR (LONG_MIN/10)
 194 #define MIND (LONG_MIN%10)
 195
 196   while (p < l && isspace((unsigned char)*p))
 197     p++;
 198   if (p >= l)
 199     return (-1);
 200   if (*p == '+')
 201     p++;
 202   else if (*p == '-') {
 203     f |= f_neg;
 204     p++;
 205   }
 206   while (p < l && isspace((unsigned char)*p))
 207     p++;
 208   while (p < l && isdigit((unsigned char)*p)) {
 209     int j = *p++ - '0';
 210     if (i < MINR || (i == MINR && -j < MIND))
 211       return (-1);
 212     i = (i * 10) - j;
 213     f |= f_ok;
 214   }
 215   while (p < l && isspace((unsigned char)*p))
 216     p++;
 217   if (p < l || !(f & f_ok))
 218     return (-1);
 219   if (!(f & f_neg)) {
 220     if (i < -LONG_MAX)
 221       return (-1);
 222     i = -i;
 223   }
 224   *ii = i;
 225   return (0);
 226
 227 #undef MINR
 228 #undef MIND
 229
 230 #undef f_neg
 231 #undef f_ok
 232 }
 233
 234 /* --- @rxs_block@ --- *
 235  *
 236  * Arguments:   @const RXSTRING *x@ = a REXX string
 237  *              @unsigned long *t@ = where to put the block spec
 238  *
 239  * Returns:     Zero if OK, nonzero on error.
 240  *
 241  * Use:         Picks out a blockingness spec.
 242  */
 243
 244 static int rxs_block(const RXSTRING *x, unsigned long *t)
 245 {
 246   long i;
 247
 248   if (!x->strptr || x->strlength < 1)
 249     return (-1);
 250   switch (x->strptr[0]) {
 251     case 'f':
 252     case 'F':
 253       *t = FOREVER;
 254       break;
 255     default:
 256       if (rxs_tol(x, &i) || i < 0)
 257         return (-1);
 258       *t = i;
 259       break;
 260   }
 261   return (0);
 262 }
 263
 264 /*----- REXX functions ----------------------------------------------------*/
 265
 266 static APIRET APIENTRY rxfn_test(const char *fn, ULONG ac, RXSTRING *av,
 267                                  const char *sn, RXSTRING *r)
 268 {
 269   ULONG i;
 270
 271   printf("test entry\n"
 272          "  fn = `%s'\n", fn);
 273   for (i = 0; i < ac; i++) {
 274     long l;
 275
 276     printf("  av[%lu] = `", i);
 277     fwrite(av[i].strptr, 1, av[i].strlength, stdout);
 278     if (rxs_tol(&av[i], &l))
 279       printf("'\n");
 280     else
 281       printf("' (%ld)\n", l);
 282   }
 283   printf("tx = `%s'; f = `%s'; c = `%s'.\n", txname, txfile, txconf);
 284   rxs_putf(r, "function `%s' completed ok", fn);
 285   return (0);
 286 }
 287
 288 /* --- @txname()@ ---
 289  *
 290  * Arguments:   ---
 291  *
 292  * Returns:     The currently-selected transport name.
 293  */
 294
 295 static APIRET APIENTRY rxfn_txname(const char *fn, ULONG ac, RXSTRING *av,
 296                                    const char *sn, RXSTRING *r)
 297 {
 298   if (ac)
 299     return (-1);
 300   rxs_putf(r, "%s", txname);
 301   return (0);
 302 }
 303
 304 /* --- @txfile()@ ---
 305  *
 306  * Arguments:   ---
 307  *
 308  * Returns:     The currently-selected transport filename.
 309  */
 310
 311 static APIRET APIENTRY rxfn_txfile(const char *fn, ULONG ac, RXSTRING *av,
 312                                    const char *sn, RXSTRING *r)
 313 {
 314   if (ac)
 315     return (-1);
 316   rxs_putf(r, "%s", txfile ? txfile : "");
 317   return (0);
 318 }
 319
 320 /* --- @txconf([CONFIG])@ ---
 321  *
 322  * Arguments:   @CONFIG@ = optional string to set
 323  *
 324  * Returns:     The currently-selected transport configuration string.
 325  */
 326
 327 static APIRET APIENTRY rxfn_txconf(const char *fn, ULONG ac, RXSTRING *av,
 328                                    const char *sn, RXSTRING *r)
 329 {
 330   if (ac > 1)
 331     return (-1);
 332   if (ac > 0 && av[0].strptr) {
 333     dstr d = DSTR_INIT;
 334     int rc;
 335     if (!tx)
 336       return (-1);
 337     rxs_get(&av[0], &d);
 338     rc = tx_configure(tx, d.buf);
 339     dstr_destroy(&d);
 340     if (rc)
 341       return (-1);
 342   }
 343   rxs_putf(r, "%s", txconf ? txconf : "");
 344   return (0);
 345 }
 346
 347 /* --- @txinit([NAME], [FILE], [CONFIG])@ ---
 348  *
 349  * Arguments:   @NAME@ = transport name to select
 350  *              @FILE@ = transport filename
 351  *              @CONFIG@ = transport configuration string
 352  *
 353  * Returns:     ---
 354  *
 355  * Use:         Initializes a transport using the given settings.  Omitted
 356  *              arguments are filled in from the command line, or internal
 357  *              defaults.
 358  */
 359
 360 static APIRET APIENTRY rxfn_txinit(const char *fn, ULONG ac, RXSTRING *av,
 361                                    const char *sn, RXSTRING *r)
 362 {
 363   const char *n = txname, *f = txfile, *c = txconf;
 364   dstr dn = DSTR_INIT, df = DSTR_INIT, dc = DSTR_INIT;
 365
 366   if (tx)
 367     return (-1);
 368   if (ac > 3)
 369     return (-1);
 370   if (ac >= 1 && av[0].strptr) {
 371     rxs_get(&av[0], &dn);
 372     n = dn.buf;
 373   }
 374   if (ac >= 2 && av[1].strptr) {
 375     rxs_get(&av[1], &df);
 376     f = df.buf;
 377   }
 378   if (ac >= 3 && av[2].strptr) {
 379     rxs_get(&av[2], &dc);
 380     c = dc.buf;
 381   }
 382   tx = tx_create(n, f, c);
 383   dstr_destroy(&dn);
 384   dstr_destroy(&df);
 385   dstr_destroy(&dc);
 386   if (!tx)
 387     return (-1);
 388   return (0);
 389 }
 390
 391 /* --- @txsend(STRING, [OPTION])@ --- *
 392  *
 393  * Arguments:   @STRING@ = string to send
 394  *              @OPTION@ = `l' or `n' (for `linebreak' or `nolinebreak')
 395  *
 396  * Returns:     ---
 397  *
 398  * Use:         Sends a string (exactly as written) to the transport.
 399  */
 400
 401 static APIRET APIENTRY rxfn_txsend(const char *fn, ULONG ac, RXSTRING *av,
 402                                    const char *sn, RXSTRING *r)
 403 {
 404   if ((ac != 1 && ac != 2) || !tx || !av[0].strptr)
 405     return (-1);
 406   tx_write(tx, av[0].strptr, av[0].strlength);
 407   if (ac == 1 || !av[1].strptr || !av[1].strlength ||
 408       av[1].strptr[0] == 'l' || av[1].strptr[0] == 'L')
 409     tx_newline(tx);
 410   return (0);
 411 }
 412
 413 /* --- @txrecv([MILLIS])@ --- *
 414  *
 415  * Arguments:   @MILLIS@ = how long (in milliseconds) to wait, or `forever'
 416  *
 417  * Returns:     The string read (may be null if nothing available -- sorry).
 418  *
 419  * Use:         Reads the next line from the transport.  If @MILLIS@ is an
 420  *              integer, then give up after that many milliseconds of
 421  *              waiting; if it is `forever' (or anything beginning with an
 422  *              `f') then don't give up.  The default is to wait forever.
 423  */
 424
 425 static APIRET APIENTRY rxfn_txrecv(const char *fn, ULONG ac, RXSTRING *av,
 426                                    const char *sn, RXSTRING *r)
 427 {
 428   txline *l;
 429   unsigned long t = FOREVER;
 430
 431   if (ac > 1 || !tx)
 432     return (-1);
 433   if (ac >= 1 && rxs_block(&av[0], &t))
 434     return (-1);
 435
 436   l = tx_read(tx, t);
 437   if (!l)
 438     r->strlength = 0;
 439   else {
 440     rxs_putm(r, l->s, l->len);
 441     tx_freeline(l);
 442   }
 443   return (0);
 444 }
 445
 446 /* --- @TXEOF()@ --- *
 447  *
 448  * Arguments:   ---
 449  *
 450  * Returns:     True if end-of-file has been seen on the transport, otherwise
 451  *              false.
 452  */
 453
 454 static APIRET APIENTRY rxfn_txeof(const char *fn, ULONG ac, RXSTRING *av,
 455                                   const char *sn, RXSTRING *r)
 456 {
 457   if (ac || !tx)
 458     return (-1);
 459   rxs_putf(r, "%d", tx->s == TX_CLOSED && !tx->ll);
 460   return (0);
 461 }
 462
 463 /* --- @txready([MILLIS])@ --- *
 464  *
 465  * Arguments:   @MILLIS@ = how long (in milliseconds) to wait, or `forever'
 466  *
 467  * Returns:     True if a line is ready, otherwise false.
 468  *
 469  * Use:         Returns whether the transport is ready for reading.  If
 470  *              @MILLIS@ is an integer, then wait for at most that many
 471  *              milliseconds before returning.  If @MILLIS@ is `forever' (or
 472  *              anything beginning with `f') then wait forever for
 473  *              readiness.  This isn't useless: it can trip the end-of-file
 474  *              detector.  If @MILLIS@ is omitted, return immediately (as if
 475  *              0 had been specified).
 476  */
 477
 478 static APIRET APIENTRY rxfn_txready(const char *fn, ULONG ac, RXSTRING *av,
 479                                     const char *sn, RXSTRING *r)
 480 {
 481   unsigned long t = 0;
 482
 483   if (ac > 1 || !tx)
 484     return (-1);
 485   if (ac >= 1 && rxs_block(&av[0], &t))
 486     return (-1);
 487   rxs_putf(r, "%d", !!tx_read(tx, t));
 488   return (0);
 489 }
 490
 491 /* --- @MILLIWAIT(MILLIS)@ --- *
 492  *
 493  * Arguments:   @MILLIS@ = how long (in milliseconds) to wait
 494  *
 495  * Returns:     ---
 496  *
 497  * Use:         Waits for @MILLIS@ milliseconds.  Always.
 498  */
 499
 500 static APIRET APIENTRY rxfn_milliwait(const char *fn, ULONG ac, RXSTRING *av,
 501                                       const char *sn, RXSTRING *r)
 502 {
 503   long l;
 504   struct timeval tv;
 505
 506   if (ac != 1 || !av[0].strptr)
 507     return (-1);
 508   if (rxs_tol(&av[0], &l) || l < 0)
 509     return (-1);
 510   tv.tv_sec = l / 1000;
 511   tv.tv_usec = (l % 1000) * 1000;
 512   select(0, 0, 0, 0, &tv);
 513   return (0);
 514 }
 515
 516 /*----- Initialization ----------------------------------------------------*/
 517
 518 struct rxfntab { char *name; RexxFunctionHandler *fn; };
 519
 520 static const struct rxfntab rxfntab[] = {
 521   { "test",             rxfn_test },
 522   { "txname",           rxfn_txname },
 523   { "txfile",           rxfn_txfile },
 524   { "txconf",           rxfn_txconf },
 525   { "txinit",           rxfn_txinit },
 526   { "txsend",           rxfn_txsend },
 527   { "txrecv",           rxfn_txrecv },
 528   { "txeof",            rxfn_txeof },
 529   { "txready",          rxfn_txready },
 530   { "milliwait",        rxfn_milliwait },
 531   { 0,          0 }
 532 };
 533
 534 /* --- @rx_init@ --- *
 535  *
 536  * Arguments:   ---
 537  *
 538  * Returns:     ---
 539  *
 540  * Use:         Initializes the REXX external functions.
 541  */
 542
 543 void rx_init(void)
 544 {
 545   const struct rxfntab *f;
 546   int rc;
 547
 548   for (f = rxfntab; f->fn; f++) {
 549     if ((rc = RexxRegisterFunctionExe(f->name, f->fn)) != 0) {
 550       err_report(ERR_RXGLUE, ERRRX_INIT, rc,
 551                  "couldn't register function `%s' (code %d)", f->name, rc);
 552       abort();
 553     }
 554   }
 555 }
 556
 557 /*----- Running REXX programs ---------------------------------------------*/
 558
 559 /* --- @rx_run@ --- *
 560  *
 561  * Arguments:   @const char *name@ = pointer to filename (or null)
 562  *              @const void *p@ = pointer to program text
 563  *              @size_t sz@ = size of program text
 564  *              @int ac@ = number of arguments
 565  *              @const char *const *av@ = vector of command-line arguments
 566  *
 567  * Returns:     Exit code from program.
 568  *
 569  * Use:         Runs a REXX script from memory.
 570  */
 571
 572 int rx_run(const char *name, const void *p, size_t sz,
 573            int ac, const char *const *av)
 574 {
 575   RXSTRING prog[2];
 576   RXSTRING *argv;
 577   RXSTRING res;
 578   dstr d = DSTR_INIT;
 579   short badrc;
 580   int rc;
 581   int i;
 582
 583   /* --- Set things up --- */
 584
 585   if (!name)
 586     name = "incore";
 587   MAKERXSTRING(prog[0], (void *)p, sz);
 588   MAKERXSTRING(prog[1], 0, 0);
 589   argv = rx_alloc(ac * sizeof(*argv));
 590   for (i = 0; i < ac; i++)
 591     MAKERXSTRING(argv[i], (char *)av[i], strlen(av[i]));
 592
 593   /* --- Run the script --- */
 594
 595   MAKERXSTRING(res, 0, 0);
 596   rc = RexxStart(ac, argv, name, prog,
 597                  "SYSTEM", RXSUBROUTINE, 0, &badrc, &res);
 598   if (rc) {
 599     rx_free(RXSTRPTR(res));
 600     rx_free(argv);
 601     if (rc < 0)
 602       err_report(ERR_RXERR, 0, -rc, "rexx error from script `%s'", name);
 603     else
 604       err_report(ERR_RXGLUE, ERRRX_INTERP, rc, "intepreter internal error");
 605     return (-1);
 606   }
 607
 608   /* --- Pick apart the results --- */
 609
 610   dstr_putm(&d, RXSTRPTR(res), RXSTRLEN(res));
 611   rx_free(RXSTRPTR(res));
 612   rx_free(argv);
 613   dstr_putz(&d);
 614   rc = atoi(d.buf);
 615   dstr_destroy(&d);
 616   return (rc);
 617 }
 618
 619 /* --- @rx_runfile@ --- *
 620  *
 621  * Arguments:   @const char *name@ = pointer to filename
 622  *              @int ac@ = number of command-line arguments
 623  *              @const char *const *av@ = vector of command-line arguments
 624  *
 625  * Returns:     Exit code from program.
 626  *
 627  * Use:         Runs a REXX script from a file, given its name.
 628  */
 629
 630 int rx_runfile(const char *name, int ac, const char *const *av)
 631 {
 632   FILE *fp;
 633   dstr d = DSTR_INIT;
 634   char buf[BUFSIZ];
 635   size_t n;
 636   int rc;
 637
 638   /* --- Read the file into memory --- *
 639    *
 640    * This way avoids any crapness in the REXX implementation and means we can
 641    * report errors in a more sensible way.
 642    */
 643
 644   if ((fp = fopen(name, "r")) == 0)
 645     goto fail_0;
 646   do {
 647     n = fread(buf, 1, sizeof(buf), fp);
 648     DPUTM(&d, buf, n);
 649   } while (n == sizeof(buf));
 650   if (ferror(fp))
 651     goto fail_1;
 652   fclose(fp);
 653
 654   /* --- Now do the from-memory thing --- */
 655
 656   rc = rx_run(name, d.buf, d.len, ac, av);
 657   dstr_destroy(&d);
 658   return (rc);
 659
 660   /* --- Tidy up on errors --- */
 661
 662 fail_1:
 663   dstr_destroy(&d);
 664   fclose(fp);
 665 fail_0:
 666   err_report(ERR_RXGLUE, ERRRX_SCRIPTREAD, errno,
 667              "couldn't read script `%s': %s", name, strerror(errno));
 668   return (-1);
 669 }
 670
 671 /*----- That's all, folks -------------------------------------------------*/