regina/unxfuncs.c

   1 #ifndef lint
   2 static char *RCSid = "$Id$";
   3 #endif
   4
   5 /*
   6  *  The Regina Rexx Interpreter
   7  *  Copyright (C) 1992  Anders Christensen <anders@pvv.unit.no>
   8  *
   9  *  This library is free software; you can redistribute it and/or
  10  *  modify it under the terms of the GNU Library General Public
  11  *  License as published by the Free Software Foundation; either
  12  *  version 2 of the License, or (at your option) any later version.
  13  *
  14  *  This library is distributed in the hope that it will be useful,
  15  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17  *  Library General Public License for more details.
  18  *
  19  *  You should have received a copy of the GNU Library General Public
  20  *  License along with this library; if not, write to the Free
  21  *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  22  */
  23
  24 /*
  25  * _XOPEN_SOURCE required for crypt()
  26  * but it stuffs up SCO and QNX-RTO :-(
  27  */
  28 #if !defined(_SCO_ELF) && !defined(_SCO_COFF) && !defined(__QNXNTO__)
  29 # ifndef _XOPEN_SOURCE
  30 #  define _XOPEN_SOURCE
  31 #  define _GNU_SOURCE
  32 # endif
  33 #endif
  34
  35 #ifndef _GNU_SOURCE
  36 /* At least Linux needs _GNU_SOURCE and _XOPEN_SOURCE together to allow
  37  * a warning free compile.
  38  */
  39 # define _GNU_SOURCE
  40 #endif
  41
  42 #define HAVE_FORK
  43 #if !defined(__WATCOMC__) && !defined(_MSC_VER)  && !(defined(__IBMC__) && defined(WIN32)) && !defined(__SASC) && !defined(__MINGW32__) && !defined(__BORLANDC__)
  44 # undef HAVE_FORK
  45 #endif
  46 #if defined(__WATCOMC__) && defined(__QNX__)
  47 # define HAVE_FORK
  48 #endif
  49
  50 #include "rexx.h"
  51 #include <stdio.h>
  52 #include <string.h>
  53 #include <ctype.h>
  54
  55 #ifdef HAVE_ASSERT_H
  56 # include <assert.h>
  57 #endif
  58
  59 #include <errno.h>
  60
  61 #if defined(VMS) || defined(MAC)
  62 # include <types.h>
  63 #include "utsname.h"
  64 #else
  65 # include <sys/types.h>
  66 # ifdef HAVE_UNISTD_H
  67 #  include <unistd.h>
  68 # endif
  69 # if defined(WIN32) && defined(__IBMC__)
  70 #   include <process.h>
  71 #   include <direct.h>
  72 typedef struct utsname
  73 {
  74    char *sysname ;
  75    char *nodename ;
  76    char *release ;
  77    char *version ;
  78    char *machine ;
  79 } _utsname ;
  80 # elif defined(__WATCOMC__) || defined(_MSC_VER) || defined(__SASC) || defined(__MINGW32__) || defined(__BORLANDC__) || defined(__AROS__) || defined(__WINS__) || defined(__EPOC32__)
  81 #  include "utsname.h"
  82 #  if !defined(__SASC) && !defined(__QNX__) && !defined(__AROS__) && !defined(__WINS__) && !defined(__EPOC32__)
  83 #   include <process.h>
  84 #   include <direct.h>
  85 #  endif
  86 # else
  87 #  ifndef VMS
  88 #  include <sys/utsname.h>
  89 #  endif
  90 # endif
  91 #endif
  92
  93 streng *unx_getpath( tsd_t *TSD, cparamboxptr dummy )
  94 {
  95    TSD = TSD; /* keep compiler happy */
  96    dummy = dummy; /* keep compiler happy */
  97    return nullstringptr() ;
  98 }
  99
 100
 101 streng *unx_popen( tsd_t *TSD, cparamboxptr parms )
 102 {
 103    streng *string=NULL, *result=NULL ;
 104    streng *cptr=NULL ;
 105    int length=0, lines=0 ;
 106    int save_internal_queues_option;
 107
 108    if ( TSD->restricted )
 109       exiterror( ERR_RESTRICTED, 1, "POPEN" )  ;
 110
 111    checkparam(  parms,  1,  2 , "POPEN" ) ;
 112    string = (parms->value) ;
 113
 114    /*
 115     * Because this sort of redirection is only valid with internal
 116     * queues, we need to make regina think we are using internal
 117     * queues for this function.
 118     */
 119    save_internal_queues_option = get_options_flag( TSD->currlevel, EXT_INTERNAL_QUEUES ) ;
 120    set_options_flag( TSD->currlevel, EXT_INTERNAL_QUEUES, 1 ) ;
 121
 122    cptr = Str_makeTSD( length=Str_len(string) + 6 ) ;
 123    cptr = Str_catTSD( cptr, string ) ;
 124    cptr = Str_catstrTSD( cptr, ">LIFO" ) ;
 125
 126    if (parms->next && parms->next->value)
 127    {
 128       lines = lines_in_stack( TSD, NULL ) ;
 129    }
 130
 131    result = perform( TSD, cptr, TSD->currlevel->environment, TSD->currentnode ) ;
 132    Free_stringTSD( cptr ) ;
 133
 134    if (parms->next && parms->next->value)
 135    {
 136       streng *varname=NULL, *varstem=NULL ;
 137       int stemlen=0 ;
 138       char *cptr=NULL, *eptr=NULL ;
 139       streng *tmpptr=NULL ;
 140
 141       varstem = parms->next->value ;
 142       varname = Str_makeTSD( (stemlen=varstem->len) + 8 ) ;
 143
 144       memcpy( varname->value, varstem->value, stemlen ) ;
 145       cptr = varname->value ;
 146       eptr = cptr + varstem->len ;
 147       for (; cptr<eptr; cptr++)
 148       {
 149          if (islower(*cptr))
 150             *cptr = (char) toupper(*cptr) ;
 151       }
 152
 153       if (*(eptr-1)!='.')
 154       {
 155          *((eptr++)-1) = '.' ;
 156          stemlen++ ;
 157       }
 158
 159       lines = lines_in_stack( TSD, NULL ) - lines ;
 160       *eptr = '0' ;
 161       varname->len = stemlen+1 ;
 162       tmpptr = int_to_streng( TSD, lines ) ;
 163       setvalue( TSD, varname, tmpptr ) ;
 164       for (; lines>0; lines--)
 165       {
 166          tmpptr = popline( TSD, NULL, NULL, 0 ) ;
 167          sprintf(eptr, "%d", lines ) ;
 168          varname->len = strlen( varname->value ) ;
 169          setvalue( TSD, varname, tmpptr ) ;
 170       }
 171       Free_stringTSD( varname ); /* bja */
 172    }
 173    set_options_flag( TSD->currlevel, EXT_INTERNAL_QUEUES, save_internal_queues_option ) ;
 174
 175    return result ;
 176
 177 /*   Free_stringTSD( cptr ) ;
 178    sprintf( (result=Str_makeTSD(SMALLSTR))->value, "%d", rcode ) ;
 179    result->len = Str_len(result) ;
 180    return result ; */
 181 }
 182
 183
 184 streng *unx_getpid( tsd_t *TSD, cparamboxptr parms )
 185 {
 186    checkparam(  parms,  0,  0 , "GETPID" ) ;
 187    return int_to_streng( TSD, getpid() ) ;
 188 }
 189
 190 streng *unx_gettid( tsd_t *TSD, cparamboxptr parms )
 191 {
 192    checkparam(  parms,  0,  0 , "GETTID" ) ;
 193    return int_to_streng( TSD, TSD->thread_id ) ;
 194 }
 195
 196 #ifdef OLD_REGINA_FEATURES
 197 streng *unx_eof( tsd_t *TSD, cparamboxptr parms )
 198 {
 199    checkparam(  parms,  0,  0 , "EOF" ) ;
 200 /*    sprintf(ptr=MallocTSD(SMALLSTR),"%d",eof_on_input()) ; */
 201    return( nullstringptr() ) ;
 202 }
 203 #endif
 204
 205 streng *unx_uname( tsd_t *TSD, cparamboxptr parms )
 206 {
 207    char option=' ' ;
 208    char *cptr=NULL ;
 209    int length=0 ;
 210    streng *result=NULL ;
 211    struct utsname utsbox ;
 212
 213    checkparam(  parms,  0,  1 , "UNAME" ) ;
 214    if (parms->value)
 215       option = getoptionchar( TSD, parms->value, "UNAME", 1, "ASMNRV", "" ) ;
 216    else
 217       option = 'A' ;
 218
 219    if (uname( &utsbox ) <0)
 220        exiterror( ERR_SYSTEM_FAILURE, 1, strerror( errno ) )  ;
 221
 222    switch( option )
 223    {
 224       case 'A':
 225          result = Str_makeTSD( 1+sizeof(struct utsname)) ;
 226          sprintf( result->value, "%s %s %s %s %s", utsbox.sysname,
 227                   utsbox.nodename, utsbox.release, utsbox.version,
 228                   utsbox.machine ) ;
 229          result->len = strlen( result->value ) ;
 230          assert( result->len <= result->max ) ;
 231          return result ;
 232
 233       case 'S': cptr = utsbox.sysname ; break ;
 234       case 'N': cptr = utsbox.nodename ; break ;
 235       case 'R': cptr = utsbox.release ; break ;
 236       case 'V': cptr = utsbox.version ; break ;
 237       case 'M': cptr = utsbox.machine ; break ;
 238       default:
 239          assert( 0 ) ;
 240    }
 241
 242    length = strlen(cptr);
 243    result = Str_makeTSD( length+1 ) ;
 244    memcpy( result->value, cptr, length ) ;
 245    result->len = length ;
 246    assert( result->len <= result->max ) ;
 247    return result ;
 248 }
 249
 250
 251 streng *unx_fork( tsd_t *TSD, cparamboxptr parms )
 252 {
 253    int i=1 ;
 254
 255    checkparam(  parms,  0,  0 , "FORK" ) ;
 256 #if defined(HAVE_FORK)
 257    i = fork() ;
 258 #endif                                                  /* MH 10-06-96 */
 259    return int_to_streng( TSD, i ) ;
 260 }
 261
 262
 263 #if 0
 264 char *unx_unixerror( tsd_t *TSD, cparamboxptr parms )
 265 {
 266    const char *errtxt=NULL ;
 267    char *result=NULL ;
 268    int errnum=0 ; /* change name from errno to not conflist with global errno */
 269
 270    checkparam(  parms,  1,  1 , "UNIXERROR" ) ;
 271    errnum = atozpos( TSD, parms->value, "UNIXERROR", 1 ) ;
 272    errtxt = strerror(errnum) ;
 273 /* unixerror returns char, not streng !                                          bja
 274    strcpy( result=MallocTSD(strlen(errtxt)+1+STRHEAD), errtxt ) ;
 275  */                                                                            /* bja */
 276    strcpy( result=MallocTSD(strlen(errtxt)+1), errtxt ) ;
 277    return result ;
 278 }
 279 #else
 280 streng *unx_unixerror( tsd_t *TSD, cparamboxptr parms )
 281 {
 282    const char *errtxt=NULL ;
 283    int errnum=0 ; /* change name from errno to not conflist with global errno */
 284
 285    checkparam(  parms,  1,  1 , "UNIXERROR" ) ;
 286    errnum = atozpos( TSD, parms->value, "UNIXERROR", 1 ) ;
 287    errtxt = strerror(errnum) ;
 288    return Str_creTSD( errtxt ) ;
 289 }
 290 #endif
 291
 292
 293
 294 streng *unx_chdir( tsd_t *TSD, cparamboxptr parms )
 295 {
 296    char *path;
 297    int rc;
 298
 299    checkparam(  parms,  1,  1 , "CD" ) ;
 300    path = str_of( TSD, parms->value ) ;
 301    rc = chdir( path ) ;
 302    FreeTSD( path ) ;
 303    return int_to_streng( TSD, rc!=0 ) ;
 304 }
 305
 306
 307 streng *unx_getenv( tsd_t *TSD, cparamboxptr parms )
 308 {
 309    streng *retval=NULL ;
 310    char *output=NULL ;
 311    char *path ;
 312
 313    checkparam(  parms,  1,  1 , "GETENV" ) ;
 314    path = str_of( TSD, parms->value ) ;
 315    output = mygetenv( TSD, path, NULL, 0 ) ;
 316    FreeTSD( path ) ;
 317    if ( output )
 318    {
 319       retval = Str_creTSD( output ) ;
 320       FreeTSD( output );
 321    }
 322    else
 323       retval = nullstringptr() ;
 324
 325    return retval ;
 326 }
 327
 328 streng *unx_crypt( tsd_t *TSD, cparamboxptr parms )
 329 {
 330    streng *retval=NULL ;
 331 #ifdef HAVE_CRYPT
 332    char *output=NULL ;
 333    char *key, *salt ;
 334 #endif
 335    int ch2,i;
 336
 337    checkparam(  parms,  2,  2 , "CRYPT" ) ;
 338    for ( i = 0; i < Str_len( parms->next->value ); i++ )
 339    {
 340       ch2 = (int)*(parms->next->value->value+i);
 341       if ((ch2 >= (int)'A' && ch2 <= (int)'Z')
 342       ||  (ch2 >= (int)'a' && ch2 <= (int)'z')
 343       ||  (ch2 >= (int)'0' && ch2 <= (int)'9')
 344       ||  (ch2 == (int)'.' || ch2 == (int)'/'))
 345       {
 346       }
 347       else
 348       {
 349          char tmp[2];
 350          tmp[0] = (char)ch2;
 351          tmp[1] = '\0';
 352          exiterror( ERR_INCORRECT_CALL, 914, "CRYPT", 2, "A-Za-z0-9./", tmp )  ;
 353       }
 354    }
 355 #ifdef HAVE_CRYPT
 356    key = str_of( TSD, parms->value );
 357    salt = str_of( TSD, parms->next->value );
 358    output = crypt( key, salt ) ;
 359    FreeTSD( salt ) ;
 360    FreeTSD( key ) ;
 361    if (output)
 362       retval = Str_creTSD(output) ;
 363    else
 364       retval = nullstringptr() ;
 365 #else
 366    retval = parms->value ;
 367 #endif
 368    TSD = TSD; /* keep compiler happy */
 369    return retval ;
 370 }
 371