FAQ
In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/47718690d4981790ebf65ad5428eccb95190be32?hp=cc0bf92f2c5d6a67a850efa7d21a5a83e016d446>

- Log -----------------------------------------------------------------
commit 47718690d4981790ebf65ad5428eccb95190be32
Author: Andy Broad <andy@broad.ology.org.uk>
Date: Mon Mar 14 17:43:30 2016 -0400

     amigaos4: avoid PerlIO_findFILE() in popen/plcose

     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.
-----------------------------------------------------------------------

Summary of changes:
  amigaos4/amigaio.c | 229 ++++++++++++++++++++++++++++++++++++++++++++++++-----
  amigaos4/amigaos.c | 208 +-----------------------------------------------
  amigaos4/amigaos.h | 4 +-
  3 files changed, 215 insertions(+), 226 deletions(-)

diff --git a/amigaos4/amigaio.c b/amigaos4/amigaio.c
index 40e9835..205e3d5 100644
--- a/amigaos4/amigaio.c
+++ b/amigaos4/amigaio.c
@@ -21,6 +21,11 @@
  #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;

diff --git a/amigaos4/amigaos.c b/amigaos4/amigaos.c
index 67b4c06..7d432d9 100644
--- a/amigaos4/amigaos.c
+++ b/amigaos4/amigaos.c
@@ -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
diff --git a/amigaos4/amigaos.h b/amigaos4/amigaos.h
index 4640bfa..f2bab44 100644
--- a/amigaos4/amigaos.h
+++ b/amigaos4/amigaos.h
@@ -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();

--
Perl5 Master Repository

Search Discussions

Related Discussions

Discussion Navigation
viewthread | post
posts ‹ prev | 1 of 1 | next ›
Discussion Overview
groupperl5-changes @
categoriesperl
postedMar 14, '16 at 10:49p
activeMar 14, '16 at 10:49p
posts1
users1
websiteperl.org

1 user in discussion

Jarkko Hietaniemi: 1 post

People

Translate

site design / logo © 2017 Grokbase