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