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