summaryrefslogtreecommitdiff
path: root/amigaos4
diff options
context:
space:
mode:
authorAndy Broad <andy@broad.ology.org.uk>2016-03-14 17:43:30 -0400
committerJarkko Hietaniemi <jhi@iki.fi>2016-03-14 17:59:58 -0400
commit47718690d4981790ebf65ad5428eccb95190be32 (patch)
treee2af8addcc81718841b7ce300ed18114e30582e4 /amigaos4
parentcc0bf92f2c5d6a67a850efa7d21a5a83e016d446 (diff)
downloadperl-47718690d4981790ebf65ad5428eccb95190be32.tar.gz
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.
Diffstat (limited to 'amigaos4')
-rw-r--r--amigaos4/amigaio.c229
-rw-r--r--amigaos4/amigaos.c208
-rw-r--r--amigaos4/amigaos.h4
3 files changed, 215 insertions, 226 deletions
diff --git a/amigaos4/amigaio.c b/amigaos4/amigaio.c
index 40e9835d0f..205e3d5eb4 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 67b4c065c4..7d432d9dfc 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 4640bfac79..f2bab44152 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();