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