This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
amigaos4: avoid PerlIO_findFILE() in popen/plcose
authorAndy Broad <andy@broad.ology.org.uk>
Mon, 14 Mar 2016 21:43:30 +0000 (17:43 -0400)
committerJarkko Hietaniemi <jhi@iki.fi>
Mon, 14 Mar 2016 21:59:58 +0000 (17:59 -0400)
Merges amigaos_popen / amigaos_pclose with the amigaos specific
version of the Perl_my_popen / Perl_my_pclose functions and uses PerlIO
directly for the perl facing end of the PIPE:s thus avoid the issues
of PerlIO_findFILE() completely.

Also fixes a couple of warnings.

amigaos4/amigaio.c
amigaos4/amigaos.c
amigaos4/amigaos.h

index 40e9835..205e3d5 100644 (file)
 #include <proto/utility.h>
 #include <dos/dos.h>
 
+extern struct SignalSemaphore popen_sema;
+extern unsigned int  pipenum;
+
+extern int32 myruncommand(BPTR seglist, int stack, char *command, int length, char **envp);
+
 void amigaos_stdio_get(pTHX_ StdioStore *store)
 {
        store->astdin =
@@ -58,27 +63,212 @@ void amigaos_post_exec(int fd, int do_report)
        }
 }
 
+
+struct popen_data
+{
+       struct Task *parent;
+       STRPTR command;
+};
+
+static int popen_result = 0;
+
+int popen_child()
+{
+       struct Task *thisTask = IExec->FindTask(0);
+       struct popen_data *pd = (struct popen_data *)thisTask->tc_UserData;
+       const char *argv[4];
+
+       argv[0] = "sh";
+       argv[1] = "-c";
+       argv[2] = pd->command ? pd->command : NULL;
+       argv[3] = NULL;
+
+       // adebug("%s %ld  %s\n",__FUNCTION__,__LINE__,command?command:"NULL");
+
+       /* We need to give this to sh via execvp, execvp expects filename,
+        * argv[]
+        */
+       IExec->ObtainSemaphore(&popen_sema);
+
+       IExec->Signal(pd->parent,SIGBREAKF_CTRL_F);
+
+       popen_result = myexecvp(FALSE, argv[0], (char **)argv);
+       if (pd->command)
+               IExec->FreeVec(pd->command);
+       IExec->FreeVec(pd);
+
+       IExec->ReleaseSemaphore(&popen_sema);
+       IExec->Forbid();
+       return 0;
+}
+
+
 PerlIO *Perl_my_popen(pTHX_ const char *cmd, const char *mode)
 {
+
        PERL_FLUSHALL_FOR_CHILD;
-       /* Call system's popen() to get a FILE *, then import it.
-        * used 0 for 2nd parameter to PerlIO_importFILE;
-        * apparently not used
-       */
-       //    FILE *f=amigaos_popen(cmd,mode);
-       //    fprintf(stderr,"popen returned %d\n",f);
-       return PerlIO_importFILE(amigaos_popen(cmd, mode), mode);
-       //   return PerlIO_importFILE(f, 0);
+       PerlIO *result = NULL;
+       char pipe_name[50];
+       char unix_pipe[50];
+       char ami_pipe[50];
+       BPTR input = 0;
+       BPTR output = 0;
+       struct Process *proc = NULL;
+       struct Task *thisTask = IExec->FindTask(0);
+       struct popen_data * pd = NULL;
+
+       /* First we need to check the mode
+        * We can only have unidirectional pipes
+        */
+       //    adebug("%s %ld cmd %s mode %s \n",__FUNCTION__,__LINE__,cmd,
+       //    mode);
+
+       switch (mode[0])
+       {
+       case 'r':
+       case 'w':
+               break;
+
+       default:
+
+               errno = EINVAL;
+               return result;
+       }
+
+       /* Make a unique pipe name
+        * we need a unix one and an amigaos version (of the same pipe!)
+        * as were linking with libunix.
+        */
+
+       sprintf(pipe_name, "%x%08lx/4096/0", pipenum++,
+               IUtility->GetUniqueID());
+       sprintf(unix_pipe, "/PIPE/%s", pipe_name);
+       sprintf(ami_pipe, "PIPE:%s", pipe_name);
+
+       /* Now we open the AmigaOs Filehandles That we wil pass to our
+        * Sub process
+        */
+
+       if (mode[0] == 'r')
+       {
+               /* A read mode pipe: Output from pipe input from Output() or NIL:*/
+               /* First attempt to DUP Output() */
+               input = IDOS->DupFileHandle(IDOS->Input());
+               if(input == 0)
+               {
+                       input = IDOS->Open("NIL:", MODE_READWRITE);
+               }
+               if (input != 0)
+               {
+                       output = IDOS->Open(ami_pipe, MODE_NEWFILE);
+               }
+               result = PerlIO_open(unix_pipe, mode);
+       }
+       else
+       {
+               /* Open the write end first! */
+
+               result = PerlIO_open(unix_pipe, mode);
+
+               input = IDOS->Open(ami_pipe, MODE_OLDFILE);
+               if (input != 0)
+               {
+                       output = IDOS->DupFileHandle(IDOS->Output());
+                       if(output == 0)
+                       {
+                               output = IDOS->Open("NIL:", MODE_READWRITE);
+                       }
+               }
+       }
+       if ((input == 0) || (output == 0) || (result == NULL))
+       {
+               /* Ouch stream opening failed */
+               /* Close and bail */
+               if (input)
+                       IDOS->Close(input);
+               if (output)
+                       IDOS->Close(output);
+               if(result)
+               {
+                       PerlIO_close(result);
+                       result = NULL;
+               }
+               return result;
+       }
+
+       /* We have our streams now start our new process
+        * We're using a new process so that execve can modify the environment
+        * with messing things up for the shell that launched perl
+        * Copy cmd before we launch the subprocess as perl seems to waste
+        * no time in overwriting it! The subprocess will free the copy.
+        */
+
+       if((pd = (struct popen_data*)IExec->AllocVecTags(sizeof(struct popen_data),AVT_Type,MEMF_SHARED,TAG_DONE)))
+       {
+               pd->parent = thisTask;
+               if ((pd->command  = mystrdup(cmd)))
+               {
+                       // adebug("%s %ld
+                       // %s\n",__FUNCTION__,__LINE__,cmd_copy?cmd_copy:"NULL");
+                       proc = IDOS->CreateNewProcTags(
+                                  NP_Entry, popen_child, NP_Child, TRUE, NP_StackSize,
+                                  ((struct Process *)thisTask)->pr_StackSize, NP_Input, input,
+                                  NP_Output, output, NP_Error, IDOS->ErrorOutput(),
+                                  NP_CloseError, FALSE, NP_Cli, TRUE, NP_Name,
+                                  "Perl: popen process", NP_UserData, (int)pd,
+                                  TAG_DONE);
+               }
+       }
+       if(proc)
+       {
+               /* wait for the child be setup right */
+               IExec->Wait(SIGBREAKF_CTRL_F);
+       }
+       if (!proc)
+       {
+               /* New Process Failed to start
+                * Close and bail out
+                */
+               if(pd)
+               {
+                       if(pd->command)
+                       {
+                               IExec->FreeVec(pd->command);
+                       }
+                       IExec->FreeVec(pd);
+               }
+               if (input)
+                       IDOS->Close(input);
+               if (output)
+                       IDOS->Close(output);
+               if(result)
+               {
+                       PerlIO_close(result);
+                       result = NULL;
+               }
+       }
+
+       /* Our new process is running and will close it streams etc
+        * once its done. All we need to is open the pipe via stdio
+        */
+
+       return result;
 }
 
-I32 Perl_my_pclose(pTHX_ PerlIO *ptr)
+I32
+Perl_my_pclose(pTHX_ PerlIO *ptr)
 {
-       FILE * const f = PerlIO_findFILE(ptr);
-       const I32 result = amigaos_pclose(f);
-       PerlIO_releaseFILE(ptr,f);
+       int result = -1;
+       /* close the file before obtaining the semaphore else we might end up
+          hanging waiting for the child to read the last bit from the pipe */
+       PerlIO_close(ptr);
+       IExec->ObtainSemaphore(&popen_sema);
+       result = popen_result;
+       IExec->ReleaseSemaphore(&popen_sema);
        return result;
 }
 
+
 #ifdef USE_ITHREADS
 
 /* An arbitrary number to start with, should work out what the real max should
@@ -182,7 +372,7 @@ int amigaos_kill(Pid_t pid, int signal)
                if (pseudo_children[i].ti_pid == pid)
                {
                        realpid = (Pid_t)IDOS->GetPID(pseudo_children[i].ti_Process,GPID_PROCESS);
-                       if(pseudo_children[i].ti_Process == IExec->FindTask(NULL))
+                       if(pseudo_children[i].ti_Process == (struct Process *)IExec->FindTask(NULL))
                        {
                                thistask = TRUE;
                        }
@@ -408,11 +598,11 @@ Pid_t amigaos_waitpid(pTHX_ int optype, Pid_t pid, void *argflags)
        int result;
        if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
        {
-               result = pthread_join(pid, argflags);
+               result = pthread_join(pid, (void **)argflags);
        }
        else
        {
-               while ((result = pthread_join(pid, argflags)) == -1 &&
+               while ((result = pthread_join(pid, (void **)argflags)) == -1 &&
                        errno == EINTR)
                {
                        //          PERL_ASYNC_CHECK();
@@ -658,7 +848,7 @@ void *amigaos_system_child(void *userdata)
 
        amigaos_stdio_restore(aTHX_ & store);
 
-       return value;
+       return (void *)value;
 }
 
 static BOOL contains_whitespace(char *string)
@@ -804,7 +994,7 @@ int myexecve(bool isperlthread,
        if (filename_conv)
                size += strlen(filename_conv);
        size += 1;
-       full = (char *)IExec->AllocVec(size + 10, MEMF_ANY | MEMF_CLEAR);
+       full = (char *)IExec->AllocVecTags(size + 10, AVT_ClearWithValue, 0 ,TAG_DONE);
        if (full)
        {
                if (interpreter)
@@ -848,9 +1038,10 @@ int myexecve(bool isperlthread,
 
                                if (esc > 0)
                                {
-                                       char *buff = (char *)IExec->AllocVec(
+                                       char *buff = (char *)IExec->AllocVecTags(
                                                         strlen(*cur) + 4 + esc,
-                                                        MEMF_ANY | MEMF_CLEAR);
+                                                        AVT_ClearWithValue,0,
+                                                        TAG_DONE);
                                        char *p = *cur;
                                        char *q = buff;
 
index 67b4c06..7d432d9 100644 (file)
@@ -161,7 +161,7 @@ char *mystrdup(const char *s)
        return result;
 }
 
-static unsigned int pipenum = 0;
+unsigned int pipenum = 0;
 
 int pipe(int filedes[2])
 {
@@ -240,8 +240,8 @@ char *convert_path_u2a(const char *filename)
        return mystrdup(filename);
 }
 
-static struct SignalSemaphore environ_sema;
-static struct SignalSemaphore popen_sema;
+struct SignalSemaphore environ_sema;
+struct SignalSemaphore popen_sema;
 
 
 void amigaos4_init_environ_sema()
@@ -520,208 +520,6 @@ void ___freeenviron()
        }
 }
 
-/* reimplementation of popen, clib2's doesn't do all we want */
-
-struct popen_data
-{
-       struct Task *parent;
-       STRPTR command;
-};
-
-static int popen_result = 0;
-
-int popen_child()
-{
-       struct Task *thisTask = IExec->FindTask(0);
-       struct popen_data *pd = (struct popen_data *)thisTask->tc_UserData;
-       const char *argv[4];
-
-       argv[0] = "sh";
-       argv[1] = "-c";
-       argv[2] = pd->command ? pd->command : NULL;
-       argv[3] = NULL;
-
-       // adebug("%s %ld  %s\n",__FUNCTION__,__LINE__,command?command:"NULL");
-
-       /* We need to give this to sh via execvp, execvp expects filename,
-        * argv[]
-        */
-       IExec->ObtainSemaphore(&popen_sema);
-
-       IExec->Signal(pd->parent,SIGBREAKF_CTRL_F);
-
-       popen_result = myexecvp(FALSE, argv[0], (char **)argv);
-       if (pd->command)
-               IExec->FreeVec(pd->command);
-       IExec->FreeVec(pd);
-
-       IExec->ReleaseSemaphore(&popen_sema);
-       IExec->Forbid();
-       return 0;
-}
-
-
-FILE *amigaos_popen(const char *cmd, const char *mode)
-{
-       FILE *result = NULL;
-       char pipe_name[50];
-       char unix_pipe[50];
-       char ami_pipe[50];
-       BPTR input = 0;
-       BPTR output = 0;
-       struct Process *proc = NULL;
-       struct Task *thisTask = IExec->FindTask(0);
-       struct popen_data * pd = NULL;
-
-       /* First we need to check the mode
-        * We can only have unidirectional pipes
-        */
-       //    adebug("%s %ld cmd %s mode %s \n",__FUNCTION__,__LINE__,cmd,
-       //    mode);
-
-       switch (mode[0])
-       {
-       case 'r':
-       case 'w':
-               break;
-
-       default:
-
-               errno = EINVAL;
-               return result;
-       }
-
-       /* Make a unique pipe name
-        * we need a unix one and an amigaos version (of the same pipe!)
-        * as were linking with libunix.
-        */
-
-       sprintf(pipe_name, "%x%08lx/4096/0", pipenum++,
-               IUtility->GetUniqueID());
-       sprintf(unix_pipe, "/PIPE/%s", pipe_name);
-       sprintf(ami_pipe, "PIPE:%s", pipe_name);
-
-       /* Now we open the AmigaOs Filehandles That we wil pass to our
-        * Sub process
-        */
-
-       if (mode[0] == 'r')
-       {
-               /* A read mode pipe: Output from pipe input from Output() or NIL:*/
-               /* First attempt to DUP Output() */
-               input = IDOS->DupFileHandle(IDOS->Input());
-               if(input == 0)
-               {
-                       input = IDOS->Open("NIL:", MODE_READWRITE);
-               }
-               if (input != 0)
-               {
-                       output = IDOS->Open(ami_pipe, MODE_NEWFILE);
-               }
-               result = fopen(unix_pipe, mode);
-       }
-       else
-       {
-               /* Open the write end first! */
-
-               result = fopen(unix_pipe, mode);
-
-               input = IDOS->Open(ami_pipe, MODE_OLDFILE);
-               if (input != 0)
-               {
-                       output = IDOS->DupFileHandle(IDOS->Output());
-                       if(output == 0)
-                       {
-                               output = IDOS->Open("NIL:", MODE_READWRITE);
-                       }
-               }
-       }
-       if ((input == 0) || (output == 0) || (result == NULL))
-       {
-               /* Ouch stream opening failed */
-               /* Close and bail */
-               if (input)
-                       IDOS->Close(input);
-               if (output)
-                       IDOS->Close(output);
-               if(result)
-               {
-                       fclose(result);
-                       result = NULL;
-               }
-               return result;
-       }
-
-       /* We have our streams now start our new process
-        * We're using a new process so that execve can modify the environment
-        * with messing things up for the shell that launched perl
-        * Copy cmd before we launch the subprocess as perl seems to waste
-        * no time in overwriting it! The subprocess will free the copy.
-        */
-
-       if((pd = (struct popen_data*)IExec->AllocVecTags(sizeof(struct popen_data),AVT_Type,MEMF_SHARED,TAG_DONE)))
-       {
-               pd->parent = thisTask;
-               if ((pd->command  = mystrdup(cmd)))
-               {
-                       // adebug("%s %ld
-                       // %s\n",__FUNCTION__,__LINE__,cmd_copy?cmd_copy:"NULL");
-                       proc = IDOS->CreateNewProcTags(
-                                  NP_Entry, popen_child, NP_Child, TRUE, NP_StackSize,
-                                  ((struct Process *)thisTask)->pr_StackSize, NP_Input, input,
-                                  NP_Output, output, NP_Error, IDOS->ErrorOutput(),
-                                  NP_CloseError, FALSE, NP_Cli, TRUE, NP_Name,
-                                  "Perl: popen process", NP_UserData, (int)pd,
-                                  TAG_DONE);
-               }
-       }
-       if(proc)
-       {
-               /* wait for the child be setup right */
-               IExec->Wait(SIGBREAKF_CTRL_F);
-       }
-       if (!proc)
-       {
-               /* New Process Failed to start
-                * Close and bail out
-                */
-               if(pd)
-               {
-                       if(pd->command)
-                       {
-                               IExec->FreeVec(pd->command);
-                       }
-                       IExec->FreeVec(pd);
-               }
-               if (input)
-                       IDOS->Close(input);
-               if (output)
-                       IDOS->Close(output);
-               if(result)
-               {
-                       fclose(result);
-                       result = NULL;
-               }
-       }
-
-       /* Our new process is running and will close it streams etc
-        * once its done. All we need to is open the pipe via stdio
-        */
-
-       return result;
-}
-
-int amigaos_pclose(FILE *f)
-{
-       int result = -1;
-       /* close the file before obtaining the semaphore else we might end up
-          hanging waiting for the child to read the last bit from the pipe */
-       fclose(f);
-       IExec->ObtainSemaphore(&popen_sema);
-       result = popen_result;
-       IExec->ReleaseSemaphore(&popen_sema);
-       return result;
-}
 
 /* Work arround for clib2 fstat */
 #ifndef S_IFCHR
index 4640bfa..f2bab44 100644 (file)
@@ -32,8 +32,8 @@ int myexecl(bool isperlthread, const char *path, ...);
 
 int pipe(int filedes[2]);
 
-FILE *amigaos_popen(const char *cmd, const char *mode);
-int   amigaos_pclose(FILE *f);
+//FILE *amigaos_popen(const char *cmd, const char *mode);
+//int   amigaos_pclose(FILE *f);
 
 void amigaos4_obtain_environ();
 void amigaos4_release_environ();