xref: /openbsd-src/gnu/usr.bin/perl/cygwin/cygwin.c (revision 52bd00bf7b17cbade3981d742f5221006d5d7d82)
1 /*
2  * Cygwin extras
3  */
4 
5 #include "EXTERN.h"
6 #include "perl.h"
7 #undef USE_DYNAMIC_LOADING
8 #include "XSUB.h"
9 
10 #include <unistd.h>
11 #include <process.h>
12 #include <sys/cygwin.h>
13 
14 /*
15  * pp_system() implemented via spawn()
16  * - more efficient and useful when embedding Perl in non-Cygwin apps
17  * - code mostly borrowed from djgpp.c
18  */
19 static int
20 do_spawnvp (const char *path, const char * const *argv)
21 {
22     dTHX;
23     Sigsave_t ihand,qhand;
24     int childpid, result, status;
25 
26     rsignal_save(SIGINT, SIG_IGN, &ihand);
27     rsignal_save(SIGQUIT, SIG_IGN, &qhand);
28     childpid = spawnvp(_P_NOWAIT,path,argv);
29     if (childpid < 0) {
30 	status = -1;
31 	if(ckWARN(WARN_EXEC))
32 	    Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't spawn \"%s\": %s",
33 		    path,Strerror (errno));
34     } else {
35 	do {
36 	    result = wait4pid(childpid, &status, 0);
37 	} while (result == -1 && errno == EINTR);
38 	if(result < 0)
39 	    status = -1;
40     }
41     (void)rsignal_restore(SIGINT, &ihand);
42     (void)rsignal_restore(SIGQUIT, &qhand);
43     return status;
44 }
45 
46 int
47 do_aspawn (SV *really, void **mark, void **sp)
48 {
49     dTHX;
50     int  rc;
51     char **a,*tmps,**argv;
52     STRLEN n_a;
53 
54     if (sp<=mark)
55         return -1;
56     a=argv=(char**) alloca ((sp-mark+3)*sizeof (char*));
57 
58     while (++mark <= sp)
59         if (*mark)
60             *a++ = SvPVx(*mark, n_a);
61         else
62             *a++ = "";
63     *a = Nullch;
64 
65     if (argv[0][0] != '/' && argv[0][0] != '\\'
66         && !(argv[0][0] && argv[0][1] == ':'
67         && (argv[0][2] == '/' || argv[0][2] != '\\'))
68      ) /* will swawnvp use PATH? */
69          TAINT_ENV();	/* testing IFS here is overkill, probably */
70 
71     if (really && *(tmps = SvPV(really, n_a)))
72         rc=do_spawnvp (tmps,(const char * const *)argv);
73     else
74         rc=do_spawnvp (argv[0],(const char *const *)argv);
75 
76     return rc;
77 }
78 
79 int
80 do_spawn (char *cmd)
81 {
82     dTHX;
83     char **a,*s,*metachars = "$&*(){}[]'\";\\?>|<~`\n";
84     const char *command[4];
85 
86     while (*cmd && isSPACE(*cmd))
87 	cmd++;
88 
89     if (strnEQ (cmd,"/bin/sh",7) && isSPACE (cmd[7]))
90         cmd+=5;
91 
92     /* save an extra exec if possible */
93     /* see if there are shell metacharacters in it */
94     if (strstr (cmd,"..."))
95 	goto doshell;
96     if (*cmd=='.' && isSPACE (cmd[1]))
97 	goto doshell;
98     if (strnEQ (cmd,"exec",4) && isSPACE (cmd[4]))
99 	goto doshell;
100     for (s=cmd; *s && isALPHA (*s); s++) ;	/* catch VAR=val gizmo */
101 	if (*s=='=')
102 	    goto doshell;
103 
104     for (s=cmd; *s; s++)
105 	if (strchr (metachars,*s))
106 	{
107 	    if (*s=='\n' && s[1]=='\0')
108 	    {
109 		*s='\0';
110 		break;
111 	    }
112 	doshell:
113 	    command[0] = "sh";
114 	    command[1] = "-c";
115 	    command[2] = cmd;
116 	    command[3] = NULL;
117 
118 	    return do_spawnvp("sh",command);
119 	}
120 
121     Newx (PL_Argv,(s-cmd)/2+2,char*);
122     PL_Cmd=savepvn (cmd,s-cmd);
123     a=PL_Argv;
124     for (s=PL_Cmd; *s;) {
125 	while (*s && isSPACE (*s)) s++;
126 	if (*s)
127 	    *(a++)=s;
128 	while (*s && !isSPACE (*s)) s++;
129 	if (*s)
130 	    *s++='\0';
131     }
132     *a=Nullch;
133     if (!PL_Argv[0])
134         return -1;
135 
136     return do_spawnvp(PL_Argv[0],(const char * const *)PL_Argv);
137 }
138 
139 /* see also Cwd.pm */
140 static
141 XS(Cygwin_cwd)
142 {
143     dXSARGS;
144     char *cwd;
145 
146     if(items != 0)
147 	Perl_croak(aTHX_ "Usage: Cwd::cwd()");
148     if((cwd = getcwd(NULL, -1))) {
149 	ST(0) = sv_2mortal(newSVpv(cwd, 0));
150 	free(cwd);
151 #ifndef INCOMPLETE_TAINTS
152 	SvTAINTED_on(ST(0));
153 #endif
154 	XSRETURN(1);
155     }
156     XSRETURN_UNDEF;
157 }
158 
159 static
160 XS(XS_Cygwin_pid_to_winpid)
161 {
162     dXSARGS;
163     dXSTARG;
164     pid_t pid, RETVAL;
165 
166     if (items != 1)
167         Perl_croak(aTHX_ "Usage: Cygwin::pid_to_winpid(pid)");
168 
169     pid = (pid_t)SvIV(ST(0));
170 
171     if ((RETVAL = cygwin_internal(CW_CYGWIN_PID_TO_WINPID, pid)) > 0) {
172 	XSprePUSH; PUSHi((IV)RETVAL);
173         XSRETURN(1);
174     }
175     XSRETURN_UNDEF;
176 }
177 
178 static
179 XS(XS_Cygwin_winpid_to_pid)
180 {
181     dXSARGS;
182     dXSTARG;
183     pid_t pid, RETVAL;
184 
185     if (items != 1)
186         Perl_croak(aTHX_ "Usage: Cygwin::winpid_to_pid(pid)");
187 
188     pid = (pid_t)SvIV(ST(0));
189 
190     if ((RETVAL = cygwin32_winpid_to_pid(pid)) > 0) {
191         XSprePUSH; PUSHi((IV)RETVAL);
192         XSRETURN(1);
193     }
194     XSRETURN_UNDEF;
195 }
196 
197 
198 void
199 init_os_extras(void)
200 {
201     char *file = __FILE__;
202     dTHX;
203 
204     newXS("Cwd::cwd", Cygwin_cwd, file);
205     newXS("Cygwin::winpid_to_pid", XS_Cygwin_winpid_to_pid, file);
206     newXS("Cygwin::pid_to_winpid", XS_Cygwin_pid_to_winpid, file);
207 }
208