This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
8e26064f08f5a62077f2ea8dd8811fb1a4b99971
[perl5.git] / amigaos4 / amigaos.c
1 /* amigaos.c uses only amigaos APIs,
2  * as opposed to amigaio.c which mixes amigaos and perl APIs */
3
4 #include <string.h>
5
6 #include <sys/stat.h>
7 #include <unistd.h>
8 #include <assert.h>
9
10 #include <errno.h>
11 #include <stdio.h>
12 #include <stdlib.h>
13 #if defined(__CLIB2__)
14 #  include <dos.h>
15 #endif
16 #if defined(__NEWLIB__)
17 #  include <amiga_platform.h>
18 #endif
19 #include <fcntl.h>
20 #include <ctype.h>
21 #include <stdarg.h>
22 #include <stdbool.h>
23 #undef WORD
24 #define WORD int16
25
26 #include <dos/dos.h>
27 #include <proto/dos.h>
28 #include <proto/exec.h>
29 #include <proto/utility.h>
30
31 #include "amigaos.h"
32
33 struct UtilityIFace *IUtility = NULL;
34
35 /***************************************************************************/
36
37 struct Interface *OpenInterface(CONST_STRPTR libname, uint32 libver)
38 {
39         struct Library *base = IExec->OpenLibrary(libname, libver);
40         struct Interface *iface = IExec->GetInterface(base, "main", 1, NULL);
41         if (iface == NULL)
42         {
43                 // We should probably post some kind of error message here.
44
45                 IExec->CloseLibrary(base);
46         }
47
48         return iface;
49 }
50
51 /***************************************************************************/
52
53 void CloseInterface(struct Interface *iface)
54 {
55         if (iface != NULL)
56         {
57                 struct Library *base = iface->Data.LibBase;
58                 IExec->DropInterface(iface);
59                 IExec->CloseLibrary(base);
60         }
61 }
62
63 BOOL __unlink_retries = FALSE;
64
65 void ___makeenviron() __attribute__((constructor));
66 void ___freeenviron() __attribute__((destructor));
67
68 void ___openinterfaces() __attribute__((constructor));
69 void ___closeinterfaces() __attribute__((destructor));
70
71 void ___openinterfaces()
72 {
73         if (!IDOS)
74                 IDOS = (struct DOSIFace *)OpenInterface("dos.library", 53);
75         if (!IUtility)
76                 IUtility =
77                     (struct UtilityIFace *)OpenInterface("utility.library", 53);
78 }
79
80 void ___closeinterfaces()
81 {
82         CloseInterface((struct Interface *)IDOS);
83         CloseInterface((struct Interface *)IUtility);
84 }
85 int VARARGS68K araddebug(UBYTE *fmt, ...);
86 int VARARGS68K adebug(UBYTE *fmt, ...);
87
88 #define __USE_RUNCOMMAND__
89
90 char **myenviron = NULL;
91 char **origenviron = NULL;
92
93 static void createvars(char **envp);
94
95 struct args
96 {
97         BPTR seglist;
98         int stack;
99         char *command;
100         int length;
101         int result;
102         char **envp;
103 };
104
105 int __myrc(char *arg)
106 {
107         struct Task *thisTask = IExec->FindTask(0);
108         struct args *myargs = (struct args *)thisTask->tc_UserData;
109         if (myargs->envp)
110                 createvars(myargs->envp);
111         // adebug("%s %ld %s \n",__FUNCTION__,__LINE__,myargs->command);
112         myargs->result = IDOS->RunCommand(myargs->seglist, myargs->stack,
113                                           myargs->command, myargs->length);
114         return 0;
115 }
116
117 int32 myruncommand(
118     BPTR seglist, int stack, char *command, int length, char **envp)
119 {
120         struct args myargs;
121         struct Task *thisTask = IExec->FindTask(0);
122         struct Process *proc;
123
124         // adebug("%s %ld  %s\n",__FUNCTION__,__LINE__,command?command:"NULL");
125
126         myargs.seglist = seglist;
127         myargs.stack = stack;
128         myargs.command = command;
129         myargs.length = length;
130         myargs.result = -1;
131         myargs.envp = envp;
132
133         if ((proc = IDOS->CreateNewProcTags(
134                  NP_Entry, __myrc, NP_Child, TRUE, NP_Input, IDOS->Input(),
135                  NP_Output, IDOS->Output(), NP_Error, IDOS->ErrorOutput(),
136                  NP_CloseInput, FALSE, NP_CloseOutput, FALSE, NP_CloseError,
137                  FALSE, NP_CopyVars, FALSE,
138
139                  //           NP_StackSize,           ((struct Process
140                  //           *)myargs.parent)->pr_StackSize,
141                  NP_Cli, TRUE, NP_UserData, (int)&myargs,
142                  NP_NotifyOnDeathSigTask, thisTask, TAG_DONE)))
143
144         {
145                 IExec->Wait(SIGF_CHILD);
146         }
147         return myargs.result;
148 }
149
150 char *mystrdup(const char *s)
151 {
152         char *result = NULL;
153         size_t size;
154
155         size = strlen(s) + 1;
156
157         if ((result = (char *)IExec->AllocVec(size, MEMF_ANY)))
158         {
159                 memmove(result, s, size);
160         }
161         return result;
162 }
163
164 static int pipenum = 0;
165
166 int pipe(int filedes[2])
167 {
168         char pipe_name[1024];
169
170 //   adebug("%s %ld \n",__FUNCTION__,__LINE__);
171 #ifdef USE_TEMPFILES
172         sprintf(pipe_name, "/T/%x.%08lx", pipenum++, IUtility->GetUniqueID());
173 #else
174         sprintf(pipe_name, "/PIPE/%x%08lx/4096/0", pipenum++,
175                 IUtility->GetUniqueID());
176 #endif
177
178         /*      printf("pipe: %s \n", pipe_name);*/
179
180         filedes[1] = open(pipe_name, O_WRONLY | O_CREAT);
181         filedes[0] = open(pipe_name, O_RDONLY);
182         if (filedes[0] == -1 || filedes[1] == -1)
183         {
184                 if (filedes[0] != -1)
185                         close(filedes[0]);
186                 if (filedes[1] != -1)
187                         close(filedes[1]);
188                 return -1;
189         }
190         /*      printf("filedes %d %d\n", filedes[0],
191          * filedes[1]);fflush(stdout);*/
192
193         return 0;
194 }
195
196 int fork(void)
197 {
198         fprintf(stderr, "Can not bloody fork\n");
199         errno = ENOMEM;
200         return -1;
201 }
202
203 int wait(int *status)
204 {
205         fprintf(stderr, "No wait try waitpid instead\n");
206         errno = ECHILD;
207         return -1;
208 }
209
210 char *convert_path_a2u(const char *filename)
211 {
212         struct NameTranslationInfo nti;
213
214         if (!filename)
215         {
216                 return 0;
217         }
218
219         __translate_amiga_to_unix_path_name(&filename, &nti);
220
221         return mystrdup(filename);
222 }
223 char *convert_path_u2a(const char *filename)
224 {
225         struct NameTranslationInfo nti;
226
227         if (!filename)
228         {
229                 return 0;
230         }
231
232         if (strcmp(filename, "/dev/tty") == 0)
233         {
234                 return mystrdup("CONSOLE:");
235                 ;
236         }
237
238         __translate_unix_to_amiga_path_name(&filename, &nti);
239
240         return mystrdup(filename);
241 }
242
243 static struct SignalSemaphore environ_sema;
244
245 void amigaos4_init_environ_sema() { IExec->InitSemaphore(&environ_sema); }
246
247 void amigaos4_obtain_environ() { IExec->ObtainSemaphore(&environ_sema); }
248
249 void amigaos4_release_environ() { IExec->ReleaseSemaphore(&environ_sema); }
250
251 static void createvars(char **envp)
252 {
253         if (envp)
254         {
255                 /* Set a local var to indicate to any subsequent sh that it is
256                 * not
257                 * the top level shell and so should only inherit local amigaos
258                 * vars */
259                 IDOS->SetVar("ABCSH_IMPORT_LOCAL", "TRUE", 5, GVF_LOCAL_ONLY);
260
261                 amigaos4_obtain_environ();
262
263                 envp = myenviron;
264
265                 while ((envp != NULL) && (*envp != NULL))
266                 {
267                         int len;
268                         char *var;
269                         char *val;
270                         if ((len = strlen(*envp)))
271                         {
272                                 if ((var = (char *)IExec->AllocVec(
273                                          len + 1, MEMF_ANY | MEMF_CLEAR)))
274                                 {
275                                         strcpy(var, *envp);
276
277                                         val = strchr(var, '=');
278                                         if (val)
279                                         {
280                                                 *val++ = '\0';
281                                                 if (*val)
282                                                 {
283                                                         IDOS->SetVar(
284                                                             var, val,
285                                                             strlen(val) + 1,
286                                                             GVF_LOCAL_ONLY);
287                                                 }
288                                         }
289                                         IExec->FreeVec(var);
290                                 }
291                         }
292                         envp++;
293                 }
294                 amigaos4_release_environ();
295         }
296 }
297
298 static BOOL contains_whitespace(char *string)
299 {
300
301         if (string)
302         {
303
304                 if (strchr(string, ' '))
305                         return TRUE;
306                 if (strchr(string, '\t'))
307                         return TRUE;
308                 if (strchr(string, '\n'))
309                         return TRUE;
310                 if (strchr(string, 0xA0))
311                         return TRUE;
312                 if (strchr(string, '"'))
313                         return TRUE;
314         }
315         return FALSE;
316 }
317
318 static int no_of_escapes(char *string)
319 {
320         int cnt = 0;
321         char *p;
322         for (p = string; p < string + strlen(string); p++)
323         {
324                 if (*p == '"')
325                         cnt++;
326                 if (*p == '*')
327                         cnt++;
328                 if (*p == '\n')
329                         cnt++;
330                 if (*p == '\t')
331                         cnt++;
332         }
333         return cnt;
334 }
335
336 struct command_data
337 {
338         STRPTR args;
339         BPTR seglist;
340         struct Task *parent;
341 };
342
343 int myexecvp(bool isperlthread, const char *filename, char *argv[])
344 {
345         //      adebug("%s %ld
346         //%s\n",__FUNCTION__,__LINE__,filename?filename:"NULL");
347         /* if there's a slash or a colon consider filename a path and skip
348          * search */
349         int res;
350         if ((strchr(filename, '/') == NULL) && (strchr(filename, ':') == NULL))
351         {
352                 char *path;
353                 char *name;
354                 char *pathpart;
355                 char *p;
356                 size_t len;
357                 struct stat st;
358
359                 if (!(path = getenv("PATH")))
360                 {
361                         path = ".:/bin:/usr/bin:/c";
362                 }
363
364                 len = strlen(filename) + 1;
365                 name = (char *)alloca(strlen(path) + len);
366                 pathpart = (char *)alloca(strlen(path) + 1);
367                 p = path;
368                 do
369                 {
370                         path = p;
371
372                         if (!(p = strchr(path, ':')))
373                         {
374                                 p = strchr(path, '\0');
375                         }
376
377                         memcpy(pathpart, path, p - path);
378                         pathpart[p - path] = '\0';
379                         if (!(strlen(pathpart) == 0))
380                         {
381                                 sprintf(name, "%s/%s", pathpart, filename);
382                         }
383                         else
384                                 sprintf(name, "%s", filename);
385
386                         if ((stat(name, &st) == 0) && (S_ISREG(st.st_mode)))
387                         {
388                                 /* we stated it and it's a regular file */
389                                 /* let's boogie! */
390                                 filename = name;
391                                 break;
392                         }
393
394                 } while (*p++ != '\0');
395         }
396         res = myexecve(isperlthread, filename, argv, myenviron);
397         return res;
398 }
399
400 int myexecv(bool isperlthread, const char *path, char *argv[])
401 {
402         return myexecve(isperlthread, path, argv, myenviron);
403 }
404
405 int myexecl(bool isperlthread, const char *path, ...)
406 {
407         va_list va;
408         char *argv[1024]; /* 1024 enough? let's hope so! */
409         int i = 0;
410         // adebug("%s %ld\n",__FUNCTION__,__LINE__);
411
412         va_start(va, path);
413         i = 0;
414
415         do
416         {
417                 argv[i] = va_arg(va, char *);
418         } while (argv[i++] != NULL);
419
420         va_end(va);
421         return myexecve(isperlthread, path, argv, myenviron);
422 }
423
424 #if 0
425
426 int myexecve(const char *filename, char *argv[], char *envp[])
427 {
428         FILE *fh;
429         char buffer[1000];
430         int size = 0;
431         char **cur;
432         char *interpreter = 0;
433         char *interpreter_args = 0;
434         char *full = 0;
435         char *filename_conv = 0;
436         char *interpreter_conv = 0;
437         //        char *tmp = 0;
438         char *fname;
439         //        int tmpint;
440         //        struct Task *thisTask = IExec->FindTask(0);
441         int result = -1;
442
443         StdioStore store;
444
445                 dTHX;
446                 if(aTHX) // I hope this is NULL when not on a interpreteer thread nor to level.
447                 {
448                         /* Save away our stdio */
449                 amigaos_stdio_save(aTHX_ & store);
450                 }
451
452         // adebug("%s %ld %s\n",__FUNCTION__,__LINE__,filename?filename:"NULL");
453
454         /* Calculate the size of filename and all args, including spaces and
455          * quotes */
456         size = 0; // strlen(filename) + 1;
457         for (cur = (char **)argv /* +1 */; *cur; cur++)
458         {
459                 size +=
460                     strlen(*cur) + 1 +
461                     (contains_whitespace(*cur) ? (2 + no_of_escapes(*cur)) : 0);
462         }
463         /* Check if it's a script file */
464
465         fh = fopen(filename, "r");
466         if (fh)
467         {
468                 if (fgetc(fh) == '#' && fgetc(fh) == '!')
469                 {
470                         char *p;
471                         char *q;
472                         fgets(buffer, 999, fh);
473                         p = buffer;
474                         while (*p == ' ' || *p == '\t')
475                                 p++;
476                         if (buffer[strlen(buffer) - 1] == '\n')
477                                 buffer[strlen(buffer) - 1] = '\0';
478                         if ((q = strchr(p, ' ')))
479                         {
480                                 *q++ = '\0';
481                                 if (*q != '\0')
482                                 {
483                                         interpreter_args = mystrdup(q);
484                                 }
485                         }
486                         else
487                                 interpreter_args = mystrdup("");
488
489                         interpreter = mystrdup(p);
490                         size += strlen(interpreter) + 1;
491                         size += strlen(interpreter_args) + 1;
492                 }
493
494                 fclose(fh);
495         }
496         else
497         {
498                 /* We couldn't open this why not? */
499                 if (errno == ENOENT)
500                 {
501                         /* file didn't exist! */
502                                                 goto out;
503                 }
504         }
505
506         /* Allocate the command line */
507         filename_conv = convert_path_u2a(filename);
508
509         if (filename_conv)
510                 size += strlen(filename_conv);
511         size += 1;
512         full = (char *)IExec->AllocVec(size + 10, MEMF_ANY | MEMF_CLEAR);
513         if (full)
514         {
515                 if (interpreter)
516                 {
517                         interpreter_conv = convert_path_u2a(interpreter);
518 #if !defined(__USE_RUNCOMMAND__)
519 #warning(using system!)
520                         sprintf(full, "%s %s %s ", interpreter_conv,
521                                 interpreter_args, filename_conv);
522 #else
523                         sprintf(full, "%s %s ", interpreter_args,
524                                 filename_conv);
525 #endif
526                         IExec->FreeVec(interpreter);
527                         IExec->FreeVec(interpreter_args);
528
529                         if (filename_conv)
530                                 IExec->FreeVec(filename_conv);
531                         fname = mystrdup(interpreter_conv);
532
533                         if (interpreter_conv)
534                                 IExec->FreeVec(interpreter_conv);
535                 }
536                 else
537                 {
538 #ifndef __USE_RUNCOMMAND__
539                         sprintf(full, "%s ", filename_conv);
540 #else
541                         sprintf(full, "");
542 #endif
543                         fname = mystrdup(filename_conv);
544                         if (filename_conv)
545                                 IExec->FreeVec(filename_conv);
546                 }
547
548                 for (cur = (char **)(argv + 1); *cur != 0; cur++)
549                 {
550                         if (contains_whitespace(*cur))
551                         {
552                                 int esc = no_of_escapes(*cur);
553
554                                 if (esc > 0)
555                                 {
556                                         char *buff = IExec->AllocVec(
557                                             strlen(*cur) + 4 + esc,
558                                             MEMF_ANY | MEMF_CLEAR);
559                                         char *p = *cur;
560                                         char *q = buff;
561
562                                         *q++ = '"';
563                                         while (*p != '\0')
564                                         {
565
566                                                 if (*p == '\n')
567                                                 {
568                                                         *q++ = '*';
569                                                         *q++ = 'N';
570                                                         p++;
571                                                         continue;
572                                                 }
573                                                 else if (*p == '"')
574                                                 {
575                                                         *q++ = '*';
576                                                         *q++ = '"';
577                                                         p++;
578                                                         continue;
579                                                 }
580                                                 else if (*p == '*')
581                                                 {
582                                                         *q++ = '*';
583                                                 }
584                                                 *q++ = *p++;
585                                         }
586                                         *q++ = '"';
587                                         *q++ = ' ';
588                                         *q = '\0';
589                                         strcat(full, buff);
590                                         IExec->FreeVec(buff);
591                                 }
592                                 else
593                                 {
594                                         strcat(full, "\"");
595                                         strcat(full, *cur);
596                                         strcat(full, "\" ");
597                                 }
598                         }
599                         else
600                         {
601                                 strcat(full, *cur);
602                                 strcat(full, " ");
603                         }
604                 }
605                 strcat(full, "\n");
606
607 //            if(envp)
608 //                 createvars(envp);
609
610 #ifndef __USE_RUNCOMMAND__
611                 result = IDOS->SystemTags(
612                     full, SYS_UserShell, TRUE, NP_StackSize,
613                     ((struct Process *)thisTask)->pr_StackSize, SYS_Input,
614                     ((struct Process *)thisTask)->pr_CIS, SYS_Output,
615                     ((struct Process *)thisTask)->pr_COS, SYS_Error,
616                     ((struct Process *)thisTask)->pr_CES, TAG_DONE);
617 #else
618
619                 if (fname)
620                 {
621                         BPTR seglist = IDOS->LoadSeg(fname);
622                         if (seglist)
623                         {
624                                 /* check if we have an executable! */
625                                 struct PseudoSegList *ps = NULL;
626                                 if (!IDOS->GetSegListInfoTags(
627                                         seglist, GSLI_Native, &ps, TAG_DONE))
628                                 {
629                                         IDOS->GetSegListInfoTags(
630                                             seglist, GSLI_68KPS, &ps, TAG_DONE);
631                                 }
632                                 if (ps != NULL)
633                                 {
634                                         //                    adebug("%s %ld %s
635                                         //                    %s\n",__FUNCTION__,__LINE__,fname,full);
636                                         IDOS->SetCliProgramName(fname);
637                                         //                        result=RunCommand(seglist,8*1024,full,strlen(full));
638                                         //                        result=myruncommand(seglist,8*1024,full,strlen(full),envp);
639                                         result = myruncommand(seglist, 8 * 1024,
640                                                               full, -1, envp);
641                                         errno = 0;
642                                 }
643                                 else
644                                 {
645                                         errno = ENOEXEC;
646                                 }
647                                 IDOS->UnLoadSeg(seglist);
648                         }
649                         else
650                         {
651                                 errno = ENOEXEC;
652                         }
653                         IExec->FreeVec(fname);
654                 }
655
656 #endif /* USE_RUNCOMMAND */
657
658                 IExec->FreeVec(full);
659                 if (errno == ENOEXEC)
660                 {
661                                         result = -1;
662                 }
663                 goto out;
664         }
665
666         if (interpreter)
667                 IExec->FreeVec(interpreter);
668         if (filename_conv)
669                 IExec->FreeVec(filename_conv);
670
671         errno = ENOMEM;
672
673 out:
674
675     amigaos_stdio_restore(aTHX_ &store);
676     STATUS_NATIVE_CHILD_SET(result);
677     PL_exit_flags |= PERL_EXIT_EXPECTED;
678     if (result != -1) my_exit(result);
679
680         return(result);
681 }
682
683 #endif
684
685 int pause(void)
686 {
687         fprintf(stderr, "Pause not implemented\n");
688
689         errno = EINTR;
690         return -1;
691 }
692
693 uint32 size_env(struct Hook *hook, APTR userdata, struct ScanVarsMsg *message)
694 {
695         if (strlen(message->sv_GDir) <= 4)
696         {
697                 hook->h_Data = (APTR)(((uint32)hook->h_Data) + 1);
698         }
699         return 0;
700 }
701
702 uint32 copy_env(struct Hook *hook, APTR userdata, struct ScanVarsMsg *message)
703 {
704         if (strlen(message->sv_GDir) <= 4)
705         {
706                 char **env = (char **)hook->h_Data;
707                 uint32 size =
708                     strlen(message->sv_Name) + 1 + message->sv_VarLen + 1 + 1;
709                 char *buffer = (char *)IExec->AllocVec((uint32)size,
710                                                        MEMF_ANY | MEMF_CLEAR);
711
712                 snprintf(buffer, size - 1, "%s=%s", message->sv_Name,
713                          message->sv_Var);
714
715                 *env = buffer;
716                 env++;
717                 hook->h_Data = env;
718         }
719         return 0;
720 }
721
722 void ___makeenviron()
723 {
724         struct Hook hook;
725
726         char varbuf[8];
727         uint32 flags = 0;
728
729         struct DOSIFace *myIDOS =
730             (struct DOSIFace *)OpenInterface("dos.library", 53);
731         if (myIDOS)
732         {
733                 if (myIDOS->GetVar("ABCSH_IMPORT_LOCAL", varbuf, 8,
734                                    GVF_LOCAL_ONLY) > 0)
735                 {
736                         flags = GVF_LOCAL_ONLY;
737                 }
738                 else
739                 {
740                         flags = GVF_GLOBAL_ONLY;
741                 }
742
743                 hook.h_Entry = size_env;
744                 hook.h_Data = 0;
745
746                 myIDOS->ScanVars(&hook, flags, 0);
747                 hook.h_Data = (APTR)(((uint32)hook.h_Data) + 1);
748
749                 myenviron = (char **)IExec->AllocVec((uint32)hook.h_Data *
750                                                          sizeof(char **),
751                                                      MEMF_ANY | MEMF_CLEAR);
752                 origenviron = myenviron;
753                 if (!myenviron)
754                 {
755                         return;
756                 }
757                 hook.h_Entry = copy_env;
758                 hook.h_Data = myenviron;
759
760                 myIDOS->ScanVars(&hook, flags, 0);
761                 CloseInterface((struct Interface *)myIDOS);
762         }
763 }
764
765 void ___freeenviron()
766 {
767         char **i;
768         /* perl might change environ, it puts it back except for ctrl-c */
769         /* so restore our own copy here */
770         struct DOSIFace *myIDOS =
771             (struct DOSIFace *)OpenInterface("dos.library", 53);
772         if (myIDOS)
773         {
774                 myenviron = origenviron;
775
776                 if (myenviron)
777                 {
778                         for (i = myenviron; *i != NULL; i++)
779                         {
780                                 IExec->FreeVec(*i);
781                         }
782                         IExec->FreeVec(myenviron);
783                         myenviron = NULL;
784                 }
785                 CloseInterface((struct Interface *)myIDOS);
786         }
787 }
788
789 /* reimplementation of popen, clib2's doesn't do all we want */
790
791 static BOOL is_final_quote_character(const char *str)
792 {
793         BOOL result;
794
795         result = (BOOL)(str[0] == '\"' && (str[1] == '\0' || isspace(str[1])));
796
797         return (result);
798 }
799
800 static BOOL is_final_squote_character(const char *str)
801 {
802         BOOL result;
803
804         result = (BOOL)(str[0] == '\'' && (str[1] == '\0' || isspace(str[1])));
805
806         return (result);
807 }
808
809 int popen_child()
810 {
811         struct Task *thisTask = IExec->FindTask(0);
812
813         char *command = (char *)thisTask->tc_UserData;
814         size_t len;
815         char *str;
816         int argc;
817         int number_of_arguments;
818         char *argv[4];
819
820         argv[0] = "sh";
821         argv[1] = "-c";
822         argv[2] = command ? command : NULL;
823         argv[3] = NULL;
824
825         // adebug("%s %ld  %s\n",__FUNCTION__,__LINE__,command?command:"NULL");
826
827         /* We need to give this to sh via execvp, execvp expects filename,
828          * argv[]
829          */
830
831         myexecvp(FALSE, argv[0], argv);
832         if (command)
833                 IExec->FreeVec(command);
834
835         IExec->Forbid();
836         return 0;
837 }
838
839 FILE *amigaos_popen(const char *cmd, const char *mode)
840 {
841         FILE *result = NULL;
842         char pipe_name[50];
843         char unix_pipe[50];
844         char ami_pipe[50];
845         char *cmd_copy;
846         BPTR input = 0;
847         BPTR output = 0;
848         struct Process *proc = NULL;
849         struct Task *thisTask = IExec->FindTask(0);
850
851         /* First we need to check the mode
852          * We can only have unidirectional pipes
853          */
854         //    adebug("%s %ld cmd %s mode %s \n",__FUNCTION__,__LINE__,cmd,
855         //    mode);
856
857         switch (mode[0])
858         {
859         case 'r':
860         case 'w':
861                 break;
862
863         default:
864
865                 errno = EINVAL;
866                 return result;
867         }
868
869         /* Make a unique pipe name
870          * we need a unix one and an amigaos version (of the same pipe!)
871          * as were linking with libunix.
872          */
873
874         sprintf(pipe_name, "%x%08lx/4096/0", pipenum++,
875                 IUtility->GetUniqueID());
876         sprintf(unix_pipe, "/PIPE/%s", pipe_name);
877         sprintf(ami_pipe, "PIPE:%s", pipe_name);
878
879         /* Now we open the AmigaOs Filehandles That we wil pass to our
880          * Sub process
881          */
882
883         if (mode[0] == 'r')
884         {
885                 /* A read mode pipe: Output from pipe input from NIL:*/
886                 input = IDOS->Open("NIL:", MODE_NEWFILE);
887                 if (input != 0)
888                 {
889                         output = IDOS->Open(ami_pipe, MODE_NEWFILE);
890                 }
891         }
892         else
893         {
894
895                 input = IDOS->Open(ami_pipe, MODE_NEWFILE);
896                 if (input != 0)
897                 {
898                         output = IDOS->Open("NIL:", MODE_NEWFILE);
899                 }
900         }
901         if ((input == 0) || (output == 0))
902         {
903                 /* Ouch stream opening failed */
904                 /* Close and bail */
905                 if (input)
906                         IDOS->Close(input);
907                 if (output)
908                         IDOS->Close(output);
909                 return result;
910         }
911
912         /* We have our streams now start our new process
913          * We're using a new process so that execve can modify the environment
914          * with messing things up for the shell that launched perl
915          * Copy cmd before we launch the subprocess as perl seems to waste
916          * no time in overwriting it! The subprocess will free the copy.
917          */
918
919         if ((cmd_copy = mystrdup(cmd)))
920         {
921                 // adebug("%s %ld
922                 // %s\n",__FUNCTION__,__LINE__,cmd_copy?cmd_copy:"NULL");
923                 proc = IDOS->CreateNewProcTags(
924                     NP_Entry, popen_child, NP_Child, TRUE, NP_StackSize,
925                     ((struct Process *)thisTask)->pr_StackSize, NP_Input, input,
926                     NP_Output, output, NP_Error, IDOS->ErrorOutput(),
927                     NP_CloseError, FALSE, NP_Cli, TRUE, NP_Name,
928                     "Perl: popen process", NP_UserData, (int)cmd_copy,
929                     TAG_DONE);
930         }
931         if (!proc)
932         {
933                 /* New Process Failed to start
934                  * Close and bail out
935                  */
936                 if (input)
937                         IDOS->Close(input);
938                 if (output)
939                         IDOS->Close(output);
940                 if (cmd_copy)
941                         IExec->FreeVec(cmd_copy);
942         }
943
944         /* Our new process is running and will close it streams etc
945          * once its done. All we need to is open the pipe via stdio
946          */
947
948         return fopen(unix_pipe, mode);
949 }
950
951 /* Work arround for clib2 fstat */
952 #ifndef S_IFCHR
953 #define S_IFCHR 0x0020000
954 #endif
955
956 #define SET_FLAG(u, v) ((void)((u) |= (v)))
957
958 int afstat(int fd, struct stat *statb)
959 {
960         int result;
961         BPTR fh;
962         int mode;
963         BOOL input;
964         /* In the first instance pass it to fstat */
965         // adebug("fd %ld ad %ld\n",fd,amigaos_get_file(fd));
966
967         if ((result = fstat(fd, statb) >= 0))
968                 return result;
969
970 /* Now we've got a file descriptor but we failed to stat it */
971 /* Could be a nil: or could be a std#? */
972
973 /* if get_default_file fails we had a dud fd so return failure */
974 #if !defined(__CLIB2__)
975
976         fh = amigaos_get_file(fd);
977
978         /* if nil: return failure*/
979         if (fh == 0)
980                 return -1;
981
982         /* Now compare with our process Input() Output() etc */
983         /* if these were regular files sockets or pipes we had already
984          * succeeded */
985         /* so we can guess they a character special console.... I hope */
986
987         struct ExamineData *data;
988         char name[120];
989         name[0] = '\0';
990
991         data = IDOS->ExamineObjectTags(EX_FileHandleInput, fh, TAG_END);
992         if (data != NULL)
993         {
994
995                 IUtility->Strlcpy(name, data->Name, sizeof(name));
996
997                 IDOS->FreeDosObject(DOS_EXAMINEDATA, data);
998         }
999
1000         // adebug("ad %ld '%s'\n",amigaos_get_file(fd),name);
1001         mode = S_IFCHR;
1002
1003         if (fh == IDOS->Input())
1004         {
1005                 input = TRUE;
1006                 SET_FLAG(mode, S_IRUSR);
1007                 SET_FLAG(mode, S_IRGRP);
1008                 SET_FLAG(mode, S_IROTH);
1009         }
1010         else if (fh == IDOS->Output() || fh == IDOS->ErrorOutput())
1011         {
1012                 input = FALSE;
1013                 SET_FLAG(mode, S_IWUSR);
1014                 SET_FLAG(mode, S_IWGRP);
1015                 SET_FLAG(mode, S_IWOTH);
1016         }
1017         else
1018         {
1019                 /* we got a filehandle not handle by fstat or the above */
1020                 /* most likely it's NIL: but lets check */
1021                 struct ExamineData *exd = NULL;
1022                 if ((exd = IDOS->ExamineObjectTags(EX_FileHandleInput, fh,
1023                                                    TAG_DONE)))
1024                 {
1025                         BOOL isnil = FALSE;
1026                         if (exd->Type ==
1027                             (20060920)) // Ugh yes I know nasty.....
1028                         {
1029                                 isnil = TRUE;
1030                         }
1031                         IDOS->FreeDosObject(DOS_EXAMINEDATA, exd);
1032                         if (isnil)
1033                         {
1034                                 /* yep we got NIL: */
1035                                 SET_FLAG(mode, S_IRUSR);
1036                                 SET_FLAG(mode, S_IRGRP);
1037                                 SET_FLAG(mode, S_IROTH);
1038                                 SET_FLAG(mode, S_IWUSR);
1039                                 SET_FLAG(mode, S_IWGRP);
1040                                 SET_FLAG(mode, S_IWOTH);
1041                         }
1042                         else
1043                         {
1044                                 IExec->DebugPrintF(
1045                                     "unhandled filehandle in afstat()\n");
1046                                 return -1;
1047                         }
1048                 }
1049         }
1050
1051         memset(statb, 0, sizeof(statb));
1052
1053         statb->st_mode = mode;
1054
1055 #endif
1056         return 0;
1057 }
1058
1059 BPTR amigaos_get_file(int fd)
1060 {
1061         BPTR fh = (BPTR)NULL;
1062         if (!(fh = _get_osfhandle(fd)))
1063         {
1064                 switch (fd)
1065                 {
1066                 case 0:
1067                         fh = IDOS->Input();
1068                         break;
1069                 case 1:
1070                         fh = IDOS->Output();
1071                         break;
1072                 case 2:
1073                         fh = IDOS->ErrorOutput();
1074                         break;
1075                 default:
1076                         break;
1077                 }
1078         }
1079         return fh;
1080 }