openkylin
/
perl
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
perl/amigaos4/amigaio.c

1174 lines
24 KiB
C
Raw Blame History

/* amigaio.c mixes amigaos and perl APIs,
* as opposed to amigaos.c which is pure amigaos */
#include "EXTERN.h"
#include "perl.h"
#include "amigaos4/amigaio.h"
#include "amigaos.h"
#ifdef WORD
# undef WORD
# define WORD int16
#endif
#include <stdio.h>
#include <exec/semaphores.h>
#include <exec/exectags.h>
#include <proto/exec.h>
#include <proto/dos.h>
#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 =
amigaos_get_file(PerlIO_fileno(IoIFP(GvIO(PL_stdingv))));
store->astderr =
amigaos_get_file(PerlIO_fileno(IoIFP(GvIO(PL_stderrgv))));
store->astdout = amigaos_get_file(
PerlIO_fileno(IoIFP(GvIO(gv_fetchpv("STDOUT", TRUE, SVt_PVIO)))));
}
void amigaos_stdio_save(pTHX_ StdioStore *store)
{
amigaos_stdio_get(aTHX_ store);
store->oldstdin = IDOS->SelectInput(store->astdin);
store->oldstderr = IDOS->SelectErrorOutput(store->astderr);
store->oldstdout = IDOS->SelectOutput(store->astdout);
}
void amigaos_stdio_restore(pTHX_ const StdioStore *store)
{
IDOS->SelectInput(store->oldstdin);
IDOS->SelectErrorOutput(store->oldstderr);
IDOS->SelectOutput(store->oldstdout);
}
void amigaos_post_exec(int fd, int do_report)
{
/* We *must* write something to our pipe or else
* the other end hangs */
if (do_report)
{
int e = errno;
PerlLIO_write(fd, (void *)&e, sizeof(e));
PerlLIO_close(fd);
}
}
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;
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)
{
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
* be */
#ifndef MAX_THREADS
# define MAX_THREADS 64
#endif
#define REAPED 0
#define ACTIVE 1
#define EXITED -1
struct thread_info
{
pthread_t ti_pid;
int ti_children;
pthread_t ti_parent;
struct MsgPort *ti_port;
struct Process *ti_Process;
};
static struct thread_info pseudo_children[MAX_THREADS];
static int num_pseudo_children = 0;
static struct SignalSemaphore fork_array_sema;
void amigaos4_init_fork_array()
{
IExec->InitSemaphore(&fork_array_sema);
pseudo_children[0].ti_pid = (pthread_t)IExec->FindTask(0);
pseudo_children[0].ti_parent = -1;
pseudo_children[0].ti_port =
(struct MsgPort *)IExec->AllocSysObjectTags(ASOT_PORT, TAG_DONE);
}
void amigaos4_dispose_fork_array()
{
while (pseudo_children[0].ti_children > 0)
{
void *msg;
IExec->WaitPort(pseudo_children[0].ti_port);
msg = IExec->GetMsg(pseudo_children[0].ti_port);
if (msg)
IExec->FreeSysObject(ASOT_MESSAGE, msg);
pseudo_children[0].ti_children--;
}
IExec->FreeSysObject(ASOT_PORT, pseudo_children[0].ti_port);
}
struct thread_exit_message
{
struct Message tem_Message;
pthread_t tem_pid;
int tem_status;
};
int getnextchild()
{
int i;
for (i = 0; i < MAX_THREADS; i++)
{
if (pseudo_children[i].ti_pid == 0)
return i;
}
return -1;
}
int findparent(pthread_t pid)
{
int i;
for (i = 0; i < MAX_THREADS; i++)
{
if (pseudo_children[i].ti_pid == pid)
return i;
}
return -1;
}
struct child_arg
{
struct Task *ca_parent_task;
pthread_t ca_parent;
PerlInterpreter *ca_interp;
};
#undef kill
/* FIXME: Is here's a chance, albeit it small of a clash between our pseudo pid */
/* derived from the pthread API and the dos.library pid that newlib kill uses? */
/* clib2 used the Process address so there was no issue */
int amigaos_kill(Pid_t pid, int signal)
{
int i;
BOOL thistask = FALSE;
Pid_t realpid = pid; // Perhaps we have a real pid from else where?
/* Look for our DOS pid */
IExec->ObtainSemaphore(&fork_array_sema);
for (i = 0; i < MAX_THREADS; i++)
{
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 == (struct Process *)IExec->FindTask(NULL))
{
thistask = TRUE;
}
break;
}
}
IExec->ReleaseSemaphore(&fork_array_sema);
/* Allow the C library to work out which signals are realy valid */
if(thistask)
{
/* A quirk in newlib kill handling means it's better to call raise() rather than kill on out own task. */
return raise(signal);
}
else
{
return kill(realpid,signal);
}
}
static THREAD_RET_TYPE amigaos4_start_child(void *arg)
{
PerlInterpreter *my_perl =
(PerlInterpreter *)((struct child_arg *)arg)->ca_interp;
;
GV *tmpgv;
int status;
int parent;
int nextchild;
pthread_t pseudo_id = pthread_self();
#ifdef PERL_SYNC_FORK
static long sync_fork_id = 0;
long id = ++sync_fork_id;
#endif
/* before we do anything set up our process semaphore and add
a new entry to the pseudochildren */
/* get next available slot */
/* should not fail here! */
IExec->ObtainSemaphore(&fork_array_sema);
nextchild = getnextchild();
pseudo_children[nextchild].ti_pid = pseudo_id;
pseudo_children[nextchild].ti_Process = (struct Process *)IExec->FindTask(NULL);
pseudo_children[nextchild].ti_parent =
((struct child_arg *)arg)->ca_parent;
pseudo_children[nextchild].ti_port =
(struct MsgPort *)IExec->AllocSysObjectTags(ASOT_PORT, TAG_DONE);
num_pseudo_children++;
IExec->ReleaseSemaphore(&fork_array_sema);
/* We're set up let the parent continue */
IExec->Signal(((struct child_arg *)arg)->ca_parent_task,
SIGBREAKF_CTRL_F);
PERL_SET_THX(my_perl);
if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV)))
{
SV *sv = GvSV(tmpgv);
SvREADONLY_off(sv);
sv_setiv(sv, (IV)pseudo_id);
SvREADONLY_on(sv);
}
hv_clear(PL_pidstatus);
/* push a zero on the stack (we are the child) */
{
dSP;
dTARGET;
PUSHi(0);
PUTBACK;
}
/* continue from next op */
PL_op = PL_op->op_next;
{
dJMPENV;
volatile int oldscope = PL_scopestack_ix;
restart:
JMPENV_PUSH(status);
switch (status)
{
case 0:
CALLRUNOPS(aTHX);
status = 0;
break;
case 2:
while (PL_scopestack_ix > oldscope)
{
LEAVE;
}
FREETMPS;
PL_curstash = PL_defstash;
if (PL_endav && !PL_minus_c)
call_list(oldscope, PL_endav);
status = STATUS_EXIT;
break;
case 3:
if (PL_restartop)
{
POPSTACK_TO(PL_mainstack);
PL_op = PL_restartop;
PL_restartop = (OP *)NULL;
;
goto restart;
}
PerlIO_printf(Perl_error_log, "panic: restartop\n");
FREETMPS;
status = 1;
break;
}
JMPENV_POP;
/* XXX hack to avoid perl_destruct() freeing optree */
PL_main_root = (OP *)NULL;
}
{
do_close(PL_stdingv, FALSE);
do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO),
FALSE); /* PL_stdoutgv - ISAGN */
do_close(PL_stderrgv, FALSE);
}
/* destroy everything (waits for any pseudo-forked children) */
/* wait for any remaining children */
while (pseudo_children[nextchild].ti_children > 0)
{
if (IExec->WaitPort(pseudo_children[nextchild].ti_port))
{
void *msg =
IExec->GetMsg(pseudo_children[nextchild].ti_port);
IExec->FreeSysObject(ASOT_MESSAGE, msg);
pseudo_children[nextchild].ti_children--;
}
}
if (PL_scopestack_ix <= 1)
{
perl_destruct(my_perl);
}
perl_free(my_perl);
IExec->ObtainSemaphore(&fork_array_sema);
parent = findparent(pseudo_children[nextchild].ti_parent);
pseudo_children[nextchild].ti_pid = 0;
pseudo_children[nextchild].ti_parent = 0;
IExec->FreeSysObject(ASOT_PORT, pseudo_children[nextchild].ti_port);
pseudo_children[nextchild].ti_port = NULL;
IExec->ReleaseSemaphore(&fork_array_sema);
{
if (parent >= 0)
{
struct thread_exit_message *tem =
(struct thread_exit_message *)
IExec->AllocSysObjectTags(
ASOT_MESSAGE, ASOMSG_Size,
sizeof(struct thread_exit_message),
ASOMSG_Length,
sizeof(struct thread_exit_message));
if (tem)
{
tem->tem_pid = pseudo_id;
tem->tem_status = status;
IExec->PutMsg(pseudo_children[parent].ti_port,
(struct Message *)tem);
}
}
}
#ifdef PERL_SYNC_FORK
return id;
#else
return (void *)status;
#endif
}
#endif /* USE_ITHREADS */
Pid_t amigaos_fork()
{
dTHX;
pthread_t id;
int handle;
struct child_arg arg;
if (num_pseudo_children >= MAX_THREADS)
{
errno = EAGAIN;
return -1;
}
arg.ca_interp = perl_clone((PerlInterpreter *)aTHX, CLONEf_COPY_STACKS);
arg.ca_parent_task = IExec->FindTask(NULL);
arg.ca_parent =
pthread_self() ? pthread_self() : (pthread_t)IExec->FindTask(0);
handle = pthread_create(&id, NULL, amigaos4_start_child, (void *)&arg);
pseudo_children[findparent(arg.ca_parent)].ti_children++;
IExec->Wait(SIGBREAKF_CTRL_F);
PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
if (handle)
{
errno = EAGAIN;
return -1;
}
return id;
}
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, (void **)argflags);
}
else
{
while ((result = pthread_join(pid, (void **)argflags)) == -1 &&
errno == EINTR)
{
// PERL_ASYNC_CHECK();
}
}
return result;
}
void amigaos_fork_set_userdata(
pTHX_ struct UserData *userdata, I32 did_pipes, int pp, SV **sp, SV **mark)
{
userdata->parent = IExec->FindTask(0);
userdata->did_pipes = did_pipes;
userdata->pp = pp;
userdata->sp = sp;
userdata->mark = mark;
userdata->my_perl = aTHX;
}
/* AmigaOS specific versions of #?exec#? solely for use in amigaos_system_child
*/
static void S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
{
const int e = errno;
// PERL_ARGS_ASSERT_EXEC_FAILED;
if (e)
{
if (ckWARN(WARN_EXEC))
Perl_warner(aTHX_ packWARN(WARN_EXEC),
"Can't exec \"%s\": %s", cmd, Strerror(e));
}
if (do_report)
{
/* XXX silently ignore failures */
PERL_UNUSED_RESULT(PerlLIO_write(fd, (void *)&e, sizeof(int)));
PerlLIO_close(fd);
}
}
static I32 S_do_amigaos_exec3(pTHX_ const char *incmd, int fd, int do_report)
{
dVAR;
const char **argv, **a;
char *s;
char *buf;
char *cmd;
/* Make a copy so we can change it */
const Size_t cmdlen = strlen(incmd) + 1;
I32 result = -1;
PERL_ARGS_ASSERT_DO_EXEC3;
ENTER;
Newx(buf, cmdlen, char);
SAVEFREEPV(buf);
cmd = buf;
memcpy(cmd, incmd, cmdlen);
while (*cmd && isSPACE(*cmd))
cmd++;
/* see if there are shell metacharacters in it */
if (*cmd == '.' && isSPACE(cmd[1]))
goto doshell;
if (strBEGINs(cmd, "exec") && isSPACE(cmd[4]))
goto doshell;
s = cmd;
while (isWORDCHAR(*s))
s++; /* catch VAR=val gizmo */
if (*s == '=')
goto doshell;
for (s = cmd; *s; s++)
{
if (*s != ' ' && !isALPHA(*s) &&
strchr("$&*(){}[]'\";\\|?<>~`\n", *s))
{
if (*s == '\n' && !s[1])
{
*s = '\0';
break;
}
/* handle the 2>&1 construct at the end */
if (*s == '>' && s[1] == '&' && s[2] == '1' &&
s > cmd + 1 && s[-1] == '2' && isSPACE(s[-2]) &&
(!s[3] || isSPACE(s[3])))
{
const char *t = s + 3;
while (*t && isSPACE(*t))
++t;
if (!*t && (PerlLIO_dup2(1, 2) != -1))
{
s[-2] = '\0';
break;
}
}
doshell:
PERL_FPU_PRE_EXEC
result = myexecl(FALSE, PL_sh_path, "sh", "-c", cmd,
(char *)NULL);
PERL_FPU_POST_EXEC
S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
amigaos_post_exec(fd, do_report);
goto leave;
}
}
Newx(argv, (s - cmd) / 2 + 2, const char *);
SAVEFREEPV(argv);
cmd = savepvn(cmd, s - cmd);
SAVEFREEPV(cmd);
a = argv;
for (s = cmd; *s;)
{
while (isSPACE(*s))
s++;
if (*s)
*(a++) = s;
while (*s && !isSPACE(*s))
s++;
if (*s)
*s++ = '\0';
}
*a = NULL;
if (argv[0])
{
PERL_FPU_PRE_EXEC
result = myexecvp(FALSE, argv[0], EXEC_ARGV_CAST(argv));
PERL_FPU_POST_EXEC
if (errno == ENOEXEC) /* for system V NIH syndrome */
goto doshell;
S_exec_failed(aTHX_ argv[0], fd, do_report);
amigaos_post_exec(fd, do_report);
}
leave:
LEAVE;
return result;
}
I32 S_do_amigaos_aexec5(
pTHX_ SV *really, SV **mark, SV **sp, int fd, int do_report)
{
dVAR;
I32 result = -1;
PERL_ARGS_ASSERT_DO_AEXEC5;
ENTER;
if (sp > mark)
{
const char **argv, **a;
const char *tmps = NULL;
Newx(argv, sp - mark + 1, const char *);
SAVEFREEPV(argv);
a = argv;
while (++mark <= sp)
{
if (*mark) {
char *arg = savepv(SvPV_nolen_const(*mark));
SAVEFREEPV(arg);
*a++ = arg;
} else
*a++ = "";
}
*a = NULL;
if (really) {
tmps = savepv(SvPV_nolen_const(really));
SAVEFREEPV(tmps);
}
if ((!really && *argv[0] != '/') ||
(really && *tmps != '/')) /* will execvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably
*/
PERL_FPU_PRE_EXEC
if (really && *tmps)
{
result = myexecvp(FALSE, tmps, EXEC_ARGV_CAST(argv));
}
else
{
result = myexecvp(FALSE, argv[0], EXEC_ARGV_CAST(argv));
}
PERL_FPU_POST_EXEC
S_exec_failed(aTHX_(really ? tmps : argv[0]), fd, do_report);
}
amigaos_post_exec(fd, do_report);
LEAVE;
return result;
}
void *amigaos_system_child(void *userdata)
{
struct Task *parent;
I32 did_pipes;
int pp;
I32 value;
STRLEN n_a;
/* these next are declared by macros else where but I may be
* passing modified values here so declare them explictly but
* still referred to by macro below */
register SV **sp;
register SV **mark;
register PerlInterpreter *my_perl;
StdioStore store;
struct UserData *ud = (struct UserData *)userdata;
did_pipes = ud->did_pipes;
parent = ud->parent;
pp = ud->pp;
SP = ud->sp;
MARK = ud->mark;
my_perl = ud->my_perl;
PERL_SET_THX(my_perl);
amigaos_stdio_save(aTHX_ & store);
if (did_pipes)
{
// PerlLIO_close(pp[0]);
}
if (PL_op->op_flags & OPf_STACKED)
{
SV *really = *++MARK;
value = (I32)S_do_amigaos_aexec5(aTHX_ really, MARK, SP, pp,
did_pipes);
}
else if (SP - MARK != 1)
{
value = (I32)S_do_amigaos_aexec5(aTHX_ NULL, MARK, SP, pp,
did_pipes);
}
else
{
value = (I32)S_do_amigaos_exec3(
aTHX_ SvPVx(sv_mortalcopy(*SP), n_a), pp, did_pipes);
}
// Forbid();
// Signal(parent, SIGBREAKF_CTRL_F);
amigaos_stdio_restore(aTHX_ & store);
return (void *)value;
}
static BOOL contains_whitespace(char *string)
{
if (string)
{
if (strchr(string, ' '))
return TRUE;
if (strchr(string, '\t'))
return TRUE;
if (strchr(string, '\n'))
return TRUE;
if (strchr(string, 0xA0))
return TRUE;
if (strchr(string, '"'))
return TRUE;
}
return FALSE;
}
static int no_of_escapes(char *string)
{
int cnt = 0;
char *p;
for (p = string; p < string + strlen(string); p++)
{
if (*p == '"')
cnt++;
if (*p == '*')
cnt++;
if (*p == '\n')
cnt++;
if (*p == '\t')
cnt++;
}
return cnt;
}
struct command_data
{
STRPTR args;
BPTR seglist;
struct Task *parent;
};
#undef fopen
#undef fgetc
#undef fgets
#undef fclose
#define __USE_RUNCOMMAND__
int myexecve(bool isperlthread,
const char *filename,
char *argv[],
char *envp[])
{
FILE *fh;
char buffer[1000];
int size = 0;
char **cur;
char *interpreter = 0;
char *interpreter_args = 0;
char *full = 0;
char *filename_conv = 0;
char *interpreter_conv = 0;
// char *tmp = 0;
char *fname;
// int tmpint;
// struct Task *thisTask = IExec->FindTask(0);
int result = -1;
StdioStore store;
pTHX = NULL;
if (isperlthread)
{
aTHX = PERL_GET_THX;
/* Save away our stdio */
amigaos_stdio_save(aTHX_ & store);
}
// adebug("%s %ld %s\n",__FUNCTION__,__LINE__,filename?filename:"NULL");
/* Calculate the size of filename and all args, including spaces and
* quotes */
size = 0; // strlen(filename) + 1;
for (cur = (char **)argv /* +1 */; *cur; cur++)
{
size +=
strlen(*cur) + 1 +
(contains_whitespace(*cur) ? (2 + no_of_escapes(*cur)) : 0);
}
/* Check if it's a script file */
IExec->DebugPrintF("%s %ld %08lx %c %c\n",__FILE__,__LINE__,filename,filename[0],filename[1]);
fh = fopen(filename, "r");
if (fh)
{
if (fgetc(fh) == '#' && fgetc(fh) == '!')
{
char *p;
char *q;
fgets(buffer, 999, fh);
p = buffer;
while (*p == ' ' || *p == '\t')
p++;
if (buffer[strlen(buffer) - 1] == '\n')
buffer[strlen(buffer) - 1] = '\0';
if ((q = strchr(p, ' ')))
{
*q++ = '\0';
if (*q != '\0')
{
interpreter_args = mystrdup(q);
}
}
else
interpreter_args = mystrdup("");
interpreter = mystrdup(p);
size += strlen(interpreter) + 1;
size += strlen(interpreter_args) + 1;
}
fclose(fh);
}
else
{
/* We couldn't open this why not? */
if (errno == ENOENT)
{
/* file didn't exist! */
goto out;
}
}
/* Allocate the command line */
filename_conv = convert_path_u2a(filename);
if (filename_conv)
size += strlen(filename_conv);
size += 1;
full = (char *)IExec->AllocVecTags(size + 10, AVT_ClearWithValue, 0 ,TAG_DONE);
if (full)
{
if (interpreter)
{
interpreter_conv = convert_path_u2a(interpreter);
#if !defined(__USE_RUNCOMMAND__)
#warning(using system!)
sprintf(full, "%s %s %s ", interpreter_conv,
interpreter_args, filename_conv);
#else
sprintf(full, "%s %s ", interpreter_args,
filename_conv);
#endif
IExec->FreeVec(interpreter);
IExec->FreeVec(interpreter_args);
if (filename_conv)
IExec->FreeVec(filename_conv);
fname = mystrdup(interpreter_conv);
if (interpreter_conv)
IExec->FreeVec(interpreter_conv);
}
else
{
#ifndef __USE_RUNCOMMAND__
sprintf(full, "%s ", filename_conv);
#else
sprintf(full, "");
#endif
fname = mystrdup(filename_conv);
if (filename_conv)
IExec->FreeVec(filename_conv);
}
for (cur = (char **)(argv + 1); *cur != 0; cur++)
{
if (contains_whitespace(*cur))
{
int esc = no_of_escapes(*cur);
if (esc > 0)
{
char *buff = (char *)IExec->AllocVecTags(
strlen(*cur) + 4 + esc,
AVT_ClearWithValue,0,
TAG_DONE);
char *p = *cur;
char *q = buff;
*q++ = '"';
while (*p != '\0')
{
if (*p == '\n')
{
*q++ = '*';
*q++ = 'N';
p++;
continue;
}
else if (*p == '"')
{
*q++ = '*';
*q++ = '"';
p++;
continue;
}
else if (*p == '*')
{
*q++ = '*';
}
*q++ = *p++;
}
*q++ = '"';
*q++ = ' ';
*q = '\0';
strcat(full, buff);
IExec->FreeVec(buff);
}
else
{
strcat(full, "\"");
strcat(full, *cur);
strcat(full, "\" ");
}
}
else
{
strcat(full, *cur);
strcat(full, " ");
}
}
strcat(full, "\n");
// if(envp)
// createvars(envp);
#ifndef __USE_RUNCOMMAND__
result = IDOS->SystemTags(
full, SYS_UserShell, TRUE, NP_StackSize,
((struct Process *)thisTask)->pr_StackSize, SYS_Input,
((struct Process *)thisTask)->pr_CIS, SYS_Output,
((struct Process *)thisTask)->pr_COS, SYS_Error,
((struct Process *)thisTask)->pr_CES, TAG_DONE);
#else
if (fname)
{
BPTR seglist = IDOS->LoadSeg(fname);
if (seglist)
{
/* check if we have an executable! */
struct PseudoSegList *ps = NULL;
if (!IDOS->GetSegListInfoTags(
seglist, GSLI_Native, &ps, TAG_DONE))
{
IDOS->GetSegListInfoTags(
seglist, GSLI_68KPS, &ps, TAG_DONE);
}
if (ps != NULL)
{
// adebug("%s %ld %s
// %s\n",__FUNCTION__,__LINE__,fname,full);
IDOS->SetCliProgramName(fname);
// result=RunCommand(seglist,8*1024,full,strlen(full));
// result=myruncommand(seglist,8*1024,full,strlen(full),envp);
result = myruncommand(seglist, 8 * 1024,
full, -1, envp);
errno = 0;
}
else
{
errno = ENOEXEC;
}
IDOS->UnLoadSeg(seglist);
}
else
{
errno = ENOEXEC;
}
IExec->FreeVec(fname);
}
#endif /* USE_RUNCOMMAND */
IExec->FreeVec(full);
if (errno == ENOEXEC)
{
result = -1;
}
goto out;
}
if (interpreter)
IExec->FreeVec(interpreter);
if (filename_conv)
IExec->FreeVec(filename_conv);
errno = ENOMEM;
out:
if (isperlthread)
{
amigaos_stdio_restore(aTHX_ & store);
STATUS_NATIVE_CHILD_SET(result);
PL_exit_flags |= PERL_EXIT_EXPECTED;
if (result != -1)
my_exit(result);
}
return (result);
}
Reference in New Issue View Git Blame Copy Permalink