This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
amigaos4: better popen() + pclose() implementation
[perl5.git] / 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 }