1 | #define PERLIO_NOT_STDIO 0
|
---|
2 | #include "djgpp.h"
|
---|
3 |
|
---|
4 | /* hold file pointer, command, mode, and the status of the command */
|
---|
5 | struct pipe_list {
|
---|
6 | FILE *fp;
|
---|
7 | int exit_status;
|
---|
8 | struct pipe_list *next;
|
---|
9 | char *command, mode;
|
---|
10 | };
|
---|
11 |
|
---|
12 | /* static, global list pointer */
|
---|
13 | static struct pipe_list *pl = NULL;
|
---|
14 |
|
---|
15 | FILE *
|
---|
16 | djgpp_popen (const char *cm, const char *md) /* program name, pipe mode */
|
---|
17 | {
|
---|
18 | struct pipe_list *l1;
|
---|
19 | int fd;
|
---|
20 | char *temp_name=NULL;
|
---|
21 |
|
---|
22 | /* make new node */
|
---|
23 | if ((l1 = (struct pipe_list *) malloc (sizeof (*l1)))
|
---|
24 | && (temp_name = malloc (L_tmpnam)) && tmpnam (temp_name))
|
---|
25 | {
|
---|
26 | l1->fp = NULL;
|
---|
27 | l1->command = NULL;
|
---|
28 | l1->next = pl;
|
---|
29 | l1->exit_status = -1;
|
---|
30 | l1->mode = md[0];
|
---|
31 |
|
---|
32 | /* if caller wants to read */
|
---|
33 | if (md[0] == 'r' && (fd = dup (fileno (stdout))) >= 0)
|
---|
34 | {
|
---|
35 | if ((l1->fp = freopen (temp_name, "wb", stdout)))
|
---|
36 | {
|
---|
37 | l1->exit_status = system (cm);
|
---|
38 | if (dup2 (fd, fileno (stdout)) >= 0)
|
---|
39 | l1->fp = fopen (temp_name, md);
|
---|
40 | }
|
---|
41 | close (fd);
|
---|
42 | }
|
---|
43 | /* if caller wants to write */
|
---|
44 | else if (md[0] == 'w' && (l1->command = malloc (1 + strlen (cm))))
|
---|
45 | {
|
---|
46 | strcpy (l1->command, cm);
|
---|
47 | l1->fp = fopen (temp_name, md);
|
---|
48 | }
|
---|
49 |
|
---|
50 | if (l1->fp)
|
---|
51 | {
|
---|
52 | l1->fp->_flag |= _IORMONCL; /* remove on close */
|
---|
53 | l1->fp->_name_to_remove = temp_name;
|
---|
54 | return (pl = l1)->fp;
|
---|
55 | }
|
---|
56 | free (l1->command);
|
---|
57 | }
|
---|
58 | free (temp_name);
|
---|
59 | free (l1);
|
---|
60 | return NULL;
|
---|
61 | }
|
---|
62 |
|
---|
63 | int
|
---|
64 | djgpp_pclose (FILE *pp)
|
---|
65 | {
|
---|
66 | struct pipe_list *l1, **l2; /* list pointers */
|
---|
67 | int retval=-1; /* function return value */
|
---|
68 |
|
---|
69 | for (l2 = &pl; *l2 && (*l2)->fp != pp; l2 = &((*l2)->next))
|
---|
70 | ;
|
---|
71 | if (!(l1 = *l2))
|
---|
72 | return retval;
|
---|
73 | *l2 = l1->next;
|
---|
74 |
|
---|
75 | /* if pipe was opened to write */
|
---|
76 | if (l1->mode == 'w')
|
---|
77 | {
|
---|
78 | int fd;
|
---|
79 | fflush (l1->fp);
|
---|
80 | close (fileno (l1->fp));
|
---|
81 |
|
---|
82 | if ((fd = dup (fileno (stdin))) >= 0
|
---|
83 | && (freopen (l1->fp->_name_to_remove, "rb", stdin)))
|
---|
84 | {
|
---|
85 | retval = system (l1->command);
|
---|
86 | dup2 (fd, fileno (stdin));
|
---|
87 | }
|
---|
88 | close (fd);
|
---|
89 | free (l1->command);
|
---|
90 | }
|
---|
91 | else
|
---|
92 | /* if pipe was opened to read, return the exit status we saved */
|
---|
93 | retval = l1->exit_status;
|
---|
94 |
|
---|
95 | fclose (l1->fp); /* this removes the temp file */
|
---|
96 | free (l1);
|
---|
97 | return retval; /* retval==0 ? OK : ERROR */
|
---|
98 | }
|
---|
99 |
|
---|
100 | /**/
|
---|
101 |
|
---|
102 | #define EXECF_SPAWN 0
|
---|
103 | #define EXECF_EXEC 1
|
---|
104 |
|
---|
105 | static int
|
---|
106 | convretcode (pTHX_ int rc,char *prog,int fl)
|
---|
107 | {
|
---|
108 | if (rc < 0 && ckWARN(WARN_EXEC))
|
---|
109 | Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't %s \"%s\": %s",
|
---|
110 | fl ? "exec" : "spawn",prog,Strerror (errno));
|
---|
111 | if (rc >= 0)
|
---|
112 | return rc << 8;
|
---|
113 | return -1;
|
---|
114 | }
|
---|
115 |
|
---|
116 | int
|
---|
117 | do_aspawn (pTHX_ SV *really,SV **mark,SV **sp)
|
---|
118 | {
|
---|
119 | int rc;
|
---|
120 | char **a,*tmps,**argv;
|
---|
121 | STRLEN n_a;
|
---|
122 |
|
---|
123 | if (sp<=mark)
|
---|
124 | return -1;
|
---|
125 | a=argv=(char**) alloca ((sp-mark+3)*sizeof (char*));
|
---|
126 |
|
---|
127 | while (++mark <= sp)
|
---|
128 | if (*mark)
|
---|
129 | *a++ = SvPVx(*mark, n_a);
|
---|
130 | else
|
---|
131 | *a++ = "";
|
---|
132 | *a = Nullch;
|
---|
133 |
|
---|
134 | if (argv[0][0] != '/' && argv[0][0] != '\\'
|
---|
135 | && !(argv[0][0] && argv[0][1] == ':'
|
---|
136 | && (argv[0][2] == '/' || argv[0][2] != '\\'))
|
---|
137 | ) /* will swawnvp use PATH? */
|
---|
138 | TAINT_ENV(); /* testing IFS here is overkill, probably */
|
---|
139 |
|
---|
140 | if (really && *(tmps = SvPV(really, n_a)))
|
---|
141 | rc=spawnvp (P_WAIT,tmps,argv);
|
---|
142 | else
|
---|
143 | rc=spawnvp (P_WAIT,argv[0],argv);
|
---|
144 |
|
---|
145 | return convretcode (rc,argv[0],EXECF_SPAWN);
|
---|
146 | }
|
---|
147 |
|
---|
148 | #define EXTRA "\x00\x00\x00\x00\x00\x00"
|
---|
149 |
|
---|
150 | int
|
---|
151 | do_spawn2 (pTHX_ char *cmd,int execf)
|
---|
152 | {
|
---|
153 | char **a,*s,*shell,*metachars;
|
---|
154 | int rc,unixysh;
|
---|
155 |
|
---|
156 | if ((shell=getenv("SHELL"))==NULL && (shell=getenv("COMSPEC"))==NULL)
|
---|
157 | shell="c:\\command.com" EXTRA;
|
---|
158 |
|
---|
159 | unixysh=_is_unixy_shell (shell);
|
---|
160 | metachars=unixysh ? "$&*(){}[]'\";\\?>|<~`\n" EXTRA : "*?[|<>\"\\" EXTRA;
|
---|
161 |
|
---|
162 | while (*cmd && isSPACE(*cmd))
|
---|
163 | cmd++;
|
---|
164 |
|
---|
165 | if (strnEQ (cmd,"/bin/sh",7) && isSPACE (cmd[7]))
|
---|
166 | cmd+=5;
|
---|
167 |
|
---|
168 | /* save an extra exec if possible */
|
---|
169 | /* see if there are shell metacharacters in it */
|
---|
170 | if (strstr (cmd,"..."))
|
---|
171 | goto doshell;
|
---|
172 | if (unixysh)
|
---|
173 | {
|
---|
174 | if (*cmd=='.' && isSPACE (cmd[1]))
|
---|
175 | goto doshell;
|
---|
176 | if (strnEQ (cmd,"exec",4) && isSPACE (cmd[4]))
|
---|
177 | goto doshell;
|
---|
178 | for (s=cmd; *s && isALPHA (*s); s++) ; /* catch VAR=val gizmo */
|
---|
179 | if (*s=='=')
|
---|
180 | goto doshell;
|
---|
181 | }
|
---|
182 | for (s=cmd; *s; s++)
|
---|
183 | if (strchr (metachars,*s))
|
---|
184 | {
|
---|
185 | if (*s=='\n' && s[1]=='\0')
|
---|
186 | {
|
---|
187 | *s='\0';
|
---|
188 | break;
|
---|
189 | }
|
---|
190 | doshell:
|
---|
191 | if (execf==EXECF_EXEC)
|
---|
192 | return convretcode (execl (shell,shell,unixysh ? "-c" : "/c",cmd,NULL),cmd,execf);
|
---|
193 | return convretcode (system (cmd),cmd,execf);
|
---|
194 | }
|
---|
195 |
|
---|
196 | Newx (PL_Argv,(s-cmd)/2+2,char*);
|
---|
197 | PL_Cmd=savepvn (cmd,s-cmd);
|
---|
198 | a=PL_Argv;
|
---|
199 | for (s=PL_Cmd; *s;) {
|
---|
200 | while (*s && isSPACE (*s)) s++;
|
---|
201 | if (*s)
|
---|
202 | *(a++)=s;
|
---|
203 | while (*s && !isSPACE (*s)) s++;
|
---|
204 | if (*s)
|
---|
205 | *s++='\0';
|
---|
206 | }
|
---|
207 | *a=Nullch;
|
---|
208 | if (!PL_Argv[0])
|
---|
209 | return -1;
|
---|
210 |
|
---|
211 | if (execf==EXECF_EXEC)
|
---|
212 | rc=execvp (PL_Argv[0],PL_Argv);
|
---|
213 | else
|
---|
214 | rc=spawnvp (P_WAIT,PL_Argv[0],PL_Argv);
|
---|
215 | return convretcode (rc,PL_Argv[0],execf);
|
---|
216 | }
|
---|
217 |
|
---|
218 | int
|
---|
219 | do_spawn (pTHX_ char *cmd)
|
---|
220 | {
|
---|
221 | return do_spawn2 (aTHX_ cmd,EXECF_SPAWN);
|
---|
222 | }
|
---|
223 |
|
---|
224 | bool
|
---|
225 | Perl_do_exec (pTHX_ char *cmd)
|
---|
226 | {
|
---|
227 | do_spawn2 (aTHX_ cmd,EXECF_EXEC);
|
---|
228 | return FALSE;
|
---|
229 | }
|
---|
230 |
|
---|
231 | /**/
|
---|
232 |
|
---|
233 | struct globinfo
|
---|
234 | {
|
---|
235 | int fd;
|
---|
236 | char *matches;
|
---|
237 | size_t size;
|
---|
238 | fpos_t pos;
|
---|
239 | };
|
---|
240 |
|
---|
241 | #define MAXOPENGLOBS 10
|
---|
242 |
|
---|
243 | static struct globinfo myglobs[MAXOPENGLOBS];
|
---|
244 |
|
---|
245 | static struct globinfo *
|
---|
246 | searchfd (int fd)
|
---|
247 | {
|
---|
248 | int ic;
|
---|
249 | for (ic=0; ic<MAXOPENGLOBS; ic++)
|
---|
250 | if (myglobs[ic].fd==fd)
|
---|
251 | return myglobs+ic;
|
---|
252 | return NULL;
|
---|
253 | }
|
---|
254 |
|
---|
255 | static int
|
---|
256 | glob_handler (__FSEXT_Fnumber n,int *rv,va_list args)
|
---|
257 | {
|
---|
258 | unsigned ic;
|
---|
259 | struct globinfo *gi;
|
---|
260 | switch (n)
|
---|
261 | {
|
---|
262 | case __FSEXT_open:
|
---|
263 | {
|
---|
264 | char *p1,*pattern,*name=va_arg (args,char*);
|
---|
265 | STRLEN len;
|
---|
266 | glob_t pglob;
|
---|
267 |
|
---|
268 | if (strnNE (name,"/dev/dosglob/",13))
|
---|
269 | break;
|
---|
270 | if ((gi=searchfd (-1)) == NULL)
|
---|
271 | break;
|
---|
272 |
|
---|
273 | gi->pos=0;
|
---|
274 | pattern=alloca (strlen (name+=13)+1);
|
---|
275 | strcpy (pattern,name);
|
---|
276 | if (!_USE_LFN)
|
---|
277 | strlwr (pattern);
|
---|
278 | ic=pglob.gl_pathc=0;
|
---|
279 | pglob.gl_pathv=NULL;
|
---|
280 | while (pattern)
|
---|
281 | {
|
---|
282 | if ((p1=strchr (pattern,' '))!=NULL)
|
---|
283 | *p1=0;
|
---|
284 | glob (pattern,ic,0,&pglob);
|
---|
285 | ic=GLOB_APPEND;
|
---|
286 | if ((pattern=p1)!=NULL)
|
---|
287 | pattern++;
|
---|
288 | }
|
---|
289 | for (ic=len=0; ic<pglob.gl_pathc; ic++)
|
---|
290 | len+=1+strlen (pglob.gl_pathv[ic]);
|
---|
291 | if (len)
|
---|
292 | {
|
---|
293 | if ((gi->matches=p1=(char*) malloc (gi->size=len))==NULL)
|
---|
294 | break;
|
---|
295 | for (ic=0; ic<pglob.gl_pathc; ic++)
|
---|
296 | {
|
---|
297 | strcpy (p1,pglob.gl_pathv[ic]);
|
---|
298 | p1+=strlen (p1)+1;
|
---|
299 | }
|
---|
300 | }
|
---|
301 | else
|
---|
302 | {
|
---|
303 | if ((gi->matches=strdup (name))==NULL)
|
---|
304 | break;
|
---|
305 | gi->size=strlen (name)+1;
|
---|
306 | }
|
---|
307 | globfree (&pglob);
|
---|
308 | gi->fd=*rv=__FSEXT_alloc_fd (glob_handler);
|
---|
309 | return 1;
|
---|
310 | }
|
---|
311 | case __FSEXT_read:
|
---|
312 | {
|
---|
313 | int fd=va_arg (args,int);
|
---|
314 | char *buf=va_arg (args,char*);
|
---|
315 | size_t siz=va_arg (args,size_t);
|
---|
316 |
|
---|
317 | if ((gi=searchfd (fd))==NULL)
|
---|
318 | break;
|
---|
319 |
|
---|
320 | if (siz+gi->pos > gi->size)
|
---|
321 | siz = gi->size - gi->pos;
|
---|
322 | memcpy (buf,gi->pos+gi->matches,siz);
|
---|
323 | gi->pos += siz;
|
---|
324 | *rv=siz;
|
---|
325 | return 1;
|
---|
326 | }
|
---|
327 | case __FSEXT_close:
|
---|
328 | {
|
---|
329 | int fd=va_arg (args,int);
|
---|
330 |
|
---|
331 | if ((gi=searchfd (fd))==NULL)
|
---|
332 | break;
|
---|
333 | free (gi->matches);
|
---|
334 | gi->fd=-1;
|
---|
335 | break;
|
---|
336 | }
|
---|
337 | default:
|
---|
338 | break;
|
---|
339 | }
|
---|
340 | return 0;
|
---|
341 | }
|
---|
342 |
|
---|
343 | static
|
---|
344 | XS(dos_GetCwd)
|
---|
345 | {
|
---|
346 | dXSARGS;
|
---|
347 |
|
---|
348 | if (items)
|
---|
349 | Perl_croak (aTHX_ "Usage: Dos::GetCwd()");
|
---|
350 | {
|
---|
351 | char tmp[PATH_MAX+2];
|
---|
352 | ST(0)=sv_newmortal ();
|
---|
353 | if (getcwd (tmp,PATH_MAX+1)!=NULL)
|
---|
354 | sv_setpv ((SV*)ST(0),tmp);
|
---|
355 | #ifndef INCOMPLETE_TAINTS
|
---|
356 | SvTAINTED_on(ST(0));
|
---|
357 | #endif
|
---|
358 | }
|
---|
359 | XSRETURN (1);
|
---|
360 | }
|
---|
361 |
|
---|
362 | static
|
---|
363 | XS(dos_UseLFN)
|
---|
364 | {
|
---|
365 | dXSARGS;
|
---|
366 | XSRETURN_IV (_USE_LFN);
|
---|
367 | }
|
---|
368 |
|
---|
369 | XS(XS_Cwd_sys_cwd)
|
---|
370 | {
|
---|
371 | dXSARGS;
|
---|
372 | if (items != 0)
|
---|
373 | Perl_croak_nocontext("Usage: Cwd::sys_cwd()");
|
---|
374 | {
|
---|
375 | char p[MAXPATHLEN];
|
---|
376 | char * RETVAL;
|
---|
377 | RETVAL = getcwd(p, MAXPATHLEN);
|
---|
378 | ST(0) = sv_newmortal();
|
---|
379 | sv_setpv((SV*)ST(0), RETVAL);
|
---|
380 | #ifndef INCOMPLETE_TAINTS
|
---|
381 | SvTAINTED_on(ST(0));
|
---|
382 | #endif
|
---|
383 | }
|
---|
384 | XSRETURN(1);
|
---|
385 | }
|
---|
386 |
|
---|
387 | void
|
---|
388 | Perl_init_os_extras(pTHX)
|
---|
389 | {
|
---|
390 | char *file = __FILE__;
|
---|
391 |
|
---|
392 | dXSUB_SYS;
|
---|
393 |
|
---|
394 | newXS ("Dos::GetCwd",dos_GetCwd,file);
|
---|
395 | newXS ("Dos::UseLFN",dos_UseLFN,file);
|
---|
396 | newXS ("Cwd::sys_cwd",XS_Cwd_sys_cwd,file);
|
---|
397 |
|
---|
398 | /* install my File System Extension for globbing */
|
---|
399 | __FSEXT_add_open_handler (glob_handler);
|
---|
400 | memset (myglobs,-1,sizeof (myglobs));
|
---|
401 | }
|
---|
402 |
|
---|
403 | static char *perlprefix;
|
---|
404 |
|
---|
405 | #define PERL5 "/perl5"
|
---|
406 |
|
---|
407 | char *
|
---|
408 | djgpp_pathexp (const char *p)
|
---|
409 | {
|
---|
410 | static char expp[PATH_MAX];
|
---|
411 | strcpy (expp,perlprefix);
|
---|
412 | switch (p[0])
|
---|
413 | {
|
---|
414 | case 'B':
|
---|
415 | strcat (expp,"/bin");
|
---|
416 | break;
|
---|
417 | case 'S':
|
---|
418 | strcat (expp,"/lib" PERL5 "/site");
|
---|
419 | break;
|
---|
420 | default:
|
---|
421 | strcat (expp,"/lib" PERL5);
|
---|
422 | break;
|
---|
423 | }
|
---|
424 | return expp;
|
---|
425 | }
|
---|
426 |
|
---|
427 | void
|
---|
428 | Perl_DJGPP_init (int *argcp,char ***argvp)
|
---|
429 | {
|
---|
430 | char *p;
|
---|
431 |
|
---|
432 | perlprefix=strdup (**argvp);
|
---|
433 | strlwr (perlprefix);
|
---|
434 | if ((p=strrchr (perlprefix,'/'))!=NULL)
|
---|
435 | {
|
---|
436 | *p=0;
|
---|
437 | if (strEQ (p-4,"/bin"))
|
---|
438 | p[-4]=0;
|
---|
439 | }
|
---|
440 | else
|
---|
441 | strcpy (perlprefix,"..");
|
---|
442 | }
|
---|
443 |
|
---|
444 | int
|
---|
445 | djgpp_fflush (FILE *fp)
|
---|
446 | {
|
---|
447 | int res;
|
---|
448 |
|
---|
449 | if ((res = fflush(fp)) == 0 && fp) {
|
---|
450 | Stat_t s;
|
---|
451 | if (Fstat(fileno(fp), &s) == 0 && !S_ISSOCK(s.st_mode))
|
---|
452 | res = fsync(fileno(fp));
|
---|
453 | }
|
---|
454 | /*
|
---|
455 | * If the flush succeeded but set end-of-file, we need to clear
|
---|
456 | * the error because our caller may check ferror(). BTW, this
|
---|
457 | * probably means we just flushed an empty file.
|
---|
458 | */
|
---|
459 | if (res == 0 && fp && ferror(fp) == EOF) clearerr(fp);
|
---|
460 |
|
---|
461 | return res;
|
---|
462 | }
|
---|
463 |
|
---|
464 | int djgpp_get_stream_mode(FILE *f)
|
---|
465 | {
|
---|
466 | extern char *__file_handle_modes;
|
---|
467 |
|
---|
468 | int mode = __file_handle_modes[fileno(f)];
|
---|
469 | if (f->_flag & _IORW)
|
---|
470 | return mode | O_RDWR;
|
---|
471 | if (f->_flag & _IOWRT)
|
---|
472 | return mode | O_WRONLY;
|
---|
473 | return mode | O_RDONLY;
|
---|
474 | }
|
---|
475 |
|
---|