diff options
Diffstat (limited to 'amigaos4')
-rw-r--r-- | amigaos4/amigaio.c | 229 | ||||
-rw-r--r-- | amigaos4/amigaos.c | 208 | ||||
-rw-r--r-- | amigaos4/amigaos.h | 4 |
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(); |