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