xref: /openbsd/gnu/usr.bin/perl/cygwin/cygwin.c (revision 097a140d)
1 /*
2  * Cygwin extras
3  */
4 
5 #define PERLIO_NOT_STDIO 0
6 #include "EXTERN.h"
7 #include "perl.h"
8 #undef USE_DYNAMIC_LOADING
9 #include "XSUB.h"
10 
11 #include <unistd.h>
12 #include <process.h>
13 #include <sys/cygwin.h>
14 #include <cygwin/version.h>
15 #include <mntent.h>
16 #include <alloca.h>
17 #include <dlfcn.h>
18 #if (CYGWIN_VERSION_API_MINOR >= 181)
19 #include <wchar.h>
20 #endif
21 
22 /*
23  * pp_system() implemented via spawn()
24  * - more efficient and useful when embedding Perl in non-Cygwin apps
25  * - code mostly borrowed from djgpp.c
26  */
27 static int
28 do_spawnvp (const char *path, const char * const *argv)
29 {
30     dTHX;
31     Sigsave_t ihand,qhand;
32     int childpid, result, status;
33 
34     rsignal_save(SIGINT, (Sighandler_t) SIG_IGN, &ihand);
35     rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand);
36     childpid = spawnvp(_P_NOWAIT,path,argv);
37     if (childpid < 0) {
38 	status = -1;
39 	if(ckWARN(WARN_EXEC))
40 	    Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't spawn \"%s\": %s",
41 		    path,Strerror (errno));
42     } else {
43 	do {
44 	    result = wait4pid(childpid, &status, 0);
45 	} while (result == -1 && errno == EINTR);
46 	if(result < 0)
47 	    status = -1;
48     }
49     (void)rsignal_restore(SIGINT, &ihand);
50     (void)rsignal_restore(SIGQUIT, &qhand);
51     return status;
52 }
53 
54 int
55 do_aspawn (SV *really, void **mark, void **sp)
56 {
57     dTHX;
58     int  rc;
59     char const **a;
60     char *tmps,**argv;
61     STRLEN n_a;
62 
63     if (sp<=mark)
64         return -1;
65     argv=(char**) alloca ((sp-mark+3)*sizeof (char*));
66     a=(char const **)argv;
67 
68     while (++mark <= sp)
69         if (*mark)
70             *a++ = SvPVx((SV *)*mark, n_a);
71         else
72             *a++ = "";
73     *a = (char*)NULL;
74 
75     if (argv[0][0] != '/' && argv[0][0] != '\\'
76         && !(argv[0][0] && argv[0][1] == ':'
77         && (argv[0][2] == '/' || argv[0][2] != '\\'))
78      ) /* will swawnvp use PATH? */
79          TAINT_ENV();	/* testing IFS here is overkill, probably */
80 
81     if (really && *(tmps = SvPV(really, n_a)))
82         rc=do_spawnvp (tmps,(const char * const *)argv);
83     else
84         rc=do_spawnvp (argv[0],(const char *const *)argv);
85 
86     return rc;
87 }
88 
89 int
90 do_spawn (char *cmd)
91 {
92     dTHX;
93     char const **argv, **a;
94     char *s;
95     char const *metachars = "$&*(){}[]'\";\\?>|<~`\n";
96     const char *command[4];
97     int result;
98 
99     ENTER;
100     while (*cmd && isSPACE(*cmd))
101 	cmd++;
102 
103     if (strBEGINs (cmd,"/bin/sh") && isSPACE (cmd[7]))
104         cmd+=5;
105 
106     /* save an extra exec if possible */
107     /* see if there are shell metacharacters in it */
108     if (strstr (cmd,"..."))
109 	goto doshell;
110     if (*cmd=='.' && isSPACE (cmd[1]))
111 	goto doshell;
112     if (strBEGINs (cmd,"exec") && isSPACE (cmd[4]))
113 	goto doshell;
114     for (s=cmd; *s && isALPHA (*s); s++) ;	/* catch VAR=val gizmo */
115     if (*s=='=')
116         goto doshell;
117 
118     for (s=cmd; *s; s++)
119 	if (strchr (metachars,*s))
120 	{
121 	    if (*s=='\n' && s[1]=='\0')
122 	    {
123 		*s='\0';
124 		break;
125 	    }
126 	doshell:
127 	    command[0] = "sh";
128 	    command[1] = "-c";
129 	    command[2] = cmd;
130 	    command[3] = NULL;
131 
132 	    result = do_spawnvp("sh",command);
133 	    goto leave;
134 	}
135 
136     Newx (argv, (s-cmd)/2+2, const char*);
137     SAVEFREEPV(argv);
138     cmd=savepvn (cmd,s-cmd);
139     SAVEFREEPV(cmd);
140     a=argv;
141     for (s=cmd; *s;) {
142 	while (*s && isSPACE (*s)) s++;
143 	if (*s)
144 	    *(a++)=s;
145 	while (*s && !isSPACE (*s)) s++;
146 	if (*s)
147 	    *s++='\0';
148     }
149     *a = (char*)NULL;
150     if (!argv[0])
151         result = -1;
152     else
153 	result = do_spawnvp(argv[0],(const char * const *)argv);
154 leave:
155     LEAVE;
156     return result;
157 }
158 
159 #if (CYGWIN_VERSION_API_MINOR >= 181)
160 char*
161 wide_to_utf8(const wchar_t *wbuf)
162 {
163     char *buf;
164     int wlen = 0;
165     char *oldlocale;
166     dVAR;
167 
168     /* Here and elsewhere in this file, we have a critical section to prevent
169      * another thread from changing the locale out from under us.  XXX But why
170      * not just use uvchr_to_utf8? */
171     LOCALE_LOCK;
172 
173     oldlocale = setlocale(LC_CTYPE, NULL);
174     setlocale(LC_CTYPE, "utf-8");
175 
176     /* uvchr_to_utf8(buf, chr) or Encoding::_bytes_to_utf8(sv, "UCS-2BE"); */
177     wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL);
178     buf = (char *) safemalloc(wlen+1);
179     wcsrtombs(buf, (const wchar_t **)&wbuf, wlen, NULL);
180 
181     if (oldlocale) setlocale(LC_CTYPE, oldlocale);
182     else setlocale(LC_CTYPE, "C");
183 
184     LOCALE_UNLOCK;
185 
186     return buf;
187 }
188 
189 wchar_t*
190 utf8_to_wide(const char *buf)
191 {
192     wchar_t *wbuf;
193     mbstate_t mbs;
194     char *oldlocale;
195     int wlen = sizeof(wchar_t)*strlen(buf);
196     dVAR;
197 
198     LOCALE_LOCK;
199 
200     oldlocale = setlocale(LC_CTYPE, NULL);
201 
202     setlocale(LC_CTYPE, "utf-8");
203     wbuf = (wchar_t *) safemalloc(wlen);
204     /* utf8_to_uvchr_buf(pathname, pathname + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */
205     wlen = mbsrtowcs(wbuf, (const char**)&buf, wlen, &mbs);
206 
207     if (oldlocale) setlocale(LC_CTYPE, oldlocale);
208     else setlocale(LC_CTYPE, "C");
209 
210     LOCALE_UNLOCK;
211 
212     return wbuf;
213 }
214 #endif /* cygwin 1.7 */
215 
216 /* see also Cwd.pm */
217 XS(Cygwin_cwd)
218 {
219     dXSARGS;
220     char *cwd;
221 
222     /* See https://github.com/Perl/perl5/issues/8345
223        There is Cwd->cwd() usage in the wild, and previous versions didn't die.
224      */
225     if(items > 1)
226 	Perl_croak(aTHX_ "Usage: Cwd::cwd()");
227     if((cwd = getcwd(NULL, -1))) {
228 	ST(0) = sv_2mortal(newSVpv(cwd, 0));
229 	free(cwd);
230 	SvTAINTED_on(ST(0));
231 	XSRETURN(1);
232     }
233     XSRETURN_UNDEF;
234 }
235 
236 XS(XS_Cygwin_pid_to_winpid)
237 {
238     dXSARGS;
239     dXSTARG;
240     pid_t pid, RETVAL;
241 
242     if (items != 1)
243         Perl_croak(aTHX_ "Usage: Cygwin::pid_to_winpid(pid)");
244 
245     pid = (pid_t)SvIV(ST(0));
246 
247     if ((RETVAL = cygwin_internal(CW_CYGWIN_PID_TO_WINPID, pid)) > 0) {
248 	XSprePUSH; PUSHi((IV)RETVAL);
249         XSRETURN(1);
250     }
251     XSRETURN_UNDEF;
252 }
253 
254 XS(XS_Cygwin_winpid_to_pid)
255 {
256     dXSARGS;
257     dXSTARG;
258     pid_t pid, RETVAL;
259 
260     if (items != 1)
261         Perl_croak(aTHX_ "Usage: Cygwin::winpid_to_pid(pid)");
262 
263     pid = (pid_t)SvIV(ST(0));
264 
265 #if (CYGWIN_VERSION_API_MINOR >= 181)
266     RETVAL = cygwin_winpid_to_pid(pid);
267 #else
268     RETVAL = cygwin32_winpid_to_pid(pid);
269 #endif
270     if (RETVAL > 0) {
271         XSprePUSH; PUSHi((IV)RETVAL);
272         XSRETURN(1);
273     }
274     XSRETURN_UNDEF;
275 }
276 
277 XS(XS_Cygwin_win_to_posix_path)
278 
279 {
280     dXSARGS;
281     int absolute_flag = 0;
282     STRLEN len;
283     int err = 0;
284     char *src_path;
285     char *posix_path;
286     int isutf8 = 0;
287 
288     if (items < 1 || items > 2)
289         Perl_croak(aTHX_ "Usage: Cygwin::win_to_posix_path(pathname, [absolute])");
290 
291     src_path = SvPV(ST(0), len);
292     if (items == 2)
293 	absolute_flag = SvTRUE(ST(1));
294 
295     if (!len)
296 	Perl_croak(aTHX_ "can't convert empty path");
297     isutf8 = SvUTF8(ST(0));
298 
299 #if (CYGWIN_VERSION_API_MINOR >= 181)
300     /* Check utf8 flag and use wide api then.
301        Size calculation: On overflow let cygwin_conv_path calculate the final size.
302      */
303     if (isutf8) {
304 	int what = absolute_flag ? CCP_WIN_W_TO_POSIX : CCP_WIN_W_TO_POSIX | CCP_RELATIVE;
305 	STRLEN wlen = sizeof(wchar_t)*(len + 260 + 1001);
306 	wchar_t *wpath = (wchar_t *) safemalloc(sizeof(wchar_t)*len);
307 	wchar_t *wbuf = (wchar_t *) safemalloc(wlen);
308 	if (!IN_BYTES) {
309 	    mbstate_t mbs;
310             char *oldlocale;
311             dVAR;
312 
313             LOCALE_LOCK;
314 
315             oldlocale = setlocale(LC_CTYPE, NULL);
316             setlocale(LC_CTYPE, "utf-8");
317 	    /* utf8_to_uvchr_buf(src_path, src_path + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */
318 	    wlen = mbsrtowcs(wpath, (const char**)&src_path, wlen, &mbs);
319 	    if (wlen > 0)
320 		err = cygwin_conv_path(what, wpath, wbuf, wlen);
321             if (oldlocale) setlocale(LC_CTYPE, oldlocale);
322             else setlocale(LC_CTYPE, "C");
323 
324             LOCALE_UNLOCK;
325 	} else { /* use bytes; assume already ucs-2 encoded bytestream */
326 	    err = cygwin_conv_path(what, src_path, wbuf, wlen);
327 	}
328 	if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
329 	    int newlen = cygwin_conv_path(what, wpath, wbuf, 0);
330 	    wbuf = (wchar_t *) realloc(&wbuf, newlen);
331 	    err = cygwin_conv_path(what, wpath, wbuf, newlen);
332 	    wlen = newlen;
333 	}
334 	/* utf16_to_utf8(*p, *d, bytlen, *newlen) */
335 	posix_path = (char *) safemalloc(wlen*3);
336 	Perl_utf16_to_utf8(aTHX_ (U8*)&wpath, (U8*)posix_path, wlen*2, &len);
337 	/*
338 	wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL);
339 	posix_path = (char *) safemalloc(wlen+1);
340 	wcsrtombs(posix_path, (const wchar_t **)&wbuf, wlen, NULL);
341 	*/
342     } else {
343 	int what = absolute_flag ? CCP_WIN_A_TO_POSIX : CCP_WIN_A_TO_POSIX | CCP_RELATIVE;
344 	posix_path = (char *) safemalloc (len + 260 + 1001);
345 	err = cygwin_conv_path(what, src_path, posix_path, len + 260 + 1001);
346 	if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
347 	    int newlen = cygwin_conv_path(what, src_path, posix_path, 0);
348 	    posix_path = (char *) realloc(&posix_path, newlen);
349 	    err = cygwin_conv_path(what, src_path, posix_path, newlen);
350 	}
351     }
352 #else
353     posix_path = (char *) safemalloc (len + 260 + 1001);
354     if (absolute_flag)
355 	err = cygwin_conv_to_full_posix_path(src_path, posix_path);
356     else
357 	err = cygwin_conv_to_posix_path(src_path, posix_path);
358 #endif
359     if (!err) {
360 	EXTEND(SP, 1);
361 	ST(0) = sv_2mortal(newSVpv(posix_path, 0));
362 	if (isutf8) { /* src was utf-8, so result should also */
363 	    /* TODO: convert ANSI (local windows encoding) to utf-8 on cygwin-1.5 */
364 	    SvUTF8_on(ST(0));
365 	}
366 	safefree(posix_path);
367         XSRETURN(1);
368     } else {
369 	safefree(posix_path);
370 	XSRETURN_UNDEF;
371     }
372 }
373 
374 XS(XS_Cygwin_posix_to_win_path)
375 {
376     dXSARGS;
377     int absolute_flag = 0;
378     STRLEN len;
379     int err = 0;
380     char *src_path, *win_path;
381     int isutf8 = 0;
382 
383     if (items < 1 || items > 2)
384         Perl_croak(aTHX_ "Usage: Cygwin::posix_to_win_path(pathname, [absolute])");
385 
386     src_path = SvPVx(ST(0), len);
387     if (items == 2)
388 	absolute_flag = SvTRUE(ST(1));
389 
390     if (!len)
391 	Perl_croak(aTHX_ "can't convert empty path");
392     isutf8 = SvUTF8(ST(0));
393 #if (CYGWIN_VERSION_API_MINOR >= 181)
394     /* Check utf8 flag and use wide api then.
395        Size calculation: On overflow let cygwin_conv_path calculate the final size.
396      */
397     if (isutf8) {
398 	int what = absolute_flag ? CCP_POSIX_TO_WIN_W : CCP_POSIX_TO_WIN_W | CCP_RELATIVE;
399 	int wlen = sizeof(wchar_t)*(len + 260 + 1001);
400 	wchar_t *wpath = (wchar_t *) safemalloc(sizeof(wchar_t)*len);
401 	wchar_t *wbuf = (wchar_t *) safemalloc(wlen);
402 	char *oldlocale;
403         dVAR;
404 
405         LOCALE_LOCK;
406 
407 	oldlocale = setlocale(LC_CTYPE, NULL);
408 	setlocale(LC_CTYPE, "utf-8");
409 	if (!IN_BYTES) {
410 	    mbstate_t mbs;
411 	    /* utf8_to_uvchr_buf(src_path, src_path + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */
412 	    wlen = mbsrtowcs(wpath, (const char**)&src_path, wlen, &mbs);
413 	    if (wlen > 0)
414 		err = cygwin_conv_path(what, wpath, wbuf, wlen);
415 	} else { /* use bytes; assume already ucs-2 encoded bytestream */
416 	    err = cygwin_conv_path(what, src_path, wbuf, wlen);
417 	}
418 	if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
419 	    int newlen = cygwin_conv_path(what, wpath, wbuf, 0);
420 	    wbuf = (wchar_t *) realloc(&wbuf, newlen);
421 	    err = cygwin_conv_path(what, wpath, wbuf, newlen);
422 	    wlen = newlen;
423 	}
424 	/* also see utf8.c: Perl_utf16_to_utf8() or Encoding::_bytes_to_utf8(sv, "UCS-2BE"); */
425 	wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL);
426 	win_path = (char *) safemalloc(wlen+1);
427 	wcsrtombs(win_path, (const wchar_t **)&wbuf, wlen, NULL);
428 	if (oldlocale) setlocale(LC_CTYPE, oldlocale);
429 	else setlocale(LC_CTYPE, "C");
430 
431         LOCALE_UNLOCK;
432     } else {
433 	int what = absolute_flag ? CCP_POSIX_TO_WIN_A : CCP_POSIX_TO_WIN_A | CCP_RELATIVE;
434 	win_path = (char *) safemalloc(len + 260 + 1001);
435 	err = cygwin_conv_path(what, src_path, win_path, len + 260 + 1001);
436 	if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
437 	    int newlen = cygwin_conv_path(what, src_path, win_path, 0);
438 	    win_path = (char *) realloc(&win_path, newlen);
439 	    err = cygwin_conv_path(what, src_path, win_path, newlen);
440 	}
441     }
442 #else
443     if (isutf8)
444 	Perl_warn(aTHX_ "can't convert utf8 path");
445     win_path = (char *) safemalloc(len + 260 + 1001);
446     if (absolute_flag)
447 	err = cygwin_conv_to_full_win32_path(src_path, win_path);
448     else
449 	err = cygwin_conv_to_win32_path(src_path, win_path);
450 #endif
451     if (!err) {
452 	EXTEND(SP, 1);
453 	ST(0) = sv_2mortal(newSVpv(win_path, 0));
454 	if (isutf8) {
455 	    SvUTF8_on(ST(0));
456 	}
457 	safefree(win_path);
458 	XSRETURN(1);
459     } else {
460 	safefree(win_path);
461 	XSRETURN_UNDEF;
462     }
463 }
464 
465 XS(XS_Cygwin_mount_table)
466 {
467     dXSARGS;
468     struct mntent *mnt;
469 
470     if (items != 0)
471         Perl_croak(aTHX_ "Usage: Cygwin::mount_table");
472     /* => array of [mnt_dir mnt_fsname mnt_type mnt_opts] */
473 
474     setmntent (0, 0);
475     while ((mnt = getmntent (0))) {
476 	AV* av = newAV();
477 	av_push(av, newSVpvn(mnt->mnt_dir, strlen(mnt->mnt_dir)));
478 	av_push(av, newSVpvn(mnt->mnt_fsname, strlen(mnt->mnt_fsname)));
479 	av_push(av, newSVpvn(mnt->mnt_type, strlen(mnt->mnt_type)));
480 	av_push(av, newSVpvn(mnt->mnt_opts, strlen(mnt->mnt_opts)));
481 	XPUSHs(sv_2mortal(newRV_noinc((SV*)av)));
482     }
483     endmntent (0);
484     PUTBACK;
485 }
486 
487 XS(XS_Cygwin_mount_flags)
488 {
489     dXSARGS;
490     char *pathname;
491     char flags[PATH_MAX];
492     flags[0] = '\0';
493 
494     if (items != 1)
495         Perl_croak(aTHX_ "Usage: Cygwin::mount_flags( mnt_dir | '/cygdrive' )");
496 
497     pathname = SvPV_nolen(ST(0));
498 
499     if (strEQ(pathname, "/cygdrive")) {
500 	char user[PATH_MAX];
501 	char system[PATH_MAX];
502 	char user_flags[PATH_MAX];
503 	char system_flags[PATH_MAX];
504 
505 	cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system,
506 			 user_flags, system_flags);
507 
508         if (strlen(user) > 0) {
509             sprintf(flags, "%s,cygdrive,%s", user_flags, user);
510         } else {
511             sprintf(flags, "%s,cygdrive,%s", system_flags, system);
512         }
513 
514 	ST(0) = sv_2mortal(newSVpv(flags, 0));
515 	XSRETURN(1);
516 
517     } else {
518 	struct mntent *mnt;
519 	int found = 0;
520 	setmntent (0, 0);
521 	while ((mnt = getmntent (0))) {
522 	    if (strEQ(pathname, mnt->mnt_dir)) {
523 		strcpy(flags, mnt->mnt_type);
524 		if (strlen(mnt->mnt_opts) > 0) {
525 		    strcat(flags, ",");
526 		    strcat(flags, mnt->mnt_opts);
527 		}
528 		found++;
529 		break;
530 	    }
531 	}
532 	endmntent (0);
533 
534 	/* Check if arg is the current volume moint point if not default,
535 	 * and then use CW_GET_CYGDRIVE_INFO also.
536 	 */
537 	if (!found) {
538 	    char user[PATH_MAX];
539 	    char system[PATH_MAX];
540 	    char user_flags[PATH_MAX];
541 	    char system_flags[PATH_MAX];
542 
543 	    cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system,
544 			     user_flags, system_flags);
545 
546 	    if (strlen(user) > 0) {
547 		if (strNE(user,pathname)) {
548 		    sprintf(flags, "%s,cygdrive,%s", user_flags, user);
549 		    found++;
550 		}
551 	    } else {
552 		if (strNE(user,pathname)) {
553 		    sprintf(flags, "%s,cygdrive,%s", system_flags, system);
554 		    found++;
555 		}
556 	    }
557 	}
558 	if (found) {
559 	    ST(0) = sv_2mortal(newSVpv(flags, 0));
560 	    XSRETURN(1);
561 	} else {
562 	    XSRETURN_UNDEF;
563 	}
564     }
565 }
566 
567 XS(XS_Cygwin_is_binmount)
568 {
569     dXSARGS;
570     char *pathname;
571 
572     if (items != 1)
573         Perl_croak(aTHX_ "Usage: Cygwin::is_binmount(pathname)");
574 
575     pathname = SvPV_nolen(ST(0));
576 
577     ST(0) = boolSV(cygwin_internal(CW_GET_BINMODE, pathname));
578     XSRETURN(1);
579 }
580 
581 XS(XS_Cygwin_sync_winenv){ cygwin_internal(CW_SYNC_WINENV); }
582 
583 void
584 init_os_extras(void)
585 {
586     dTHX;
587     char const *file = __FILE__;
588     void *handle;
589 
590     newXS("Cwd::cwd", Cygwin_cwd, file);
591     newXSproto("Cygwin::winpid_to_pid", XS_Cygwin_winpid_to_pid, file, "$");
592     newXSproto("Cygwin::pid_to_winpid", XS_Cygwin_pid_to_winpid, file, "$");
593     newXSproto("Cygwin::win_to_posix_path", XS_Cygwin_win_to_posix_path, file, "$;$");
594     newXSproto("Cygwin::posix_to_win_path", XS_Cygwin_posix_to_win_path, file, "$;$");
595     newXSproto("Cygwin::mount_table", XS_Cygwin_mount_table, file, "");
596     newXSproto("Cygwin::mount_flags", XS_Cygwin_mount_flags, file, "$");
597     newXSproto("Cygwin::is_binmount", XS_Cygwin_is_binmount, file, "$");
598     newXS("Cygwin::sync_winenv", XS_Cygwin_sync_winenv, file);
599 
600     /* Initialize Win32CORE if it has been statically linked. */
601     handle = dlopen(NULL, RTLD_LAZY);
602     if (handle) {
603         void (*pfn_init)(pTHX);
604         pfn_init = (void (*)(pTHX))dlsym(handle, "init_Win32CORE");
605         if (pfn_init)
606             pfn_init(aTHX);
607         dlclose(handle);
608     }
609 }
610