This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Ensure stack is in consistent state while restoring SAVEt_HINTS
[perl5.git] / cygwin / cygwin.c
CommitLineData
5db16f6a
EF
1/*
2 * Cygwin extras
3 */
4
6cc44f62 5#define PERLIO_NOT_STDIO 0
5db16f6a
EF
6#include "EXTERN.h"
7#include "perl.h"
8#undef USE_DYNAMIC_LOADING
9#include "XSUB.h"
10
6b49d266 11#include <unistd.h>
b4bcd662 12#include <process.h>
49fd6edc 13#include <sys/cygwin.h>
803e389c 14#include <cygwin/version.h>
a25ce5f3 15#include <mntent.h>
6d7e4387 16#include <alloca.h>
9fb265f7 17#include <dlfcn.h>
803e389c
RU
18#if (CYGWIN_VERSION_API_MINOR >= 181)
19#include <wchar.h>
20#endif
5db16f6a 21
b4bcd662
GS
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 */
27static int
28do_spawnvp (const char *path, const char * const *argv)
29{
acfe0abc 30 dTHX;
b4bcd662
GS
31 Sigsave_t ihand,qhand;
32 int childpid, result, status;
33
ec1aec95
YST
34 rsignal_save(SIGINT, (Sighandler_t) SIG_IGN, &ihand);
35 rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand);
b4bcd662
GS
36 childpid = spawnvp(_P_NOWAIT,path,argv);
37 if (childpid < 0) {
38 status = -1;
411caa50 39 if(ckWARN(WARN_EXEC))
f98bc0c6 40 Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't spawn \"%s\": %s",
b4bcd662 41 path,Strerror (errno));
b4bcd662
GS
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
54int
55do_aspawn (SV *really, void **mark, void **sp)
56{
acfe0abc 57 dTHX;
b4bcd662 58 int rc;
a4ec4e68
JH
59 char const **a;
60 char *tmps,**argv;
61 STRLEN n_a;
b4bcd662
GS
62
63 if (sp<=mark)
64 return -1;
a4ec4e68
JH
65 argv=(char**) alloca ((sp-mark+3)*sizeof (char*));
66 a=(char const **)argv;
b4bcd662
GS
67
68 while (++mark <= sp)
69 if (*mark)
667e2948 70 *a++ = SvPVx((SV *)*mark, n_a);
b4bcd662
GS
71 else
72 *a++ = "";
dfe169ee 73 *a = (char*)NULL;
b4bcd662
GS
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
89int
90do_spawn (char *cmd)
91{
acfe0abc 92 dTHX;
282fc0b3 93 char const **argv, **a;
a4ec4e68
JH
94 char *s;
95 char const *metachars = "$&*(){}[]'\";\\?>|<~`\n";
b4bcd662 96 const char *command[4];
282fc0b3 97 int result;
b4bcd662 98
282fc0b3 99 ENTER;
b4bcd662
GS
100 while (*cmd && isSPACE(*cmd))
101 cmd++;
102
f55ac4a4 103 if (strBEGINs (cmd,"/bin/sh") && isSPACE (cmd[7]))
b4bcd662
GS
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;
f55ac4a4 112 if (strBEGINs (cmd,"exec") && isSPACE (cmd[4]))
b4bcd662
GS
113 goto doshell;
114 for (s=cmd; *s && isALPHA (*s); s++) ; /* catch VAR=val gizmo */
4e650215
KW
115 if (*s=='=')
116 goto doshell;
b4bcd662
GS
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
282fc0b3
Z
132 result = do_spawnvp("sh",command);
133 goto leave;
b4bcd662
GS
134 }
135
282fc0b3
Z
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;) {
b4bcd662
GS
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 }
dfe169ee 149 *a = (char*)NULL;
282fc0b3
Z
150 if (!argv[0])
151 result = -1;
152 else
153 result = do_spawnvp(argv[0],(const char * const *)argv);
154leave:
155 LEAVE;
156 return result;
b4bcd662 157}
5db16f6a 158
803e389c
RU
159#if (CYGWIN_VERSION_API_MINOR >= 181)
160char*
161wide_to_utf8(const wchar_t *wbuf)
162{
163 char *buf;
164 int wlen = 0;
a0b53297
KW
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);
803e389c
RU
174 setlocale(LC_CTYPE, "utf-8");
175
c80e42f3 176 /* uvchr_to_utf8(buf, chr) or Encoding::_bytes_to_utf8(sv, "UCS-2BE"); */
803e389c
RU
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");
a0b53297
KW
183
184 LOCALE_UNLOCK;
185
803e389c
RU
186 return buf;
187}
188
189wchar_t*
190utf8_to_wide(const char *buf)
191{
192 wchar_t *wbuf;
193 mbstate_t mbs;
a0b53297 194 char *oldlocale;
803e389c 195 int wlen = sizeof(wchar_t)*strlen(buf);
a0b53297
KW
196 dVAR;
197
198 LOCALE_LOCK;
199
200 oldlocale = setlocale(LC_CTYPE, NULL);
803e389c
RU
201
202 setlocale(LC_CTYPE, "utf-8");
203 wbuf = (wchar_t *) safemalloc(wlen);
c80e42f3 204 /* utf8_to_uvchr_buf(pathname, pathname + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */
803e389c
RU
205 wlen = mbsrtowcs(wbuf, (const char**)&buf, wlen, &mbs);
206
207 if (oldlocale) setlocale(LC_CTYPE, oldlocale);
208 else setlocale(LC_CTYPE, "C");
a0b53297
KW
209
210 LOCALE_UNLOCK;
211
803e389c
RU
212 return wbuf;
213}
214#endif /* cygwin 1.7 */
215
5db16f6a 216/* see also Cwd.pm */
5db16f6a
EF
217XS(Cygwin_cwd)
218{
219 dXSARGS;
220 char *cwd;
221
8034715d 222 /* See https://github.com/Perl/perl5/issues/8345
482150a7
JH
223 There is Cwd->cwd() usage in the wild, and previous versions didn't die.
224 */
225 if(items > 1)
5db16f6a 226 Perl_croak(aTHX_ "Usage: Cwd::cwd()");
47dafe4d 227 if((cwd = getcwd(NULL, -1))) {
5db16f6a 228 ST(0) = sv_2mortal(newSVpv(cwd, 0));
a236cecb 229 free(cwd);
6be3b590 230 SvTAINTED_on(ST(0));
5db16f6a
EF
231 XSRETURN(1);
232 }
233 XSRETURN_UNDEF;
234}
235
49fd6edc
YST
236XS(XS_Cygwin_pid_to_winpid)
237{
238 dXSARGS;
d2dc0126
YST
239 dXSTARG;
240 pid_t pid, RETVAL;
241
49fd6edc
YST
242 if (items != 1)
243 Perl_croak(aTHX_ "Usage: Cygwin::pid_to_winpid(pid)");
d2dc0126
YST
244
245 pid = (pid_t)SvIV(ST(0));
246
49fd6edc
YST
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
49fd6edc
YST
254XS(XS_Cygwin_winpid_to_pid)
255{
256 dXSARGS;
d2dc0126
YST
257 dXSTARG;
258 pid_t pid, RETVAL;
259
49fd6edc
YST
260 if (items != 1)
261 Perl_croak(aTHX_ "Usage: Cygwin::winpid_to_pid(pid)");
d2dc0126
YST
262
263 pid = (pid_t)SvIV(ST(0));
264
803e389c
RU
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) {
49fd6edc
YST
271 XSprePUSH; PUSHi((IV)RETVAL);
272 XSRETURN(1);
273 }
274 XSRETURN_UNDEF;
275}
276
15414d2b 277XS(XS_Cygwin_win_to_posix_path)
803e389c 278
15414d2b
RU
279{
280 dXSARGS;
281 int absolute_flag = 0;
282 STRLEN len;
ba495c01 283 int err = 0;
803e389c
RU
284 char *src_path;
285 char *posix_path;
286 int isutf8 = 0;
15414d2b
RU
287
288 if (items < 1 || items > 2)
289 Perl_croak(aTHX_ "Usage: Cygwin::win_to_posix_path(pathname, [absolute])");
290
803e389c 291 src_path = SvPV(ST(0), len);
15414d2b
RU
292 if (items == 2)
293 absolute_flag = SvTRUE(ST(1));
294
295 if (!len)
296 Perl_croak(aTHX_ "can't convert empty path");
803e389c 297 isutf8 = SvUTF8(ST(0));
15414d2b 298
803e389c
RU
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;
dad3daef 305 STRLEN wlen = sizeof(wchar_t)*(len + 260 + 1001);
803e389c
RU
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;
a0b53297
KW
310 char *oldlocale;
311 dVAR;
312
313 LOCALE_LOCK;
314
315 oldlocale = setlocale(LC_CTYPE, NULL);
803e389c 316 setlocale(LC_CTYPE, "utf-8");
c80e42f3 317 /* utf8_to_uvchr_buf(src_path, src_path + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */
803e389c
RU
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");
a0b53297
KW
323
324 LOCALE_UNLOCK;
803e389c
RU
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);
dad3daef 336 Perl_utf16_to_utf8(aTHX_ (U8*)&wpath, (U8*)posix_path, wlen*2, &len);
803e389c
RU
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);
15414d2b 354 if (absolute_flag)
803e389c 355 err = cygwin_conv_to_full_posix_path(src_path, posix_path);
15414d2b 356 else
803e389c
RU
357 err = cygwin_conv_to_posix_path(src_path, posix_path);
358#endif
15414d2b 359 if (!err) {
803e389c
RU
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);
15414d2b 368 } else {
803e389c 369 safefree(posix_path);
15414d2b
RU
370 XSRETURN_UNDEF;
371 }
372}
373
374XS(XS_Cygwin_posix_to_win_path)
375{
376 dXSARGS;
377 int absolute_flag = 0;
378 STRLEN len;
ba495c01 379 int err = 0;
803e389c
RU
380 char *src_path, *win_path;
381 int isutf8 = 0;
15414d2b
RU
382
383 if (items < 1 || items > 2)
384 Perl_croak(aTHX_ "Usage: Cygwin::posix_to_win_path(pathname, [absolute])");
385
803e389c 386 src_path = SvPVx(ST(0), len);
15414d2b
RU
387 if (items == 2)
388 absolute_flag = SvTRUE(ST(1));
389
390 if (!len)
391 Perl_croak(aTHX_ "can't convert empty path");
803e389c
RU
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);
a0b53297
KW
402 char *oldlocale;
403 dVAR;
404
405 LOCALE_LOCK;
406
407 oldlocale = setlocale(LC_CTYPE, NULL);
803e389c
RU
408 setlocale(LC_CTYPE, "utf-8");
409 if (!IN_BYTES) {
410 mbstate_t mbs;
c80e42f3 411 /* utf8_to_uvchr_buf(src_path, src_path + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */
803e389c
RU
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");
a0b53297
KW
430
431 LOCALE_UNLOCK;
803e389c
RU
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);
15414d2b 446 if (absolute_flag)
803e389c 447 err = cygwin_conv_to_full_win32_path(src_path, win_path);
15414d2b 448 else
803e389c
RU
449 err = cygwin_conv_to_win32_path(src_path, win_path);
450#endif
15414d2b 451 if (!err) {
803e389c
RU
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);
15414d2b 459 } else {
803e389c 460 safefree(win_path);
15414d2b
RU
461 XSRETURN_UNDEF;
462 }
463}
464
a25ce5f3
RU
465XS(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
487XS(XS_Cygwin_mount_flags)
488{
489 dXSARGS;
490 char *pathname;
803e389c
RU
491 char flags[PATH_MAX];
492 flags[0] = '\0';
a25ce5f3
RU
493
494 if (items != 1)
803e389c 495 Perl_croak(aTHX_ "Usage: Cygwin::mount_flags( mnt_dir | '/cygdrive' )");
a25ce5f3
RU
496
497 pathname = SvPV_nolen(ST(0));
74dc058d 498
083b2a61 499 if (strEQ(pathname, "/cygdrive")) {
803e389c
RU
500 char user[PATH_MAX];
501 char system[PATH_MAX];
502 char user_flags[PATH_MAX];
503 char system_flags[PATH_MAX];
74dc058d 504
803e389c
RU
505 cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system,
506 user_flags, system_flags);
74dc058d
JH
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
a25ce5f3
RU
514 ST(0) = sv_2mortal(newSVpv(flags, 0));
515 XSRETURN(1);
74dc058d 516
a25ce5f3
RU
517 } else {
518 struct mntent *mnt;
803e389c 519 int found = 0;
a25ce5f3
RU
520 setmntent (0, 0);
521 while ((mnt = getmntent (0))) {
083b2a61 522 if (strEQ(pathname, mnt->mnt_dir)) {
a25ce5f3
RU
523 strcpy(flags, mnt->mnt_type);
524 if (strlen(mnt->mnt_opts) > 0) {
525 strcat(flags, ",");
526 strcat(flags, mnt->mnt_opts);
527 }
803e389c 528 found++;
a25ce5f3
RU
529 break;
530 }
531 }
532 endmntent (0);
803e389c
RU
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) {
083b2a61 547 if (strNE(user,pathname)) {
803e389c
RU
548 sprintf(flags, "%s,cygdrive,%s", user_flags, user);
549 found++;
550 }
551 } else {
083b2a61 552 if (strNE(user,pathname)) {
803e389c
RU
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 }
a25ce5f3
RU
564 }
565}
566
15414d2b
RU
567XS(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
286f8194
RU
581XS(XS_Cygwin_sync_winenv){ cygwin_internal(CW_SYNC_WINENV); }
582
5db16f6a
EF
583void
584init_os_extras(void)
585{
5db16f6a 586 dTHX;
a4ec4e68 587 char const *file = __FILE__;
9fb265f7 588 void *handle;
5db16f6a
EF
589
590 newXS("Cwd::cwd", Cygwin_cwd, file);
15414d2b
RU
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, "$;$");
a25ce5f3
RU
595 newXSproto("Cygwin::mount_table", XS_Cygwin_mount_table, file, "");
596 newXSproto("Cygwin::mount_flags", XS_Cygwin_mount_flags, file, "$");
15414d2b 597 newXSproto("Cygwin::is_binmount", XS_Cygwin_is_binmount, file, "$");
286f8194 598 newXS("Cygwin::sync_winenv", XS_Cygwin_sync_winenv, file);
78ff2d7b 599
9fb265f7
JD
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);
78ff2d7b 608 }
5db16f6a 609}