regina/unxfuncs.c

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