amigaos4/amigaio.c

   1 /* amigaio.c mixes amigaos and perl APIs,
   2  * as opposed to amigaos.c which is pure amigaos */
   3
   4 #include "EXTERN.h"
   5 #include "perl.h"
   6
   7 #include "amigaos4/amigaio.h"
   8 #include "amigaos.h"
   9
  10 #ifdef WORD
  11 #  undef WORD
  12 #  define WORD int16
  13 #endif
  14
  15 #include <stdio.h>
  16
  17 #include <exec/semaphores.h>
  18 #include <exec/exectags.h>
  19 #include <proto/exec.h>
  20 #include <proto/dos.h>
  21 #include <proto/utility.h>
  22 #include <dos/dos.h>
  23
  24 void amigaos_stdio_get(pTHX_ StdioStore *store)
  25 {
  26         store->astdin =
  27             amigaos_get_file(PerlIO_fileno(IoIFP(GvIO(PL_stdingv))));
  28         store->astderr =
  29             amigaos_get_file(PerlIO_fileno(IoIFP(GvIO(PL_stderrgv))));
  30         store->astdout = amigaos_get_file(
  31                              PerlIO_fileno(IoIFP(GvIO(gv_fetchpv("STDOUT", TRUE, SVt_PVIO)))));
  32 }
  33
  34 void amigaos_stdio_save(pTHX_ StdioStore *store)
  35 {
  36         amigaos_stdio_get(aTHX_ store);
  37         store->oldstdin = IDOS->SelectInput(store->astdin);
  38         store->oldstderr = IDOS->SelectErrorOutput(store->astderr);
  39         store->oldstdout = IDOS->SelectOutput(store->astdout);
  40 }
  41
  42 void amigaos_stdio_restore(pTHX_ const StdioStore *store)
  43 {
  44         IDOS->SelectInput(store->oldstdin);
  45         IDOS->SelectErrorOutput(store->oldstderr);
  46         IDOS->SelectOutput(store->oldstdout);
  47 }
  48
  49 void amigaos_post_exec(int fd, int do_report)
  50 {
  51         /* We *must* write something to our pipe or else
  52          * the other end hangs */
  53         if (do_report)
  54         {
  55                 int e = errno;
  56                 PerlLIO_write(fd, (void *)&e, sizeof(e));
  57                 PerlLIO_close(fd);
  58         }
  59 }
  60
  61 PerlIO *Perl_my_popen(pTHX_ const char *cmd, const char *mode)
  62 {
  63         PERL_FLUSHALL_FOR_CHILD;
  64         /* Call system's popen() to get a FILE *, then import it.
  65          * used 0 for 2nd parameter to PerlIO_importFILE;
  66          * apparently not used
  67         */
  68         //    FILE *f=amigaos_popen(cmd,mode);
  69         //    fprintf(stderr,"popen returned %d\n",f);
  70         return PerlIO_importFILE(amigaos_popen(cmd, mode), mode);
  71         //   return PerlIO_importFILE(f, 0);
  72 }
  73
  74 I32 Perl_my_pclose(pTHX_ PerlIO *ptr)
  75 {
  76         FILE * const f = PerlIO_findFILE(ptr);
  77         const I32 result = amigaos_pclose(f);
  78         PerlIO_releaseFILE(ptr,f);
  79         return result;
  80 }
  81
  82 #ifdef USE_ITHREADS
  83
  84 /* An arbitrary number to start with, should work out what the real max should
  85  * be */
  86
  87 #ifndef MAX_THREADS
  88 #  define MAX_THREADS 64
  89 #endif
  90
  91 #define REAPED 0
  92 #define ACTIVE 1
  93 #define EXITED -1
  94
  95 struct thread_info
  96 {
  97         pthread_t ti_pid;
  98         int ti_children;
  99         pthread_t ti_parent;
 100         struct MsgPort *ti_port;
 101         struct Process *ti_Process;
 102 };
 103
 104 static struct thread_info pseudo_children[MAX_THREADS];
 105 static int num_pseudo_children = 0;
 106 static struct SignalSemaphore fork_array_sema;
 107
 108 void amigaos4_init_fork_array()
 109 {
 110         IExec->InitSemaphore(&fork_array_sema);
 111         pseudo_children[0].ti_pid = (pthread_t)IExec->FindTask(0);
 112         pseudo_children[0].ti_parent = -1;
 113         pseudo_children[0].ti_port =
 114             (struct MsgPort *)IExec->AllocSysObjectTags(ASOT_PORT, TAG_DONE);
 115 }
 116
 117 void amigaos4_dispose_fork_array()
 118 {
 119         while (pseudo_children[0].ti_children > 0)
 120         {
 121                 void *msg;
 122                 IExec->WaitPort(pseudo_children[0].ti_port);
 123                 msg = IExec->GetMsg(pseudo_children[0].ti_port);
 124                 if (msg)
 125                         IExec->FreeSysObject(ASOT_MESSAGE, msg);
 126                 pseudo_children[0].ti_children--;
 127         }
 128         IExec->FreeSysObject(ASOT_PORT, pseudo_children[0].ti_port);
 129 }
 130
 131 struct thread_exit_message
 132 {
 133         struct Message tem_Message;
 134         pthread_t tem_pid;
 135         int tem_status;
 136 };
 137
 138 int getnextchild()
 139 {
 140         int i;
 141         for (i = 0; i < MAX_THREADS; i++)
 142         {
 143                 if (pseudo_children[i].ti_pid == 0)
 144                         return i;
 145         }
 146         return -1;
 147 }
 148
 149 int findparent(pthread_t pid)
 150 {
 151         int i;
 152         for (i = 0; i < MAX_THREADS; i++)
 153         {
 154                 if (pseudo_children[i].ti_pid == pid)
 155                         return i;
 156         }
 157         return -1;
 158 }
 159
 160 struct child_arg
 161 {
 162         struct Task *ca_parent_task;
 163         pthread_t ca_parent;
 164         PerlInterpreter *ca_interp;
 165 };
 166
 167 #undef kill
 168
 169 /* FIXME: Is here's a chance, albeit it small of a clash between our pseudo pid */
 170 /* derived from the pthread API  and the dos.library pid that newlib kill uses? */
 171 /* clib2 used the Process address so there was no issue */
 172
 173 int amigaos_kill(Pid_t pid, int signal)
 174 {
 175         int i;
 176         BOOL thistask = FALSE;
 177         Pid_t realpid = pid; // Perhaps we have a real pid from else where?
 178         /* Look for our DOS pid */
 179         IExec->ObtainSemaphore(&fork_array_sema);
 180         for (i = 0; i < MAX_THREADS; i++)
 181         {
 182                 if (pseudo_children[i].ti_pid == pid)
 183                 {
 184                         realpid = (Pid_t)IDOS->GetPID(pseudo_children[i].ti_Process,GPID_PROCESS);
 185                         if(pseudo_children[i].ti_Process == IExec->FindTask(NULL))
 186                         {
 187                                 thistask = TRUE;
 188                         }
 189                         break;
 190                 }
 191         }
 192         IExec->ReleaseSemaphore(&fork_array_sema);
 193         /* Allow the C library to work out which signals are realy valid */
 194         if(thistask)
 195         {
 196                 /* A quirk in newlib kill handling means it's better to call raise() rather than kill on out own task. */
 197                 return raise(signal);
 198         }
 199         else
 200         {
 201                 return kill(realpid,signal);
 202         }
 203 }
 204
 205 static THREAD_RET_TYPE amigaos4_start_child(void *arg)
 206 {
 207
 208         PerlInterpreter *my_perl =
 209             (PerlInterpreter *)((struct child_arg *)arg)->ca_interp;
 210         ;
 211
 212         GV *tmpgv;
 213         int status;
 214         int parent;
 215         int nextchild;
 216         pthread_t pseudo_id = pthread_self();
 217
 218 #ifdef PERL_SYNC_FORK
 219         static long sync_fork_id = 0;
 220         long id = ++sync_fork_id;
 221 #endif
 222
 223         /* before we do anything set up our process semaphore and add
 224            a new entry to the pseudochildren */
 225
 226         /* get next available slot */
 227         /* should not fail here! */
 228
 229         IExec->ObtainSemaphore(&fork_array_sema);
 230
 231         nextchild = getnextchild();
 232
 233         pseudo_children[nextchild].ti_pid = pseudo_id;
 234         pseudo_children[nextchild].ti_Process = (struct Process *)IExec->FindTask(NULL);
 235         pseudo_children[nextchild].ti_parent =
 236             ((struct child_arg *)arg)->ca_parent;
 237         pseudo_children[nextchild].ti_port =
 238             (struct MsgPort *)IExec->AllocSysObjectTags(ASOT_PORT, TAG_DONE);
 239
 240         num_pseudo_children++;
 241         IExec->ReleaseSemaphore(&fork_array_sema);
 242
 243         /* We're set up let the parent continue */
 244
 245         IExec->Signal(((struct child_arg *)arg)->ca_parent_task,
 246                       SIGBREAKF_CTRL_F);
 247
 248         PERL_SET_THX(my_perl);
 249         if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV)))
 250         {
 251                 SV *sv = GvSV(tmpgv);
 252                 SvREADONLY_off(sv);
 253                 sv_setiv(sv, (IV)pseudo_id);
 254                 SvREADONLY_on(sv);
 255         }
 256         hv_clear(PL_pidstatus);
 257
 258         /* push a zero on the stack (we are the child) */
 259         {
 260                 dSP;
 261                 dTARGET;
 262                 PUSHi(0);
 263                 PUTBACK;
 264         }
 265
 266         /* continue from next op */
 267         PL_op = PL_op->op_next;
 268
 269         {
 270                 dJMPENV;
 271                 volatile int oldscope = PL_scopestack_ix;
 272
 273 restart:
 274                 JMPENV_PUSH(status);
 275                 switch (status)
 276                 {
 277                 case 0:
 278                         CALLRUNOPS(aTHX);
 279                         status = 0;
 280                         break;
 281                 case 2:
 282                         while (PL_scopestack_ix > oldscope)
 283                         {
 284                                 LEAVE;
 285                         }
 286                         FREETMPS;
 287                         PL_curstash = PL_defstash;
 288                         if (PL_endav && !PL_minus_c)
 289                                 call_list(oldscope, PL_endav);
 290                         status = STATUS_EXIT;
 291                         break;
 292                 case 3:
 293                         if (PL_restartop)
 294                         {
 295                                 POPSTACK_TO(PL_mainstack);
 296                                 PL_op = PL_restartop;
 297                                 PL_restartop = (OP *)NULL;
 298                                 ;
 299                                 goto restart;
 300                         }
 301                         PerlIO_printf(Perl_error_log, "panic: restartop\n");
 302                         FREETMPS;
 303                         status = 1;
 304                         break;
 305                 }
 306                 JMPENV_POP;
 307
 308                 /* XXX hack to avoid perl_destruct() freeing optree */
 309                 PL_main_root = (OP *)NULL;
 310         }
 311
 312         {
 313                 do_close(PL_stdingv, FALSE);
 314                 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO),
 315                          FALSE); /* PL_stdoutgv - ISAGN */
 316                 do_close(PL_stderrgv, FALSE);
 317         }
 318
 319         /* destroy everything (waits for any pseudo-forked children) */
 320
 321         /* wait for any remaining children */
 322
 323         while (pseudo_children[nextchild].ti_children > 0)
 324         {
 325                 if (IExec->WaitPort(pseudo_children[nextchild].ti_port))
 326                 {
 327                         void *msg =
 328                             IExec->GetMsg(pseudo_children[nextchild].ti_port);
 329                         IExec->FreeSysObject(ASOT_MESSAGE, msg);
 330                         pseudo_children[nextchild].ti_children--;
 331                 }
 332         }
 333         if (PL_scopestack_ix <= 1)
 334         {
 335                 perl_destruct(my_perl);
 336         }
 337         perl_free(my_perl);
 338
 339         IExec->ObtainSemaphore(&fork_array_sema);
 340         parent = findparent(pseudo_children[nextchild].ti_parent);
 341         pseudo_children[nextchild].ti_pid = 0;
 342         pseudo_children[nextchild].ti_parent = 0;
 343         IExec->FreeSysObject(ASOT_PORT, pseudo_children[nextchild].ti_port);
 344         pseudo_children[nextchild].ti_port = NULL;
 345
 346         IExec->ReleaseSemaphore(&fork_array_sema);
 347
 348         {
 349                 if (parent >= 0)
 350                 {
 351                         struct thread_exit_message *tem =
 352                             (struct thread_exit_message *)
 353                             IExec->AllocSysObjectTags(
 354                                 ASOT_MESSAGE, ASOMSG_Size,
 355                                 sizeof(struct thread_exit_message),
 356                                 ASOMSG_Length,
 357                                 sizeof(struct thread_exit_message));
 358                         if (tem)
 359                         {
 360                                 tem->tem_pid = pseudo_id;
 361                                 tem->tem_status = status;
 362                                 IExec->PutMsg(pseudo_children[parent].ti_port,
 363                                               (struct Message *)tem);
 364                         }
 365                 }
 366         }
 367 #ifdef PERL_SYNC_FORK
 368         return id;
 369 #else
 370         return (void *)status;
 371 #endif
 372 }
 373
 374 #endif /* USE_ITHREADS */
 375
 376 Pid_t amigaos_fork()
 377 {
 378         dTHX;
 379         pthread_t id;
 380         int handle;
 381         struct child_arg arg;
 382         if (num_pseudo_children >= MAX_THREADS)
 383         {
 384                 errno = EAGAIN;
 385                 return -1;
 386         }
 387         arg.ca_interp = perl_clone((PerlInterpreter *)aTHX, CLONEf_COPY_STACKS);
 388         arg.ca_parent_task = IExec->FindTask(NULL);
 389         arg.ca_parent =
 390             pthread_self() ? pthread_self() : (pthread_t)IExec->FindTask(0);
 391
 392         handle = pthread_create(&id, NULL, amigaos4_start_child, (void *)&arg);
 393         pseudo_children[findparent(arg.ca_parent)].ti_children++;
 394
 395         IExec->Wait(SIGBREAKF_CTRL_F);
 396
 397         PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
 398         if (handle)
 399         {
 400                 errno = EAGAIN;
 401                 return -1;
 402         }
 403         return id;
 404 }
 405
 406 Pid_t amigaos_waitpid(pTHX_ int optype, Pid_t pid, void *argflags)
 407 {
 408         int result;
 409         if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
 410         {
 411                 result = pthread_join(pid, argflags);
 412         }
 413         else
 414         {
 415                 while ((result = pthread_join(pid, argflags)) == -1 &&
 416                         errno == EINTR)
 417                 {
 418                         //          PERL_ASYNC_CHECK();
 419                 }
 420         }
 421         return result;
 422 }
 423
 424 void amigaos_fork_set_userdata(
 425     pTHX_ struct UserData *userdata, I32 did_pipes, int pp, SV **sp, SV **mark)
 426 {
 427         userdata->parent = IExec->FindTask(0);
 428         userdata->did_pipes = did_pipes;
 429         userdata->pp = pp;
 430         userdata->sp = sp;
 431         userdata->mark = mark;
 432         userdata->my_perl = aTHX;
 433 }
 434
 435 /* AmigaOS specific versions of #?exec#? solely for use in amigaos_system_child
 436  */
 437
 438 static void S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
 439 {
 440         const int e = errno;
 441 //    PERL_ARGS_ASSERT_EXEC_FAILED;
 442         if (e)
 443         {
 444                 if (ckWARN(WARN_EXEC))
 445                         Perl_warner(aTHX_ packWARN(WARN_EXEC),
 446                                     "Can't exec \"%s\": %s", cmd, Strerror(e));
 447         }
 448         if (do_report)
 449         {
 450                 /* XXX silently ignore failures */
 451                 PERL_UNUSED_RESULT(PerlLIO_write(fd, (void *)&e, sizeof(int)));
 452                 PerlLIO_close(fd);
 453         }
 454 }
 455
 456 static I32 S_do_amigaos_exec3(pTHX_ const char *incmd, int fd, int do_report)
 457 {
 458         dVAR;
 459         const char **a;
 460         char *s;
 461         char *buf;
 462         char *cmd;
 463         /* Make a copy so we can change it */
 464         const Size_t cmdlen = strlen(incmd) + 1;
 465         I32 result = -1;
 466
 467         PERL_ARGS_ASSERT_DO_EXEC3;
 468
 469         Newx(buf, cmdlen, char);
 470         cmd = buf;
 471         memcpy(cmd, incmd, cmdlen);
 472
 473         while (*cmd && isSPACE(*cmd))
 474                 cmd++;
 475
 476         /* see if there are shell metacharacters in it */
 477
 478         if (*cmd == '.' && isSPACE(cmd[1]))
 479                 goto doshell;
 480
 481         if (strnEQ(cmd, "exec", 4) && isSPACE(cmd[4]))
 482                 goto doshell;
 483
 484         s = cmd;
 485         while (isWORDCHAR(*s))
 486                 s++; /* catch VAR=val gizmo */
 487         if (*s == '=')
 488                 goto doshell;
 489
 490         for (s = cmd; *s; s++)
 491         {
 492                 if (*s != ' ' && !isALPHA(*s) &&
 493                         strchr("$&*(){}[]'\";\\|?<>~`\n", *s))
 494                 {
 495                         if (*s == '\n' && !s[1])
 496                         {
 497                                 *s = '\0';
 498                                 break;
 499                         }
 500                         /* handle the 2>&1 construct at the end */
 501                         if (*s == '>' && s[1] == '&' && s[2] == '1' &&
 502                                 s > cmd + 1 && s[-1] == '2' && isSPACE(s[-2]) &&
 503                                 (!s[3] || isSPACE(s[3])))
 504                         {
 505                                 const char *t = s + 3;
 506
 507                                 while (*t && isSPACE(*t))
 508                                         ++t;
 509                                 if (!*t && (PerlLIO_dup2(1, 2) != -1))
 510                                 {
 511                                         s[-2] = '\0';
 512                                         break;
 513                                 }
 514                         }
 515 doshell:
 516                         PERL_FPU_PRE_EXEC
 517                         result = myexecl(FALSE, PL_sh_path, "sh", "-c", cmd,
 518                                          (char *)NULL);
 519                         PERL_FPU_POST_EXEC
 520                         S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
 521                         amigaos_post_exec(fd, do_report);
 522                         Safefree(buf);
 523                         return result;
 524                 }
 525         }
 526
 527         Newx(PL_Argv, (s - cmd) / 2 + 2, const char *);
 528         PL_Cmd = savepvn(cmd, s - cmd);
 529         a = PL_Argv;
 530         for (s = PL_Cmd; *s;)
 531         {
 532                 while (isSPACE(*s))
 533                         s++;
 534                 if (*s)
 535                         *(a++) = s;
 536                 while (*s && !isSPACE(*s))
 537                         s++;
 538                 if (*s)
 539                         *s++ = '\0';
 540         }
 541         *a = NULL;
 542         if (PL_Argv[0])
 543         {
 544                 PERL_FPU_PRE_EXEC
 545                 result = myexecvp(FALSE, PL_Argv[0], EXEC_ARGV_CAST(PL_Argv));
 546                 PERL_FPU_POST_EXEC
 547                 if (errno == ENOEXEC)
 548                 {
 549                         /* for system V NIH syndrome */
 550                         do_execfree();
 551                         goto doshell;
 552                 }
 553                 S_exec_failed(aTHX_ PL_Argv[0], fd, do_report);
 554                 amigaos_post_exec(fd, do_report);
 555         }
 556         do_execfree();
 557         Safefree(buf);
 558         return result;
 559 }
 560
 561 I32 S_do_amigaos_aexec5(
 562     pTHX_ SV *really, SV **mark, SV **sp, int fd, int do_report)
 563 {
 564         dVAR;
 565         I32 result = -1;
 566         PERL_ARGS_ASSERT_DO_AEXEC5;
 567         if (sp > mark)
 568         {
 569                 const char **a;
 570                 const char *tmps = NULL;
 571                 Newx(PL_Argv, sp - mark + 1, const char *);
 572                 a = PL_Argv;
 573
 574                 while (++mark <= sp)
 575                 {
 576                         if (*mark)
 577                                 *a++ = SvPV_nolen_const(*mark);
 578                         else
 579                                 *a++ = "";
 580                 }
 581                 *a = NULL;
 582                 if (really)
 583                         tmps = SvPV_nolen_const(really);
 584                 if ((!really && *PL_Argv[0] != '/') ||
 585                         (really && *tmps != '/')) /* will execvp use PATH? */
 586                         TAINT_ENV(); /* testing IFS here is overkill, probably
 587                                         */
 588                 PERL_FPU_PRE_EXEC
 589                 if (really && *tmps)
 590                 {
 591                         result = myexecvp(FALSE, tmps, EXEC_ARGV_CAST(PL_Argv));
 592                 }
 593                 else
 594                 {
 595                         result = myexecvp(FALSE, PL_Argv[0],
 596                                           EXEC_ARGV_CAST(PL_Argv));
 597                 }
 598                 PERL_FPU_POST_EXEC
 599                 S_exec_failed(aTHX_(really ? tmps : PL_Argv[0]), fd, do_report);
 600         }
 601         amigaos_post_exec(fd, do_report);
 602         do_execfree();
 603         return result;
 604 }
 605
 606 void *amigaos_system_child(void *userdata)
 607 {
 608         struct Task *parent;
 609         I32 did_pipes;
 610         int pp;
 611         I32 value;
 612         STRLEN n_a;
 613         /* these next are declared by macros else where but I may be
 614          * passing modified values here so declare them explictly but
 615          * still referred to by macro below */
 616
 617         register SV **sp;
 618         register SV **mark;
 619         register PerlInterpreter *my_perl;
 620
 621         StdioStore store;
 622
 623         struct UserData *ud = (struct UserData *)userdata;
 624
 625         did_pipes = ud->did_pipes;
 626         parent = ud->parent;
 627         pp = ud->pp;
 628         SP = ud->sp;
 629         MARK = ud->mark;
 630         my_perl = ud->my_perl;
 631         PERL_SET_THX(my_perl);
 632
 633         amigaos_stdio_save(aTHX_ & store);
 634
 635         if (did_pipes)
 636         {
 637                 //    PerlLIO_close(pp[0]);
 638         }
 639         if (PL_op->op_flags & OPf_STACKED)
 640         {
 641                 SV *really = *++MARK;
 642                 value = (I32)S_do_amigaos_aexec5(aTHX_ really, MARK, SP, pp,
 643                                                  did_pipes);
 644         }
 645         else if (SP - MARK != 1)
 646         {
 647                 value = (I32)S_do_amigaos_aexec5(aTHX_ NULL, MARK, SP, pp,
 648                                                  did_pipes);
 649         }
 650         else
 651         {
 652                 value = (I32)S_do_amigaos_exec3(
 653                             aTHX_ SvPVx(sv_mortalcopy(*SP), n_a), pp, did_pipes);
 654         }
 655
 656         //    Forbid();
 657         //    Signal(parent, SIGBREAKF_CTRL_F);
 658
 659         amigaos_stdio_restore(aTHX_ & store);
 660
 661         return value;
 662 }
 663
 664 static BOOL contains_whitespace(char *string)
 665 {
 666
 667         if (string)
 668         {
 669
 670                 if (strchr(string, ' '))
 671                         return TRUE;
 672                 if (strchr(string, '\t'))
 673                         return TRUE;
 674                 if (strchr(string, '\n'))
 675                         return TRUE;
 676                 if (strchr(string, 0xA0))
 677                         return TRUE;
 678                 if (strchr(string, '"'))
 679                         return TRUE;
 680         }
 681         return FALSE;
 682 }
 683
 684 static int no_of_escapes(char *string)
 685 {
 686         int cnt = 0;
 687         char *p;
 688         for (p = string; p < string + strlen(string); p++)
 689         {
 690                 if (*p == '"')
 691                         cnt++;
 692                 if (*p == '*')
 693                         cnt++;
 694                 if (*p == '\n')
 695                         cnt++;
 696                 if (*p == '\t')
 697                         cnt++;
 698         }
 699         return cnt;
 700 }
 701
 702 struct command_data
 703 {
 704         STRPTR args;
 705         BPTR seglist;
 706         struct Task *parent;
 707 };
 708
 709 #undef fopen
 710 #undef fgetc
 711 #undef fgets
 712 #undef fclose
 713
 714 #define __USE_RUNCOMMAND__
 715
 716 int myexecve(bool isperlthread,
 717              const char *filename,
 718              char *argv[],
 719              char *envp[])
 720 {
 721         FILE *fh;
 722         char buffer[1000];
 723         int size = 0;
 724         char **cur;
 725         char *interpreter = 0;
 726         char *interpreter_args = 0;
 727         char *full = 0;
 728         char *filename_conv = 0;
 729         char *interpreter_conv = 0;
 730         //        char *tmp = 0;
 731         char *fname;
 732         //        int tmpint;
 733         //        struct Task *thisTask = IExec->FindTask(0);
 734         int result = -1;
 735
 736         StdioStore store;
 737
 738         pTHX = NULL;
 739
 740         if (isperlthread)
 741         {
 742                 aTHX = PERL_GET_THX;
 743                 /* Save away our stdio */
 744                 amigaos_stdio_save(aTHX_ & store);
 745         }
 746
 747         // adebug("%s %ld %s\n",__FUNCTION__,__LINE__,filename?filename:"NULL");
 748
 749         /* Calculate the size of filename and all args, including spaces and
 750          * quotes */
 751         size = 0; // strlen(filename) + 1;
 752         for (cur = (char **)argv /* +1 */; *cur; cur++)
 753         {
 754                 size +=
 755                     strlen(*cur) + 1 +
 756                     (contains_whitespace(*cur) ? (2 + no_of_escapes(*cur)) : 0);
 757         }
 758         /* Check if it's a script file */
 759         IExec->DebugPrintF("%s %ld %08lx %c %c\n",__FILE__,__LINE__,filename,filename[0],filename[1]);
 760         fh = fopen(filename, "r");
 761         if (fh)
 762         {
 763                 if (fgetc(fh) == '#' && fgetc(fh) == '!')
 764                 {
 765                         char *p;
 766                         char *q;
 767                         fgets(buffer, 999, fh);
 768                         p = buffer;
 769                         while (*p == ' ' || *p == '\t')
 770                                 p++;
 771                         if (buffer[strlen(buffer) - 1] == '\n')
 772                                 buffer[strlen(buffer) - 1] = '\0';
 773                         if ((q = strchr(p, ' ')))
 774                         {
 775                                 *q++ = '\0';
 776                                 if (*q != '\0')
 777                                 {
 778                                         interpreter_args = mystrdup(q);
 779                                 }
 780                         }
 781                         else
 782                                 interpreter_args = mystrdup("");
 783
 784                         interpreter = mystrdup(p);
 785                         size += strlen(interpreter) + 1;
 786                         size += strlen(interpreter_args) + 1;
 787                 }
 788
 789                 fclose(fh);
 790         }
 791         else
 792         {
 793                 /* We couldn't open this why not? */
 794                 if (errno == ENOENT)
 795                 {
 796                         /* file didn't exist! */
 797                         goto out;
 798                 }
 799         }
 800
 801         /* Allocate the command line */
 802         filename_conv = convert_path_u2a(filename);
 803
 804         if (filename_conv)
 805                 size += strlen(filename_conv);
 806         size += 1;
 807         full = (char *)IExec->AllocVec(size + 10, MEMF_ANY | MEMF_CLEAR);
 808         if (full)
 809         {
 810                 if (interpreter)
 811                 {
 812                         interpreter_conv = convert_path_u2a(interpreter);
 813 #if !defined(__USE_RUNCOMMAND__)
 814 #warning(using system!)
 815                         sprintf(full, "%s %s %s ", interpreter_conv,
 816                                 interpreter_args, filename_conv);
 817 #else
 818                         sprintf(full, "%s %s ", interpreter_args,
 819                                 filename_conv);
 820 #endif
 821                         IExec->FreeVec(interpreter);
 822                         IExec->FreeVec(interpreter_args);
 823
 824                         if (filename_conv)
 825                                 IExec->FreeVec(filename_conv);
 826                         fname = mystrdup(interpreter_conv);
 827
 828                         if (interpreter_conv)
 829                                 IExec->FreeVec(interpreter_conv);
 830                 }
 831                 else
 832                 {
 833 #ifndef __USE_RUNCOMMAND__
 834                         sprintf(full, "%s ", filename_conv);
 835 #else
 836                         sprintf(full, "");
 837 #endif
 838                         fname = mystrdup(filename_conv);
 839                         if (filename_conv)
 840                                 IExec->FreeVec(filename_conv);
 841                 }
 842
 843                 for (cur = (char **)(argv + 1); *cur != 0; cur++)
 844                 {
 845                         if (contains_whitespace(*cur))
 846                         {
 847                                 int esc = no_of_escapes(*cur);
 848
 849                                 if (esc > 0)
 850                                 {
 851                                         char *buff = (char *)IExec->AllocVec(
 852                                                          strlen(*cur) + 4 + esc,
 853                                                          MEMF_ANY | MEMF_CLEAR);
 854                                         char *p = *cur;
 855                                         char *q = buff;
 856
 857                                         *q++ = '"';
 858                                         while (*p != '\0')
 859                                         {
 860
 861                                                 if (*p == '\n')
 862                                                 {
 863                                                         *q++ = '*';
 864                                                         *q++ = 'N';
 865                                                         p++;
 866                                                         continue;
 867                                                 }
 868                                                 else if (*p == '"')
 869                                                 {
 870                                                         *q++ = '*';
 871                                                         *q++ = '"';
 872                                                         p++;
 873                                                         continue;
 874                                                 }
 875                                                 else if (*p == '*')
 876                                                 {
 877                                                         *q++ = '*';
 878                                                 }
 879                                                 *q++ = *p++;
 880                                         }
 881                                         *q++ = '"';
 882                                         *q++ = ' ';
 883                                         *q = '\0';
 884                                         strcat(full, buff);
 885                                         IExec->FreeVec(buff);
 886                                 }
 887                                 else
 888                                 {
 889                                         strcat(full, "\"");
 890                                         strcat(full, *cur);
 891                                         strcat(full, "\" ");
 892                                 }
 893                         }
 894                         else
 895                         {
 896                                 strcat(full, *cur);
 897                                 strcat(full, " ");
 898                         }
 899                 }
 900                 strcat(full, "\n");
 901
 902 //            if(envp)
 903 //                 createvars(envp);
 904
 905 #ifndef __USE_RUNCOMMAND__
 906                 result = IDOS->SystemTags(
 907                              full, SYS_UserShell, TRUE, NP_StackSize,
 908                              ((struct Process *)thisTask)->pr_StackSize, SYS_Input,
 909                              ((struct Process *)thisTask)->pr_CIS, SYS_Output,
 910                              ((struct Process *)thisTask)->pr_COS, SYS_Error,
 911                              ((struct Process *)thisTask)->pr_CES, TAG_DONE);
 912 #else
 913
 914                 if (fname)
 915                 {
 916                         BPTR seglist = IDOS->LoadSeg(fname);
 917                         if (seglist)
 918                         {
 919                                 /* check if we have an executable! */
 920                                 struct PseudoSegList *ps = NULL;
 921                                 if (!IDOS->GetSegListInfoTags(
 922                                             seglist, GSLI_Native, &ps, TAG_DONE))
 923                                 {
 924                                         IDOS->GetSegListInfoTags(
 925                                             seglist, GSLI_68KPS, &ps, TAG_DONE);
 926                                 }
 927                                 if (ps != NULL)
 928                                 {
 929                                         //                    adebug("%s %ld %s
 930                                         //                    %s\n",__FUNCTION__,__LINE__,fname,full);
 931                                         IDOS->SetCliProgramName(fname);
 932                                         //                        result=RunCommand(seglist,8*1024,full,strlen(full));
 933                                         //                        result=myruncommand(seglist,8*1024,full,strlen(full),envp);
 934                                         result = myruncommand(seglist, 8 * 1024,
 935                                                               full, -1, envp);
 936                                         errno = 0;
 937                                 }
 938                                 else
 939                                 {
 940                                         errno = ENOEXEC;
 941                                 }
 942                                 IDOS->UnLoadSeg(seglist);
 943                         }
 944                         else
 945                         {
 946                                 errno = ENOEXEC;
 947                         }
 948                         IExec->FreeVec(fname);
 949                 }
 950
 951 #endif /* USE_RUNCOMMAND */
 952
 953                 IExec->FreeVec(full);
 954                 if (errno == ENOEXEC)
 955                 {
 956                         result = -1;
 957                 }
 958                 goto out;
 959         }
 960
 961         if (interpreter)
 962                 IExec->FreeVec(interpreter);
 963         if (filename_conv)
 964                 IExec->FreeVec(filename_conv);
 965
 966         errno = ENOMEM;
 967
 968 out:
 969         if (isperlthread)
 970         {
 971                 amigaos_stdio_restore(aTHX_ & store);
 972                 STATUS_NATIVE_CHILD_SET(result);
 973                 PL_exit_flags |= PERL_EXIT_EXPECTED;
 974                 if (result != -1)
 975                         my_exit(result);
 976         }
 977         return (result);
 978 }