1 files changed, 210 insertions, 19 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;