xref: /openbsd/gnu/usr.bin/perl/cygwin/cygwin.c (revision 404b540a)
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 #include <mntent.h>
14 #include <alloca.h>
15 #include <dlfcn.h>
16 
17 /*
18  * pp_system() implemented via spawn()
19  * - more efficient and useful when embedding Perl in non-Cygwin apps
20  * - code mostly borrowed from djgpp.c
21  */
22 static int
23 do_spawnvp (const char *path, const char * const *argv)
24 {
25     dTHX;
26     Sigsave_t ihand,qhand;
27     int childpid, result, status;
28 
29     rsignal_save(SIGINT, (Sighandler_t) SIG_IGN, &ihand);
30     rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand);
31     childpid = spawnvp(_P_NOWAIT,path,argv);
32     if (childpid < 0) {
33 	status = -1;
34 	if(ckWARN(WARN_EXEC))
35 	    Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't spawn \"%s\": %s",
36 		    path,Strerror (errno));
37     } else {
38 	do {
39 	    result = wait4pid(childpid, &status, 0);
40 	} while (result == -1 && errno == EINTR);
41 	if(result < 0)
42 	    status = -1;
43     }
44     (void)rsignal_restore(SIGINT, &ihand);
45     (void)rsignal_restore(SIGQUIT, &qhand);
46     return status;
47 }
48 
49 int
50 do_aspawn (SV *really, void **mark, void **sp)
51 {
52     dTHX;
53     int  rc;
54     char **a,*tmps,**argv;
55     STRLEN n_a;
56 
57     if (sp<=mark)
58         return -1;
59     a=argv=(char**) alloca ((sp-mark+3)*sizeof (char*));
60 
61     while (++mark <= sp)
62         if (*mark)
63             *a++ = SvPVx((SV *)*mark, n_a);
64         else
65             *a++ = "";
66     *a = (char*)NULL;
67 
68     if (argv[0][0] != '/' && argv[0][0] != '\\'
69         && !(argv[0][0] && argv[0][1] == ':'
70         && (argv[0][2] == '/' || argv[0][2] != '\\'))
71      ) /* will swawnvp use PATH? */
72          TAINT_ENV();	/* testing IFS here is overkill, probably */
73 
74     if (really && *(tmps = SvPV(really, n_a)))
75         rc=do_spawnvp (tmps,(const char * const *)argv);
76     else
77         rc=do_spawnvp (argv[0],(const char *const *)argv);
78 
79     return rc;
80 }
81 
82 int
83 do_spawn (char *cmd)
84 {
85     dTHX;
86     char const **a;
87     char *s,*metachars = "$&*(){}[]'\";\\?>|<~`\n";
88     const char *command[4];
89 
90     while (*cmd && isSPACE(*cmd))
91 	cmd++;
92 
93     if (strnEQ (cmd,"/bin/sh",7) && isSPACE (cmd[7]))
94         cmd+=5;
95 
96     /* save an extra exec if possible */
97     /* see if there are shell metacharacters in it */
98     if (strstr (cmd,"..."))
99 	goto doshell;
100     if (*cmd=='.' && isSPACE (cmd[1]))
101 	goto doshell;
102     if (strnEQ (cmd,"exec",4) && isSPACE (cmd[4]))
103 	goto doshell;
104     for (s=cmd; *s && isALPHA (*s); s++) ;	/* catch VAR=val gizmo */
105 	if (*s=='=')
106 	    goto doshell;
107 
108     for (s=cmd; *s; s++)
109 	if (strchr (metachars,*s))
110 	{
111 	    if (*s=='\n' && s[1]=='\0')
112 	    {
113 		*s='\0';
114 		break;
115 	    }
116 	doshell:
117 	    command[0] = "sh";
118 	    command[1] = "-c";
119 	    command[2] = cmd;
120 	    command[3] = NULL;
121 
122 	    return do_spawnvp("sh",command);
123 	}
124 
125     Newx (PL_Argv,(s-cmd)/2+2,const char*);
126     PL_Cmd=savepvn (cmd,s-cmd);
127     a=PL_Argv;
128     for (s=PL_Cmd; *s;) {
129 	while (*s && isSPACE (*s)) s++;
130 	if (*s)
131 	    *(a++)=s;
132 	while (*s && !isSPACE (*s)) s++;
133 	if (*s)
134 	    *s++='\0';
135     }
136     *a = (char*)NULL;
137     if (!PL_Argv[0])
138         return -1;
139 
140     return do_spawnvp(PL_Argv[0],(const char * const *)PL_Argv);
141 }
142 
143 /* see also Cwd.pm */
144 XS(Cygwin_cwd)
145 {
146     dXSARGS;
147     char *cwd;
148 
149     /* See http://rt.perl.org/rt3/Ticket/Display.html?id=38628
150        There is Cwd->cwd() usage in the wild, and previous versions didn't die.
151      */
152     if(items > 1)
153 	Perl_croak(aTHX_ "Usage: Cwd::cwd()");
154     if((cwd = getcwd(NULL, -1))) {
155 	ST(0) = sv_2mortal(newSVpv(cwd, 0));
156 	free(cwd);
157 #ifndef INCOMPLETE_TAINTS
158 	SvTAINTED_on(ST(0));
159 #endif
160 	XSRETURN(1);
161     }
162     XSRETURN_UNDEF;
163 }
164 
165 XS(XS_Cygwin_pid_to_winpid)
166 {
167     dXSARGS;
168     dXSTARG;
169     pid_t pid, RETVAL;
170 
171     if (items != 1)
172         Perl_croak(aTHX_ "Usage: Cygwin::pid_to_winpid(pid)");
173 
174     pid = (pid_t)SvIV(ST(0));
175 
176     if ((RETVAL = cygwin_internal(CW_CYGWIN_PID_TO_WINPID, pid)) > 0) {
177 	XSprePUSH; PUSHi((IV)RETVAL);
178         XSRETURN(1);
179     }
180     XSRETURN_UNDEF;
181 }
182 
183 XS(XS_Cygwin_winpid_to_pid)
184 {
185     dXSARGS;
186     dXSTARG;
187     pid_t pid, RETVAL;
188 
189     if (items != 1)
190         Perl_croak(aTHX_ "Usage: Cygwin::winpid_to_pid(pid)");
191 
192     pid = (pid_t)SvIV(ST(0));
193 
194     if ((RETVAL = cygwin32_winpid_to_pid(pid)) > 0) {
195         XSprePUSH; PUSHi((IV)RETVAL);
196         XSRETURN(1);
197     }
198     XSRETURN_UNDEF;
199 }
200 
201 XS(XS_Cygwin_win_to_posix_path)
202 {
203     dXSARGS;
204     int absolute_flag = 0;
205     STRLEN len;
206     int err;
207     char *pathname, *buf;
208 
209     if (items < 1 || items > 2)
210         Perl_croak(aTHX_ "Usage: Cygwin::win_to_posix_path(pathname, [absolute])");
211 
212     pathname = SvPV(ST(0), len);
213     if (items == 2)
214 	absolute_flag = SvTRUE(ST(1));
215 
216     if (!len)
217 	Perl_croak(aTHX_ "can't convert empty path");
218     buf = (char *) safemalloc (len + 260 + 1001);
219 
220     if (absolute_flag)
221 	err = cygwin_conv_to_full_posix_path(pathname, buf);
222     else
223 	err = cygwin_conv_to_posix_path(pathname, buf);
224     if (!err) {
225 	ST(0) = sv_2mortal(newSVpv(buf, 0));
226 	safefree(buf);
227        XSRETURN(1);
228     } else {
229 	safefree(buf);
230 	XSRETURN_UNDEF;
231     }
232 }
233 
234 XS(XS_Cygwin_posix_to_win_path)
235 {
236     dXSARGS;
237     int absolute_flag = 0;
238     STRLEN len;
239     int err;
240     char *pathname, *buf;
241 
242     if (items < 1 || items > 2)
243         Perl_croak(aTHX_ "Usage: Cygwin::posix_to_win_path(pathname, [absolute])");
244 
245     pathname = SvPV(ST(0), len);
246     if (items == 2)
247 	absolute_flag = SvTRUE(ST(1));
248 
249     if (!len)
250 	Perl_croak(aTHX_ "can't convert empty path");
251     buf = (char *) safemalloc(len + 260 + 1001);
252 
253     if (absolute_flag)
254 	err = cygwin_conv_to_full_win32_path(pathname, buf);
255     else
256 	err = cygwin_conv_to_win32_path(pathname, buf);
257     if (!err) {
258 	ST(0) = sv_2mortal(newSVpv(buf, 0));
259 	safefree(buf);
260        XSRETURN(1);
261     } else {
262 	safefree(buf);
263 	XSRETURN_UNDEF;
264     }
265 }
266 
267 XS(XS_Cygwin_mount_table)
268 {
269     dXSARGS;
270     struct mntent *mnt;
271 
272     if (items != 0)
273         Perl_croak(aTHX_ "Usage: Cygwin::mount_table");
274     /* => array of [mnt_dir mnt_fsname mnt_type mnt_opts] */
275 
276     setmntent (0, 0);
277     while ((mnt = getmntent (0))) {
278 	AV* av = newAV();
279 	av_push(av, newSVpvn(mnt->mnt_dir, strlen(mnt->mnt_dir)));
280 	av_push(av, newSVpvn(mnt->mnt_fsname, strlen(mnt->mnt_fsname)));
281 	av_push(av, newSVpvn(mnt->mnt_type, strlen(mnt->mnt_type)));
282 	av_push(av, newSVpvn(mnt->mnt_opts, strlen(mnt->mnt_opts)));
283 	XPUSHs(sv_2mortal(newRV_noinc((SV*)av)));
284     }
285     endmntent (0);
286     PUTBACK;
287 }
288 
289 XS(XS_Cygwin_mount_flags)
290 {
291     dXSARGS;
292     char *pathname;
293     char flags[260];
294 
295     if (items != 1)
296         Perl_croak(aTHX_ "Usage: Cygwin::mount_flags(mnt_dir|'/cygwin')");
297 
298     pathname = SvPV_nolen(ST(0));
299 
300     /* TODO: Check for cygdrive registry setting,
301      *       and then use CW_GET_CYGDRIVE_INFO
302      */
303     if (!strcmp(pathname, "/cygdrive")) {
304 	char user[260];
305 	char system[260];
306 	char user_flags[260];
307 	char system_flags[260];
308 
309 	cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system, user_flags,
310 			 system_flags);
311 
312         if (strlen(user) > 0) {
313             sprintf(flags, "%s,cygdrive,%s", user_flags, user);
314         } else {
315             sprintf(flags, "%s,cygdrive,%s", system_flags, system);
316         }
317 
318 	ST(0) = sv_2mortal(newSVpv(flags, 0));
319 	XSRETURN(1);
320 
321     } else {
322 	struct mntent *mnt;
323 	setmntent (0, 0);
324 	while ((mnt = getmntent (0))) {
325 	    if (!strcmp(pathname, mnt->mnt_dir)) {
326 		strcpy(flags, mnt->mnt_type);
327 		if (strlen(mnt->mnt_opts) > 0) {
328 		    strcat(flags, ",");
329 		    strcat(flags, mnt->mnt_opts);
330 		}
331 		break;
332 	    }
333 	}
334 	endmntent (0);
335 	ST(0) = sv_2mortal(newSVpv(flags, 0));
336 	XSRETURN(1);
337     }
338 }
339 
340 XS(XS_Cygwin_is_binmount)
341 {
342     dXSARGS;
343     char *pathname;
344 
345     if (items != 1)
346         Perl_croak(aTHX_ "Usage: Cygwin::is_binmount(pathname)");
347 
348     pathname = SvPV_nolen(ST(0));
349 
350     ST(0) = boolSV(cygwin_internal(CW_GET_BINMODE, pathname));
351     XSRETURN(1);
352 }
353 
354 void
355 init_os_extras(void)
356 {
357     dTHX;
358     char *file = __FILE__;
359     void *handle;
360 
361     newXS("Cwd::cwd", Cygwin_cwd, file);
362     newXSproto("Cygwin::winpid_to_pid", XS_Cygwin_winpid_to_pid, file, "$");
363     newXSproto("Cygwin::pid_to_winpid", XS_Cygwin_pid_to_winpid, file, "$");
364     newXSproto("Cygwin::win_to_posix_path", XS_Cygwin_win_to_posix_path, file, "$;$");
365     newXSproto("Cygwin::posix_to_win_path", XS_Cygwin_posix_to_win_path, file, "$;$");
366     newXSproto("Cygwin::mount_table", XS_Cygwin_mount_table, file, "");
367     newXSproto("Cygwin::mount_flags", XS_Cygwin_mount_flags, file, "$");
368     newXSproto("Cygwin::is_binmount", XS_Cygwin_is_binmount, file, "$");
369 
370     /* Initialize Win32CORE if it has been statically linked. */
371     handle = dlopen(NULL, RTLD_LAZY);
372     if (handle) {
373         void (*pfn_init)(pTHX);
374         pfn_init = (void (*)(pTHX))dlsym(handle, "init_Win32CORE");
375         if (pfn_init)
376             pfn_init(aTHX);
377         dlclose(handle);
378     }
379 }
380