This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlapi: Remove per-thread section; move to real scns
[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(__attribute__((unused))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->AllocVecTags(size, TAG_DONE)))
158         {
159                 memmove(result, s, size);
160         }
161         return result;
162 }
163
164 unsigned 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(__attribute__((unused))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 struct SignalSemaphore environ_sema;
244 struct SignalSemaphore popen_sema;
245
246
247 void amigaos4_init_environ_sema()
248 {
249         IExec->InitSemaphore(&environ_sema);
250         IExec->InitSemaphore(&popen_sema);
251 }
252
253 void amigaos4_obtain_environ()
254 {
255         IExec->ObtainSemaphore(&environ_sema);
256 }
257
258 void amigaos4_release_environ()
259 {
260         IExec->ReleaseSemaphore(&environ_sema);
261 }
262
263 static void createvars(char **envp)
264 {
265         if (envp)
266         {
267                 /* Set a local var to indicate to any subsequent sh that it is
268                 * not
269                 * the top level shell and so should only inherit local amigaos
270                 * vars */
271                 IDOS->SetVar("ABCSH_IMPORT_LOCAL", "TRUE", 5, GVF_LOCAL_ONLY);
272
273                 amigaos4_obtain_environ();
274
275                 envp = myenviron;
276
277                 while ((envp != NULL) && (*envp != NULL))
278                 {
279                         int len;
280                         char *var;
281                         char *val;
282                         if ((len = strlen(*envp)))
283                         {
284                                 if ((var = (char *)IExec->AllocVecTags(len + 1, AVT_ClearWithValue,0,TAG_DONE)))
285                                 {
286                                         strcpy(var, *envp);
287
288                                         val = strchr(var, '=');
289                                         if (val)
290                                         {
291                                                 *val++ = '\0';
292                                                 if (*val)
293                                                 {
294                                                         IDOS->SetVar(
295                                                             var, val,
296                                                             strlen(val) + 1,
297                                                             GVF_LOCAL_ONLY);
298                                                 }
299                                         }
300                                         IExec->FreeVec(var);
301                                 }
302                         }
303                         envp++;
304                 }
305                 amigaos4_release_environ();
306         }
307 }
308
309 struct command_data
310 {
311         STRPTR args;
312         BPTR seglist;
313         struct Task *parent;
314 };
315
316
317 int myexecvp(bool isperlthread, const char *filename, char *argv[])
318 {
319         //      adebug("%s %ld
320         //%s\n",__FUNCTION__,__LINE__,filename?filename:"NULL");
321         /* if there's a slash or a colon consider filename a path and skip
322          * search */
323         int res;
324         char *name = NULL;
325         char *pathpart = NULL;
326         if ((strchr(filename, '/') == NULL) && (strchr(filename, ':') == NULL))
327         {
328                 const char *path;
329                 const char *p;
330                 size_t len;
331                 struct stat st;
332
333                 if (!(path = getenv("PATH")))
334                 {
335                         path = ".:/bin:/usr/bin:/c";
336                 }
337
338                 len = strlen(filename) + 1;
339                 name = (char *)IExec->AllocVecTags(strlen(path) + len, AVT_ClearWithValue,0,AVT_Type,MEMF_SHARED,TAG_DONE);
340                 pathpart = (char *)IExec->AllocVecTags(strlen(path) + 1, AVT_ClearWithValue,0,AVT_Type,MEMF_SHARED,TAG_DONE);
341                 p = path;
342                 do
343                 {
344                         path = p;
345
346                         if (!(p = strchr(path, ':')))
347                         {
348                                 p = strchr(path, '\0');
349                         }
350
351                         memcpy(pathpart, path, p - path);
352                         pathpart[p - path] = '\0';
353                         if (!(strlen(pathpart) == 0))
354                         {
355                                 sprintf(name, "%s/%s", pathpart, filename);
356                         }
357                         else
358                                 sprintf(name, "%s", filename);
359
360                         if ((stat(name, &st) == 0) && (S_ISREG(st.st_mode)))
361                         {
362                                 /* we stated it and it's a regular file */
363                                 /* let's boogie! */
364                                 filename = name;
365                                 break;
366                         }
367
368                 }
369                 while (*p++ != '\0');
370         }
371
372         res = myexecve(isperlthread, filename, argv, myenviron);
373
374         if(name)
375         {
376                 IExec->FreeVec((APTR)name);
377                 name = NULL;
378         }
379         if(pathpart)
380         {
381                 IExec->FreeVec((APTR)pathpart);
382                 pathpart = NULL;
383         }
384         return res;
385 }
386
387 int myexecv(bool isperlthread, const char *path, char *argv[])
388 {
389         return myexecve(isperlthread, path, argv, myenviron);
390 }
391
392 int myexecl(bool isperlthread, const char *path, ...)
393 {
394         va_list va;
395         char *argv[1024]; /* 1024 enough? let's hope so! */
396         int i = 0;
397         // adebug("%s %ld\n",__FUNCTION__,__LINE__);
398
399         va_start(va, path);
400         i = 0;
401
402         do
403         {
404                 argv[i] = va_arg(va, char *);
405         }
406         while (argv[i++] != NULL);
407
408         va_end(va);
409         return myexecve(isperlthread, path, argv, myenviron);
410 }
411
412 int pause(void)
413 {
414         fprintf(stderr, "Pause not implemented\n");
415
416         errno = EINTR;
417         return -1;
418 }
419
420 uint32 size_env(struct Hook *hook, __attribute__((unused))APTR userdata, struct ScanVarsMsg *message)
421 {
422         if (strlen(message->sv_GDir) <= 4)
423         {
424                 hook->h_Data = (APTR)(((uint32)hook->h_Data) + 1);
425         }
426         return 0;
427 }
428
429 uint32 copy_env(struct Hook *hook, __attribute__((unused))APTR userdata, struct ScanVarsMsg *message)
430 {
431         if (strlen(message->sv_GDir) <= 4)
432         {
433                 char **env = (char **)hook->h_Data;
434                 uint32 size =
435                     strlen(message->sv_Name) + 1 + message->sv_VarLen + 1 + 1;
436                 char *buffer = (char *)IExec->AllocVecTags((uint32)size,AVT_ClearWithValue,0,TAG_DONE);
437
438
439                 snprintf(buffer, size - 1, "%s=%s", message->sv_Name,
440                          message->sv_Var);
441
442                 *env = buffer;
443                 env++;
444                 hook->h_Data = env;
445         }
446         return 0;
447 }
448
449 void ___makeenviron()
450 {
451         struct Hook *hook = (struct Hook *)IExec->AllocSysObjectTags(ASOT_HOOK,TAG_DONE);
452
453         if(hook)
454         {
455                 char varbuf[8];
456                 uint32 flags = 0;
457
458                 struct DOSIFace *myIDOS =
459                     (struct DOSIFace *)OpenInterface("dos.library", 53);
460                 if (myIDOS)
461                 {
462                         uint32 size = 0;
463                         if (myIDOS->GetVar("ABCSH_IMPORT_LOCAL", varbuf, 8,
464                                            GVF_LOCAL_ONLY) > 0)
465                         {
466                                 flags = GVF_LOCAL_ONLY;
467                         }
468                         else
469                         {
470                                 flags = GVF_GLOBAL_ONLY;
471                         }
472
473                         hook->h_Entry = size_env;
474                         hook->h_Data = 0;
475
476                         myIDOS->ScanVars(hook, flags, 0);
477                         size  = ((uint32)hook->h_Data) + 1;
478
479                         myenviron = (char **)IExec->AllocVecTags(size *
480                                     sizeof(char **),
481                                     AVT_ClearWithValue,0,TAG_DONE);
482                         origenviron = myenviron;
483                         if (!myenviron)
484                         {
485                                 IExec->FreeSysObject(ASOT_HOOK,hook);
486                                 CloseInterface((struct Interface *)myIDOS);
487                                 return;
488                         }
489                         hook->h_Entry = copy_env;
490                         hook->h_Data = myenviron;
491
492                         myIDOS->ScanVars(hook, flags, 0);
493                         IExec->FreeSysObject(ASOT_HOOK,hook);
494                         CloseInterface((struct Interface *)myIDOS);
495                 }
496         }
497 }
498
499 void ___freeenviron()
500 {
501         char **i;
502         /* perl might change environ, it puts it back except for ctrl-c */
503         /* so restore our own copy here */
504         struct DOSIFace *myIDOS =
505             (struct DOSIFace *)OpenInterface("dos.library", 53);
506         if (myIDOS)
507         {
508                 myenviron = origenviron;
509
510                 if (myenviron)
511                 {
512                         for (i = myenviron; *i != NULL; i++)
513                         {
514                                 IExec->FreeVec(*i);
515                         }
516                         IExec->FreeVec(myenviron);
517                         myenviron = NULL;
518                 }
519                 CloseInterface((struct Interface *)myIDOS);
520         }
521 }
522
523
524 /* Work arround for clib2 fstat */
525 #ifndef S_IFCHR
526 #define S_IFCHR 0x0020000
527 #endif
528
529 #define SET_FLAG(u, v) ((void)((u) |= (v)))
530
531 int afstat(int fd, struct stat *statb)
532 {
533         int result;
534         BPTR fh;
535         int mode;
536         BOOL input;
537         /* In the first instance pass it to fstat */
538         // adebug("fd %ld ad %ld\n",fd,amigaos_get_file(fd));
539
540         if ((result = fstat(fd, statb) >= 0))
541                 return result;
542
543         /* Now we've got a file descriptor but we failed to stat it */
544         /* Could be a nil: or could be a std#? */
545
546         /* if get_default_file fails we had a dud fd so return failure */
547 #if !defined(__CLIB2__)
548
549         fh = amigaos_get_file(fd);
550
551         /* if nil: return failure*/
552         if (fh == 0)
553                 return -1;
554
555         /* Now compare with our process Input() Output() etc */
556         /* if these were regular files sockets or pipes we had already
557          * succeeded */
558         /* so we can guess they a character special console.... I hope */
559
560         struct ExamineData *data;
561         char name[120];
562         name[0] = '\0';
563
564         data = IDOS->ExamineObjectTags(EX_FileHandleInput, fh, TAG_END);
565         if (data != NULL)
566         {
567
568                 IUtility->Strlcpy(name, data->Name, sizeof(name));
569
570                 IDOS->FreeDosObject(DOS_EXAMINEDATA, data);
571         }
572
573         // adebug("ad %ld '%s'\n",amigaos_get_file(fd),name);
574         mode = S_IFCHR;
575
576         if (fh == IDOS->Input())
577         {
578                 input = TRUE;
579                 SET_FLAG(mode, S_IRUSR);
580                 SET_FLAG(mode, S_IRGRP);
581                 SET_FLAG(mode, S_IROTH);
582         }
583         else if (fh == IDOS->Output() || fh == IDOS->ErrorOutput())
584         {
585                 input = FALSE;
586                 SET_FLAG(mode, S_IWUSR);
587                 SET_FLAG(mode, S_IWGRP);
588                 SET_FLAG(mode, S_IWOTH);
589         }
590         else
591         {
592                 /* we got a filehandle not handle by fstat or the above */
593                 /* most likely it's NIL: but lets check */
594                 struct ExamineData *exd = NULL;
595                 if ((exd = IDOS->ExamineObjectTags(EX_FileHandleInput, fh,
596                                                    TAG_DONE)))
597                 {
598                         BOOL isnil = FALSE;
599                         if (exd->Type ==
600                                 (20060920)) // Ugh yes I know nasty.....
601                         {
602                                 isnil = TRUE;
603                         }
604                         IDOS->FreeDosObject(DOS_EXAMINEDATA, exd);
605                         if (isnil)
606                         {
607                                 /* yep we got NIL: */
608                                 SET_FLAG(mode, S_IRUSR);
609                                 SET_FLAG(mode, S_IRGRP);
610                                 SET_FLAG(mode, S_IROTH);
611                                 SET_FLAG(mode, S_IWUSR);
612                                 SET_FLAG(mode, S_IWGRP);
613                                 SET_FLAG(mode, S_IWOTH);
614                         }
615                         else
616                         {
617                                 IExec->DebugPrintF(
618                                     "unhandled filehandle in afstat()\n");
619                                 return -1;
620                         }
621                 }
622         }
623
624         memset(statb, 0, sizeof(statb));
625
626         statb->st_mode = mode;
627
628 #endif
629         return 0;
630 }
631
632 BPTR amigaos_get_file(int fd)
633 {
634         BPTR fh = (BPTR)NULL;
635         if (!(fh = _get_osfhandle(fd)))
636         {
637                 switch (fd)
638                 {
639                 case 0:
640                         fh = IDOS->Input();
641                         break;
642                 case 1:
643                         fh = IDOS->Output();
644                         break;
645                 case 2:
646                         fh = IDOS->ErrorOutput();
647                         break;
648                 default:
649                         break;
650                 }
651         }
652         return fh;
653 }
654
655 /*########################################################################*/
656
657 #define LOCK_START 0xFFFFFFFFFFFFFFFELL
658 #define LOCK_LENGTH 1LL
659
660 // No wait forever option so lets wait for a loooong time.
661 #define TIMEOUT 0x7FFFFFFF
662
663 int amigaos_flock(int fd, int oper)
664 {
665         BPTR fh;
666         int32 success = -1;
667
668         if (!(fh = amigaos_get_file(fd)))
669         {
670                 errno = EBADF;
671                 return -1;
672         }
673
674         switch (oper)
675         {
676         case LOCK_SH:
677         {
678                 if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH,
679                                      REC_SHARED | RECF_DOS_METHOD_ONLY,
680                                      TIMEOUT))
681                 {
682                         success = 0;
683                 }
684                 break;
685         }
686         case LOCK_EX:
687         {
688                 if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH,
689                                      REC_EXCLUSIVE | RECF_DOS_METHOD_ONLY,
690                                      TIMEOUT))
691                 {
692                         success = 0;
693                 }
694                 break;
695         }
696         case LOCK_SH | LOCK_NB:
697         {
698                 if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH,
699                                      REC_SHARED_IMMED | RECF_DOS_METHOD_ONLY,
700                                      TIMEOUT))
701                 {
702                         success = 0;
703                 }
704                 else
705                 {
706                         errno = EWOULDBLOCK;
707                 }
708                 break;
709         }
710         case LOCK_EX | LOCK_NB:
711         {
712                 if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH,
713                                      REC_EXCLUSIVE_IMMED | RECF_DOS_METHOD_ONLY,
714                                      TIMEOUT))
715                 {
716                         success = 0;
717                 }
718                 else
719                 {
720                         errno = EWOULDBLOCK;
721                 }
722                 break;
723         }
724         case LOCK_UN:
725         {
726                 if (IDOS->UnLockRecord(fh, LOCK_START, LOCK_LENGTH))
727                 {
728                         success = 0;
729                 }
730                 break;
731         }
732         default:
733         {
734                 errno = EINVAL;
735                 return -1;
736         }
737         }
738         return success;
739 }