regina/envir.c

   1 /*
   2  *  The Regina Rexx Interpreter
   3  *  Copyright (C) 1993-1994  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 #include "rexx.h"
  21 #include <string.h>
  22
  23 #if defined(VMS)
  24 # define fork() vfork()
  25 /*
  26  *  At least with OpenVMS 7.3-1 on Alpha, the Posix way seems to work.
  27  *  So there is no need to redirect on (now) bogus code.
  28  */
  29
  30 #ifdef VMS_DO_COMMAND
  31 # ifdef posix_do_command
  32 #  undef posix_do_command
  33 # endif
  34 # define posix_do_command __regina_vms_do_command
  35 #endif
  36 #endif
  37
  38 /*
  39  * The following strings must match AddressWithType enums in regina_t.h
  40  */
  41 static char *env_type[] = { "NORMAL", "STREAM", "STEM", "LIFO", "FIFO" };
  42
  43 struct envir
  44 {
  45    environment e ;
  46    int type ;
  47    struct envir *next, *prev ;
  48 };
  49
  50 #if defined(_AMIGA) || defined(__AROS__)
  51 struct envir *amiga_find_envir( const tsd_t *TSD, const streng * );
  52 streng *AmigaSubCom( const tsd_t *TSD, const streng *command, struct envir *envir, int *rc );
  53 #endif
  54
  55 /* clear_environpart sets initial values of an environpart.
  56  * attention: cleanup_environpart() closes open file handles and removes
  57  *            temporary files, this function not.
  58  */
  59 static void clear_environpart(environpart *ep)
  60 {
  61    ep->currnum = -1 ;
  62    ep->maxnum = -1 ;
  63    ep->SameAsOutput = 0;
  64    ep->FileRedirected = 0;
  65    ep->tempname = NULL ;
  66    ep->tmp_queue = NULL ;
  67    ep->queue = NULL ;
  68    ep->type = 0 ;
  69    ep->hdls[2] = ep->hdls[1] = ep->hdls[0] = -1;
  70 }
  71
  72 void add_envir( tsd_t *TSD, const streng *name, int type, int subtype )
  73 /* an environment with the same name can be added more than once! */
  74 {
  75    struct envir *ptr;
  76
  77    ptr = (struct envir *)MallocTSD( sizeof( struct envir ) );
  78    memset( &ptr->e, 0, sizeof(ptr->e) );
  79    clear_environpart( &ptr->e.input );
  80    clear_environpart( &ptr->e.output );
  81    clear_environpart( &ptr->e.error );
  82    ptr->e.input.flags.isinput = 1;
  83    ptr->e.error.flags.iserror = 1;
  84
  85    ptr->e.name = Str_dupTSD( name );
  86    ptr->e.subtype = subtype;
  87    ptr->e.subcomed = 0;
  88    ptr->type = type;
  89    ptr->prev = (struct envir *)TSD->firstenvir;
  90    ptr->next = NULL;
  91    TSD->firstenvir = ptr;
  92    if ( ptr->prev )
  93       ptr->prev->next = ptr;
  94 }
  95
  96 #ifdef TRACEMEM
  97 static void markenvir( const tsd_t *TSD )
  98 {
  99    struct envir *eptr=NULL ;
 100
 101    eptr = (struct envir *) TSD->firstenvir ;
 102    for (; eptr; eptr=eptr->prev )
 103    {
 104       markmemory( eptr, TRC_ENVIRBOX ) ;
 105       markmemory( eptr->e.name, TRC_ENVIRNAME ) ;
 106       if (eptr->e.input.name)
 107          markmemory( eptr->e.input.name, TRC_ENVIRNAME ) ;
 108       if (eptr->e.output.name)
 109          markmemory( eptr->e.output.name, TRC_ENVIRNAME ) ;
 110       if (eptr->e.error.name)
 111          markmemory( eptr->e.error.name, TRC_ENVIRNAME ) ;
 112    }
 113 }
 114 #endif /* TRACEMEM */
 115
 116
 117 static struct envir *find_envir( const tsd_t *TSD, const streng *name )
 118 {
 119    struct envir *ptr=NULL ;
 120
 121 #if defined(_AMIGA) || defined(__AROS__)
 122    if ((ptr=amiga_find_envir( TSD, name))!=NULL)
 123       return ptr;
 124 #endif
 125
 126    for ( ptr = (struct envir *)TSD->firstenvir; ptr; ptr = ptr->prev )
 127    {
 128       if ( !Str_cmp( ptr->e.name, name ) )
 129          return ptr ;
 130    }
 131    return NULL ;
 132 }
 133
 134 /*
 135  * This function is used to determine if an environment exists. It is the
 136  * external equivalent of find_envir()
 137  */
 138 int envir_exists( const tsd_t *TSD, const streng *name )
 139 {
 140    if ( find_envir( TSD, name ) == NULL )
 141       return 0;
 142    else
 143       return 1;
 144 }
 145
 146 /*
 147  * This function returns textual information about the current environment.
 148  * Suitable output for ADDRESS BIF
 149  */
 150 streng *get_envir_details( const tsd_t *TSD, char opt, const streng *name )
 151 {
 152    struct envir *ptr=NULL ;
 153    streng *result, *env_resource, *raw_resource;
 154    char *env_position;
 155    int awt, ant, len;
 156
 157    ptr = find_envir( TSD, name );
 158    switch( opt )
 159    {
 160       case 'I':
 161          env_position = (char *)"INPUT";
 162          awt = ptr->e.input.flags.awt;
 163          ant = ptr->e.input.flags.ant;
 164          raw_resource = ptr->e.input.name;
 165          break;
 166       case 'O':
 167          env_position = (char *)( (ptr->e.output.flags.append) ? "APPEND" : "REPLACE" );
 168          awt = ptr->e.output.flags.awt;
 169          ant = ptr->e.output.flags.ant;
 170          raw_resource = ptr->e.output.name;
 171          break;
 172       case 'E':
 173          env_position = (char *)( (ptr->e.error.flags.append) ? "APPEND" : "REPLACE" );
 174          awt = ptr->e.error.flags.awt;
 175          ant = ptr->e.error.flags.ant;
 176          raw_resource = ptr->e.error.name;
 177          break;
 178       default:
 179          /*
 180           * Should not get here!!
 181           */
 182          awt = ant = 0;
 183          env_position = NULL;
 184          raw_resource = NULL;
 185          break;
 186    }
 187    /*
 188     * Determine the resource string...
 189     */
 190    if ( raw_resource == NULL )
 191    {
 192       env_resource = nullstringptr();
 193    }
 194    else if ( awt == awtSTEM )
 195    {
 196       env_resource = raw_resource;
 197    }
 198    else if ( ant == antSTRING )
 199    {
 200       if ( raw_resource == NULL )
 201       {
 202          env_resource = nullstringptr();
 203       }
 204       else
 205       {
 206          env_resource = raw_resource;
 207       }
 208    }
 209    else
 210    {
 211       /*
 212        * Get the value of the symbol...
 213        */
 214       env_resource = (streng *)getdirvalue( (tsd_t *)TSD, raw_resource );
 215    }
 216    len = 3 + strlen( env_position) + strlen( env_type[awt] ) + env_resource->len;
 217    result = Str_makeTSD( len );
 218    result = Str_catstrTSD( result, env_position );
 219    result = Str_catstrTSD( result, " " );
 220    result = Str_catstrTSD( result, env_type[awt] );
 221    if ( env_resource->len )
 222    {
 223       result = Str_catstrTSD( result, " " );
 224       result = Str_catTSD( result, env_resource );
 225    }
 226    return result;
 227 }
 228
 229 /*
 230  * This function is used to set the subcomed flag in an environment exists.
 231  */
 232 int set_subcomed_envir( const tsd_t *TSD, const streng *name, int subcomed )
 233 {
 234    struct envir *ptr=NULL ;
 235    if ( ( ptr = find_envir( TSD, name ) ) == NULL )
 236       return 0;
 237    ptr->e.subcomed = subcomed;
 238    return 1;
 239 }
 240 /*
 241  * This function is used to get the subcomed flag from an environment.
 242  */
 243 int get_subcomed_envir( const tsd_t *TSD, const streng *name )
 244 {
 245    struct envir *ptr=NULL ;
 246    if ( ( ptr = find_envir( TSD, name ) ) == NULL )
 247       return 0;
 248    return ptr->e.subcomed;
 249 }
 250
 251 static void del_envirpart( const tsd_t *TSD, environpart *e )
 252 /* Deletes all allocated parts of the environpart e.
 253  * The names are set to NULL afterwards, thus allowing multiple calls.
 254  */
 255 {
 256    if ( e->name )
 257       Free_stringTSD( e->name ) ;
 258    if ( e->base )
 259       Free_stringTSD( e->base ) ;
 260    if ( e->currname )
 261       Free_stringTSD( e->currname ) ;
 262    e->name =
 263    e->base =
 264    e->currname = NULL;
 265    /* Temporary files must be deleted under all circumstances! */
 266    cleanup_envirpart(TSD, e);
 267 }
 268
 269 void del_envir( tsd_t *TSD, const streng *name )
 270 /* Deletes all allocated parts of the environment with the given name and
 271  * removes it from the linked list.
 272  */
 273 {
 274    struct envir *ptr=NULL ;
 275
 276    ptr = find_envir( TSD, name ) ;
 277 #if defined(_AMIGA) || defined(__AROS__)
 278    /* Amiga environments may not be deleted */
 279    if (ptr && ptr->type == ENVIR_AMIGA)
 280       return;
 281 #endif
 282    if (!ptr)
 283       return;
 284
 285    if (ptr->prev)
 286       ptr->prev->next = ptr->next ;
 287    if (ptr->next)
 288       ptr->next->prev = ptr->prev ;
 289    if (TSD->firstenvir==ptr)
 290       TSD->firstenvir = ptr->prev ;
 291
 292    /* Delete the names in the environment */
 293    if ( ptr->e.name )
 294       Free_stringTSD( ptr->e.name ) ;
 295    del_envirpart( TSD, &ptr->e.input ) ;
 296    del_envirpart( TSD, &ptr->e.output ) ;
 297    del_envirpart( TSD, &ptr->e.error ) ;
 298    FreeTSD( ptr ) ;
 299 }
 300
 301 static void update_environpart( const tsd_t *TSD, environpart *e, const nodeptr newptr)
 302 /* e is the environpart which has to be reset. new is the new part and has
 303  * to been valid. new->name may be NULL (for NORMAL behaviour).
 304  */
 305 {
 306    del_envirpart( TSD, e ) ;
 307
 308    if (newptr->name)
 309    {
 310       e->name = Str_dupTSD( newptr->name ) ;
 311       e->base = Str_makeTSD( 3*sizeof(int) ) ;
 312    }
 313
 314    e->flags = newptr->u.of ;
 315    clear_environpart(e);
 316 }
 317
 318 int set_envir( const tsd_t *TSD, const streng *envirname, const nodeptr ios )
 319 /* This function sets all three IO-redirections INPUT, OUTPUT and ERROR.
 320  * ios->p[0] must be the redirection of INPUT,
 321  * ios->p[1] must be the redirection of OUTPUT,
 322  * ios->p[2] must be the redirection of ERROR
 323  * ios==NULL || envirname==NULL --> don't do anything.
 324  * ios->p[x]==NULL --> don't touch this redirection.
 325  * ios->p[x].name may be NULL (for NORMAL behaviour).
 326  *
 327  * The types of all four nodes may or may not be X_ADDR_WITH.
 328  *
 329  * returns 1 on success, 0 if the envirname doesn't exist.
 330  */
 331 {
 332    struct envir *e;
 333
 334    if ( ( envirname == NULL ) || ( ios == NULL ) )
 335       return 1;
 336
 337    if ( ( e = find_envir( TSD, envirname ) ) == NULL )
 338       return 0;
 339    if (ios->p[0]) update_environpart( TSD, &e->e.input,  ios->p[0] );
 340    if (ios->p[1]) update_environpart( TSD, &e->e.output, ios->p[1] );
 341    if (ios->p[2]) update_environpart( TSD, &e->e.error,  ios->p[2] );
 342    e->e.input.flags.isinput = 1;
 343    e->e.error.flags.iserror = 1;
 344
 345    return 1;
 346 }
 347
 348 static void dup_environpart( const tsd_t *TSD, environpart *dest,
 349                                  const nodeptr prefer, const environpart *src )
 350 /* Copies src to dest if prefer isn't set. In this case prefer is used.
 351  */
 352 {
 353    if (prefer)
 354       update_environpart( TSD, dest, prefer ) ;
 355    else
 356    {
 357       if (src->name)
 358       {
 359          dest->name = Str_dupTSD( src->name ) ;
 360          dest->base = Str_makeTSD( 3*sizeof(int) ) ;
 361       }
 362       dest->flags = src->flags ;
 363    }
 364    clear_environpart(dest);
 365 }
 366
 367 static struct envir *dup_envir( tsd_t *TSD, const streng *name, cnodeptr ios )
 368 /* This functions returns a new instance of the environment with the given
 369  * name or NULL if there is not such an environment name.
 370  * The current IO-redirection settings are overwritten with the
 371  * environment parts given in ios->p[0..2] for INPUT, OUTPUT and ERROR.
 372  */
 373 {
 374    struct envir *prev, *newptr;
 375
 376    if ( ( prev = find_envir( TSD, name ) ) == NULL )
 377       return NULL;
 378
 379    add_envir( TSD, name, prev->type, prev->e.subtype );
 380    newptr = (struct envir *)TSD->firstenvir;
 381
 382    dup_environpart( TSD, &newptr->e.input,  ios->p[0], &prev->e.input  );
 383    dup_environpart( TSD, &newptr->e.output, ios->p[1], &prev->e.output );
 384    dup_environpart( TSD, &newptr->e.error,  ios->p[2], &prev->e.error  );
 385    newptr->e.input.flags.isinput = 1;
 386    newptr->e.error.flags.iserror = 1;
 387
 388    return newptr;
 389 }
 390
 391 int init_envir( tsd_t *TSD )
 392 {
 393    static const struct {
 394       const char *name ;
 395       int         subtype ;
 396    } locals[] = {
 397       { "COMMAND",        SUBENVIR_PATH    } , /* was SUBENVIR_COMMAND */
 398       { "SYSTEM",         SUBENVIR_SYSTEM  } ,
 399       { "OS2ENVIRONMENT", SUBENVIR_SYSTEM  } ,
 400       { "ENVIRONMENT",    SUBENVIR_SYSTEM  } ,
 401       { "CMD",            SUBENVIR_PATH    } , /* was SUBENVIR_COMMAND */
 402       { "PATH",           SUBENVIR_PATH    } ,
 403       { "REGINA",         SUBENVIR_REXX    } ,
 404       { "REXX",           SUBENVIR_REXX    }
 405    };
 406    unsigned i;
 407    streng *tmp;
 408
 409    for ( i = 0; i < sizeof(locals) / sizeof(locals[0]); i++ )
 410    {
 411       tmp = Str_creTSD( locals[i].name ) ;
 412       add_envir( TSD, tmp, ENVIR_SHELL, locals[i].subtype ) ;
 413       Free_stringTSD( tmp ) ;
 414    }
 415 #ifdef TRACEMEM
 416    regmarker( TSD, markenvir ) ;
 417 #endif
 418    return(1);
 419 }
 420
 421
 422 static int get_io_flag( tsd_t *TSD, streng *command, streng **rxqueue )
 423 {
 424    int length=0, i=0, pos=0 ;
 425    int flag=0,have_space=0 ;
 426    int qname_start,qname_end;
 427    streng *tmpq=NULL;
 428
 429    flag = REDIR_NONE ;
 430    /*
 431     * All I/O redirection valid with INTERNAL queues only
 432     */
 433    if ((length=Str_len(command)) > 5
 434    &&  (get_options_flag( TSD->currlevel, EXT_INTERNAL_QUEUES )
 435       ||   external_queues_used( TSD ) == 0 ) )
 436    {
 437       if ((!memcmp(command->value,"lifo>",5)) ||
 438           (!memcmp(command->value,"LIFO>",5)))
 439                flag |= REDIR_INPUT ;
 440
 441       if ((!memcmp(command->value+length-5,">lifo",5))
 442       ||  (!memcmp(command->value+length-5,">LIFO",5)))
 443       {
 444          flag |= REDIR_OUTLIFO ;
 445          command->len -= 5;
 446       }
 447       else
 448       {
 449          if ( ( !memcmp( command->value+length-5, ">fifo" ,5 ) )
 450          ||   ( !memcmp( command->value+length-5, ">FIFO", 5 ) ) )
 451          {
 452             flag |= REDIR_OUTFIFO ;
 453             command->len -= 5;
 454          }
 455          else
 456          {
 457             if ( length >= 8 )
 458             {
 459                for ( i = 0, pos = -1; i < length; i++ )
 460                {
 461                   if ( *(command->value + i ) == '|' )
 462                   {
 463                      pos = i;
 464                      /* don't break here, as we want the last '|' */
 465                   }
 466                }
 467                if ( pos != -1 )
 468                {
 469                   /* allow "|" [whitespace] "rxqueue" [whitespace[args]] */
 470                   /* "|" already checked */
 471                   for ( i = pos + 1; i < length; i++ )
 472                   {
 473                      if ( !rx_isspace(command->value[i] ) )
 474                         break;
 475                   }
 476                   if ( i+7 <= length )
 477                   {
 478                      if (mem_cmpic( command->value + i, "RXQUEUE", 7 ) == 0 )
 479                      {
 480                         i += 7;
 481                         for ( ; i < length; i++ )
 482                         {
 483                            if ( !rx_isspace( command->value[i] ) )
 484                               break;
 485                            have_space = 1;
 486                         }
 487                         if ( i == length )
 488                         {
 489                             flag |= REDIR_OUTFIFO ;
 490                             command->len = pos;
 491                         }
 492                         else if ( have_space )
 493                         {
 494                             if ( *(command->value + i) == '/' )
 495                             {
 496                                /*
 497                                 * Only a switch, not a queuename
 498                                 */
 499                                if ( i+6 <= length
 500                                &&   mem_cmpic( command->value + i, "/CLEAR", 6 ) == 0 )
 501                                {
 502                                   flag |= REDIR_CLEAR;
 503                                   flag |= REDIR_OUTFIFO ;
 504                                }
 505                                else if ( i+5 <= length )
 506                                {
 507                                   if (mem_cmpic( command->value + i, "/FIFO", 5 ) == 0 )
 508                                      flag |= REDIR_OUTFIFO ;
 509                                   else if (mem_cmpic( command->value + i, "/LIFO", 5 ) == 0 )
 510                                      flag |= REDIR_OUTLIFO ;
 511                                   else
 512                                      flag |= REDIR_OUTFIFO ;
 513                                   /*
 514                                    * Let the queue name be determined by the caller
 515                                    */
 516                                }
 517                             }
 518                             else
 519                             {
 520                                /*
 521                                 * First word must be a queue name, optionally
 522                                 * followed by a switch
 523                                 */
 524                                have_space = 0;
 525                                qname_start = i;
 526                                for ( ; i < length; i++ )
 527                                {
 528                                   if ( rx_isspace( command->value[i] ) )
 529                                   {
 530                                      have_space = 1;
 531                                      qname_end = i;
 532                                      /*
 533                                       * Get queuename from RXQUEUE env
 534                                       * variable, or if not set, use SESSION
 535                                       */
 536                                      tmpq = Str_make_TSD( TSD, qname_end - qname_start );
 537                                      tmpq->len = qname_end - qname_start;
 538                                      memcpy( tmpq->value, command->value + qname_start, qname_end - qname_start );
 539                                      break;
 540                                   }
 541                                }
 542                                if ( have_space )
 543                                {
 544                                   /*
 545                                    * Eat up all spaces. If we have
 546                                    * any non-spaces left, it should be
 547                                    * a switch
 548                                    */
 549                                   for ( ; i < length; i++ )
 550                                   {
 551                                      if ( !rx_isspace( command->value[i] ) )
 552                                         break;
 553                                   }
 554                                   if ( i+6 <= length
 555                                   &&   mem_cmpic( command->value + i, "/CLEAR", 6 ) == 0 )
 556                                   {
 557                                      flag |= REDIR_CLEAR;
 558                                      flag |= REDIR_OUTFIFO ;
 559                                   }
 560                                   else if ( i+5 <= length )
 561                                   {
 562                                      if (mem_cmpic( command->value + i, "/FIFO", 5 ) == 0 )
 563                                         flag |= REDIR_OUTFIFO ;
 564                                      else if (mem_cmpic( command->value + i, "/LIFO", 5 ) == 0 )
 565                                         flag |= REDIR_OUTLIFO ;
 566                                      else
 567                                         flag |= REDIR_OUTFIFO ;
 568                                   }
 569                                }
 570                                else
 571                                {
 572                                   /*
 573                                    * Only have a queue name
 574                                    */
 575                                   tmpq = Str_make_TSD( TSD, length - qname_start );
 576                                   tmpq->len = length - qname_start;
 577                                   memcpy( tmpq->value, command->value + qname_start, length - qname_start );
 578                                   flag |= REDIR_OUTFIFO ;
 579                                }
 580                             }
 581                             command->len = pos;
 582                         }
 583                      }
 584                   }
 585                }
 586             }
 587          }
 588       }
 589    }
 590
 591    if (flag & REDIR_INPUT)
 592    {
 593       for(i=5; i<Str_len(command); i++ ) /* avoid buffer overrun */
 594          command->value[i-5]=command->value[i] ;
 595       command->len -= 5 ;
 596    }
 597    *rxqueue = tmpq;
 598    return flag ;
 599 }
 600
 601 /*
 602  * ANSI 8.2.4 and 8.3.5 and others forces us to set some variables showing
 603  * the result and to raise some conditions in case of errors after
 604  * processing an external command.
 605  */
 606 void post_process_system_call( tsd_t *TSD, const streng *cmd,
 607                                int rc_code, const streng *rc_value,
 608                                cnodeptr thisptr )
 609 {
 610    int rs;
 611    trap *traps;
 612    int type;
 613
 614    /*
 615     * ANSI 8.2.4 etc. forces us to do the following.
 616     *
 617     * 10-08-2004 MH interpreted 8.2.4 as only being applicable to
 618     * clauses entered at the interactive prompt.
 619     */
 620 #if 0
 621    if ( !TSD->systeminfo->interactive )
 622 #endif
 623    {
 624       if ( rc_value != NULL )
 625          set_reserved_value( TSD, POOL0_RC, Str_dupTSD( rc_value ), 0,
 626                              VFLAG_STR );
 627       else
 628          set_reserved_value( TSD, POOL0_RC, NULL, rc_code, VFLAG_NUM );
 629    }
 630
 631    /* set .RS: -1==Failure, 0=OK, 1=Error */
 632    if ( rc_code == 0 )
 633       rs = 0;
 634    else if ( rc_code < 0 )
 635       rs = -1;
 636    else
 637       rs = 1;
 638    set_reserved_value( TSD, POOL0_RS, NULL, rs, VFLAG_NUM );
 639
 640    /* ARexx OPTIONS RESULTS */
 641    if ( get_options_flag( TSD->currlevel, EXT_RESULTS ) )
 642    {
 643       if ( rc_code == 0 )
 644          set_reserved_value( TSD, POOL0_RESULT, Str_dupTSD( rc_value ), 0, VFLAG_STR );
 645       else
 646          set_reserved_value( TSD, POOL0_RESULT, NULL, 0, VFLAG_NONE );
 647    }
 648
 649    if ( rc_code )
 650    {
 651       traceerror( TSD, thisptr, rc_code );
 652       traps = gettraps( TSD, TSD->currlevel );
 653       type = ( rc_code > 0 ) ? SIGNAL_ERROR : SIGNAL_FAILURE;
 654
 655       if ( traps[type].on_off )
 656          condition_hook( TSD, type, rc_code, 0, thisptr->lineno, Str_dupTSD( cmd ), NULL );
 657    }
 658 }
 659
 660 streng *perform( tsd_t *TSD, const streng *command, const streng *envir, cnodeptr thisptr, cnodeptr overwrite )
 661 /* If and only if overwrite is set, a new instance of the environment is
 662  * temporarily created and reset to the new IO-redirections.
 663  */
 664 {
 665    int rc=0, io_flag=0, clearq=0, tempenvir=0;
 666    struct envir *eptr;
 667    streng *retstr=NULL ;
 668    streng *rxqueue=NULL;
 669    streng *cmd=Str_dupTSD(command);
 670    streng *saved_queue=NULL;
 671    char *rxq=NULL;
 672
 673    if ( overwrite )
 674    {
 675       /*
 676        * fixes bug 653214, overwrite was this->p[1] in former versions, which
 677        * was wrong is this wasn't an ADDRESS statement.
 678        */
 679       if (( eptr = dup_envir( TSD, envir, overwrite ) ) != NULL)
 680          tempenvir = 1;
 681    }
 682    else
 683    {
 684       eptr = find_envir( TSD, envir ) ;
 685    }
 686
 687    if (eptr)
 688    {
 689       if ( TSD->restricted
 690       &&   eptr->e.subtype )
 691          exiterror( ERR_RESTRICTED, 5 )  ;
 692       switch (eptr->type)
 693       {
 694          case ENVIR_PIPE:
 695             retstr = SubCom( TSD, cmd, envir, &rc ) ;
 696             break ;
 697
 698          case ENVIR_SHELL:
 699             io_flag = get_io_flag( TSD, cmd, &rxqueue ) ;
 700             /*
 701              * Save the current queue name
 702              * Then change it to the value of rxqueue
 703              * Only for internal queues
 704              */
 705             if ( get_options_flag( TSD->currlevel, EXT_INTERNAL_QUEUES ) )
 706             {
 707                /*
 708                 * If no queuename specified,
 709                 * get queuename from RXQUEUE env
 710                 * variable, or if not set, use SESSION
 711                 */
 712                if ( rxqueue == NULL )
 713                {
 714                   if ( ( rxq = getenv("RXQUEUE") ) == NULL )
 715                   {
 716                      rxqueue = Str_cre_TSD( TSD, "SESSION" );
 717                   }
 718                   else
 719                   {
 720                      rxqueue = Str_cre_TSD( TSD, rxq );
 721                   }
 722                }
 723                saved_queue = set_queue( TSD, rxqueue );
 724                if ( io_flag & REDIR_CLEAR )
 725                {
 726                   clearq = 1;
 727                   io_flag -= REDIR_CLEAR;
 728                }
 729             }
 730             rc = posix_do_command( TSD, cmd, io_flag, &eptr->e, NULL ) ;
 731             /*
 732              * Change the current queue name back
 733              * to the saved name
 734              */
 735             if ( get_options_flag( TSD->currlevel, EXT_INTERNAL_QUEUES ) )
 736             {
 737                if ( clearq )
 738                   drop_buffer( TSD, 0 ) ;
 739                set_queue( TSD, saved_queue );
 740                if ( rxqueue != NULL )
 741                   Free_stringTSD( rxqueue );
 742             }
 743             retstr = int_to_streng( TSD, rc ) ;
 744             break ;
 745
 746 #if defined(_AMIGA) || defined(__AROS__)
 747          case ENVIR_AMIGA:
 748             retstr = AmigaSubCom( TSD, cmd, eptr, &rc);
 749             break;
 750 #endif
 751
 752          default:
 753              exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;
 754       }
 755    }
 756    else
 757    {
 758       retstr = SubCom( TSD, cmd, envir, &rc ) ;
 759    }
 760
 761    if (tempenvir)
 762       del_envir( TSD, envir ) ;
 763
 764    post_process_system_call( TSD, cmd, rc, retstr, thisptr );
 765
 766    Free_stringTSD( cmd ) ;
 767    return retstr ;
 768 }
 769
 770 /* run_popen is a special implementation of a direct call to posix_do_command.
 771  * It redirects input and error to "normal" and fetches the output.
 772  * This output has blanks as line-delimiters. All lines are returned
 773  * concatenated on success; NULL is returned if an errors occurs.
 774  * The global variable "RC" contains the return code of the called process.
 775  *
 776  * The command is executed in the current environment. If the environment
 777  * isn't a standard environment, SYSTEM is used.
 778  */
 779 streng *run_popen( tsd_t *TSD, const streng *command, const streng *envir )
 780 {
 781    int rc;
 782    streng *retval;
 783    struct envir *ptr=NULL ;
 784    Queue *q ;
 785
 786    for ( ptr = (struct envir *)TSD->firstenvir; ptr; ptr = ptr->prev )
 787    {
 788       if ( ( ptr->type == ENVIR_SHELL ) && ( Str_cmp( ptr->e.name, envir ) == 0 ) )
 789          break;
 790    }
 791    if ( ptr == NULL )
 792    {
 793       retval = Str_creTSD( "SYSTEM" ); /* temporary misuse */
 794       ptr = find_envir( TSD, retval );
 795       Free_stringTSD( retval ) ;
 796    }
 797
 798    /* Create a new environment with no redirections. */
 799    add_envir(TSD, ptr->e.name, ENVIR_SHELL, ptr->e.subtype);
 800
 801    q = find_free_slot( TSD ) ;
 802    q->type = QisTemp;
 803    rc = posix_do_command(TSD, command, REDIR_OUTSTRING, (environment *)TSD->firstenvir, q ) ;
 804    retval = stack_to_line( TSD, q ) ;
 805
 806    /* restore the previous environment and delete the temporary one */
 807    del_envir(TSD, ptr->e.name);
 808
 809    set_reserved_value( TSD, POOL0_RC, NULL, rc, VFLAG_NUM );
 810
 811    if (rc >= 0)
 812       return(retval);
 813
 814    /* rc shows an error while calling: */
 815    Free_stringTSD(retval);
 816    return(NULL);
 817 }