1 #include <libc/stubs.h>
12 #include <sys/fsext.h>
18 /* hold file pointer, command, mode, and the status of the command */
22 struct pipe_list *next;
26 /* static, global list pointer */
27 static struct pipe_list *pl = NULL;
30 popen (const char *cm, const char *md) /* program name, pipe mode */
37 if ((l1 = (struct pipe_list *) malloc (sizeof (*l1)))
38 && (temp_name = malloc (L_tmpnam)) && tmpnam (temp_name))
46 /* if caller wants to read */
47 if (md[0] == 'r' && (fd = dup (fileno (stdout))) >= 0)
49 if ((l1->fp = freopen (temp_name, "wb", stdout)))
51 l1->exit_status = system (cm);
52 if (dup2 (fd, fileno (stdout)) >= 0)
53 l1->fp = fopen (temp_name, md);
57 /* if caller wants to write */
58 else if (md[0] == 'w' && (l1->command = malloc (1 + strlen (cm))))
60 strcpy (l1->command, cm);
61 l1->fp = fopen (temp_name, md);
66 l1->fp->_flag |= _IORMONCL; /* remove on close */
67 l1->fp->_name_to_remove = temp_name;
80 struct pipe_list *l1, **l2; /* list pointers */
81 int retval=-1; /* function return value */
83 for (l2 = &pl; *l2 && (*l2)->fp != pp; l2 = &((*l2)->next))
89 /* if pipe was opened to write */
94 close (fileno (l1->fp));
96 if ((fd = dup (fileno (stdin))) >= 0
97 && (freopen (l1->fp->_name_to_remove, "rb", stdin)))
99 retval = system (l1->command);
100 dup2 (fd, fileno (stdin));
106 /* if pipe was opened to read, return the exit status we saved */
107 retval = l1->exit_status;
109 fclose (l1->fp); /* this removes the temp file */
111 return retval; /* retval==0 ? OK : ERROR */
116 #define EXECF_SPAWN 0
120 convretcode (pTHX_ int rc,char *prog,int fl)
122 if (rc < 0 && ckWARN(WARN_EXEC))
123 Perl_warner(aTHX_ WARN_EXEC,"Can't %s \"%s\": %s",
124 fl ? "exec" : "spawn",prog,Strerror (errno));
133 do_aspawn (pTHX_ SV *really,SV **mark,SV **sp)
137 char **a,*tmps,**argv;
142 a=argv=(char**) alloca ((sp-mark+3)*sizeof (char*));
146 *a++ = SvPVx(*mark, n_a);
151 if (argv[0][0] != '/' && argv[0][0] != '\\'
152 && !(argv[0][0] && argv[0][1] == ':'
153 && (argv[0][2] == '/' || argv[0][2] != '\\'))
154 ) /* will swawnvp use PATH? */
155 TAINT_ENV(); /* testing IFS here is overkill, probably */
157 if (really && *(tmps = SvPV(really, n_a)))
158 rc=spawnvp (P_WAIT,tmps,argv);
160 rc=spawnvp (P_WAIT,argv[0],argv);
162 return convretcode (rc,argv[0],EXECF_SPAWN);
165 #define EXTRA "\x00\x00\x00\x00\x00\x00"
168 do_spawn2 (pTHX_ char *cmd,int execf)
170 char **a,*s,*shell,*metachars;
173 if ((shell=getenv("SHELL"))==NULL && (shell=getenv("COMSPEC"))==NULL)
174 shell="c:\\command.com" EXTRA;
176 unixysh=_is_unixy_shell (shell);
177 metachars=unixysh ? "$&*(){}[]'\";\\?>|<~`\n" EXTRA : "*?[|<>\"\\" EXTRA;
179 while (*cmd && isSPACE(*cmd))
182 if (strnEQ (cmd,"/bin/sh",7) && isSPACE (cmd[7]))
185 /* save an extra exec if possible */
186 /* see if there are shell metacharacters in it */
187 if (strstr (cmd,"..."))
191 if (*cmd=='.' && isSPACE (cmd[1]))
193 if (strnEQ (cmd,"exec",4) && isSPACE (cmd[4]))
195 for (s=cmd; *s && isALPHA (*s); s++) ; /* catch VAR=val gizmo */
200 if (strchr (metachars,*s))
202 if (*s=='\n' && s[1]=='\0')
208 if (execf==EXECF_EXEC)
209 return convretcode (execl (shell,shell,unixysh ? "-c" : "/c",cmd,NULL),cmd,execf);
210 return convretcode (system (cmd),cmd,execf);
213 New (1303,PL_Argv,(s-cmd)/2+2,char*);
214 PL_Cmd=savepvn (cmd,s-cmd);
216 for (s=PL_Cmd; *s;) {
217 while (*s && isSPACE (*s)) s++;
220 while (*s && !isSPACE (*s)) s++;
228 if (execf==EXECF_EXEC)
229 rc=execvp (PL_Argv[0],PL_Argv);
231 rc=spawnvp (P_WAIT,PL_Argv[0],PL_Argv);
232 return convretcode (rc,PL_Argv[0],execf);
236 do_spawn (pTHX_ char *cmd)
238 return do_spawn2 (aTHX_ cmd,EXECF_SPAWN);
242 Perl_do_exec (pTHX_ char *cmd)
244 do_spawn2 (aTHX_ cmd,EXECF_EXEC);
257 #define MAXOPENGLOBS 10
259 static struct globinfo myglobs[MAXOPENGLOBS];
261 static struct globinfo *
265 for (ic=0; ic<MAXOPENGLOBS; ic++)
266 if (myglobs[ic].fd==fd)
272 glob_handler (__FSEXT_Fnumber n,int *rv,va_list args)
280 char *p1,*pattern,*name=va_arg (args,char*);
284 if (strnNE (name,"/dev/dosglob/",13))
286 if ((gi=searchfd (-1)) == NULL)
289 pattern=alloca (strlen (name+=13)+1);
290 strcpy (pattern,name);
297 if ((p1=strchr (pattern,' '))!=NULL)
299 glob (pattern,ic,0,&pglob);
301 if ((pattern=p1)!=NULL)
304 for (ic=len=0; ic<pglob.gl_pathc; ic++)
305 len+=1+strlen (pglob.gl_pathv[ic]);
308 if ((gi->matches=p1=(char*) malloc (gi->size=len))==NULL)
310 for (ic=0; ic<pglob.gl_pathc; ic++)
312 strcpy (p1,pglob.gl_pathv[ic]);
318 if ((gi->matches=strdup (name))==NULL)
320 gi->size=strlen (name)+1;
323 gi->fd=*rv=__FSEXT_alloc_fd (glob_handler);
328 int fd=va_arg (args,int);
329 char *buf=va_arg (args,char*);
330 size_t siz=va_arg (args,size_t);
332 if ((gi=searchfd (fd))==NULL)
336 if (siz+ic>=gi->size)
338 memcpy (buf,ic+gi->matches,siz);
345 int fd=va_arg (args,int);
347 if ((gi=searchfd (fd))==NULL)
365 Perl_croak (aTHX_ "Usage: Dos::GetCwd()");
367 char tmp[PATH_MAX+2];
368 ST(0)=sv_newmortal ();
369 if (getcwd (tmp,PATH_MAX+1)!=NULL)
370 sv_setpv ((SV*)ST(0),tmp);
379 XSRETURN_IV (_USE_LFN);
383 Perl_init_os_extras(pTHX)
385 char *file = __FILE__;
389 newXS ("Dos::GetCwd",dos_GetCwd,file);
390 newXS ("Dos::UseLFN",dos_UseLFN,file);
392 /* install my File System Extension for globbing */
393 __FSEXT_add_open_handler (glob_handler);
394 memset (myglobs,-1,sizeof (myglobs));
397 static char *perlprefix;
399 #define PERL5 "/perl5"
401 char *djgpp_pathexp (const char *p)
403 static char expp[PATH_MAX];
404 strcpy (expp,perlprefix);
408 strcat (expp,"/bin");
411 strcat (expp,"/lib" PERL5 "/site");
414 strcat (expp,"/lib" PERL5);
421 Perl_DJGPP_init (int *argcp,char ***argvp)
425 perlprefix=strdup (**argvp);
427 if ((p=strrchr (perlprefix,'/'))!=NULL)
430 if (strEQ (p-4,"/bin"))
434 strcpy (perlprefix,"..");