[asperl] integrate latest win32 branch
[p5sagit/p5-mst-13.2.git] / djgpp / djgpp.c
CommitLineData
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 */
30struct 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 */
39static struct pipe_list *pl = NULL;
40
41FILE *
42popen (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
99int
100pclose (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
175static int
176convretcode (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
187int
188do_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
221int
222do_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 }
261doshell:
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
289int
290do_spawn (char *cmd)
291{
292 return do_spawn2 (cmd,EXECF_SPAWN);
293}
294
295bool
296do_exec (char *cmd)
297{
298 do_spawn2 (cmd,EXECF_EXEC);
299 return FALSE;
300}
301
302/**/
303
304struct globinfo
305{
306 int fd;
307 char *matches;
308 size_t size;
309};
310
311#define MAXOPENGLOBS 10
312
313static struct globinfo myglobs[MAXOPENGLOBS];
314
315static struct globinfo *
316searchfd (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
325static int
326glob_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
413static
414XS(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
429static
430XS(dos_UseLFN)
431{
432 dXSARGS;
433 XSRETURN_IV (_USE_LFN);
434}
435
436void
437init_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
451static char *perlprefix;
452
453#define PERL5 "/perl5"
454
455char *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
474void
475Perl_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