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