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 LM |
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 | ||
a02a5408 | 196 | Newx (PL_Argv,(s-cmd)/2+2,char*); |
6b88bc9c GS |
197 | PL_Cmd=savepvn (cmd,s-cmd); |
198 | a=PL_Argv; | |
199 | for (s=PL_Cmd; *s;) { | |
39e571d4 LM |
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 | } | |
4e205ed6 | 207 | *a=NULL; |
6b88bc9c | 208 | if (!PL_Argv[0]) |
39e571d4 LM |
209 | return -1; |
210 | ||
211 | if (execf==EXECF_EXEC) | |
6b88bc9c | 212 | rc=execvp (PL_Argv[0],PL_Argv); |
39e571d4 | 213 | else |
6b88bc9c GS |
214 | rc=spawnvp (P_WAIT,PL_Argv[0],PL_Argv); |
215 | return convretcode (rc,PL_Argv[0],execf); | |
39e571d4 LM |
216 | } |
217 | ||
218 | int | |
41cd3736 | 219 | do_spawn (pTHX_ char *cmd) |
39e571d4 | 220 | { |
41cd3736 | 221 | return do_spawn2 (aTHX_ cmd,EXECF_SPAWN); |
39e571d4 LM |
222 | } |
223 | ||
224 | bool | |
e670e57a | 225 | Perl_do_exec (pTHX_ const char *cmd) |
39e571d4 | 226 | { |
41cd3736 | 227 | do_spawn2 (aTHX_ cmd,EXECF_EXEC); |
39e571d4 LM |
228 | return FALSE; |
229 | } | |
230 | ||
231 | /**/ | |
232 | ||
233 | struct globinfo | |
234 | { | |
235 | int fd; | |
236 | char *matches; | |
237 | size_t size; | |
933fea7f | 238 | fpos_t pos; |
39e571d4 LM |
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 | ||
933fea7f | 273 | gi->pos=0; |
39e571d4 LM |
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 | ||
933fea7f GS |
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; | |
39e571d4 LM |
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) | |
41cd3736 | 349 | Perl_croak (aTHX_ "Usage: Dos::GetCwd()"); |
39e571d4 LM |
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); | |
ebdd4fa0 JH |
355 | #ifndef INCOMPLETE_TAINTS |
356 | SvTAINTED_on(ST(0)); | |
357 | #endif | |
39e571d4 LM |
358 | } |
359 | XSRETURN (1); | |
360 | } | |
361 | ||
362 | static | |
363 | XS(dos_UseLFN) | |
364 | { | |
365 | dXSARGS; | |
366 | XSRETURN_IV (_USE_LFN); | |
367 | } | |
368 | ||
d835d330 JH |
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 | ||
39e571d4 | 387 | void |
41cd3736 | 388 | Perl_init_os_extras(pTHX) |
39e571d4 LM |
389 | { |
390 | char *file = __FILE__; | |
391 | ||
392 | dXSUB_SYS; | |
393 | ||
394 | newXS ("Dos::GetCwd",dos_GetCwd,file); | |
395 | newXS ("Dos::UseLFN",dos_UseLFN,file); | |
d835d330 | 396 | newXS ("Cwd::sys_cwd",XS_Cwd_sys_cwd,file); |
39e571d4 LM |
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 | ||
af89d9af JH |
407 | char * |
408 | djgpp_pathexp (const char *p) | |
39e571d4 LM |
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 | ||
05af4e39 PFI |
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 | } | |
a5936e02 JH |
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 |