This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove use of dVAR in core
[perl5.git] / cygwin / cygwin.c
CommitLineData
5db16f6a
FE
1/*
2 * Cygwin extras
3 */
4
6cc44f62 5#define PERLIO_NOT_STDIO 0
5db16f6a
FE
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
JHR
59 char const **a;
60 char *tmps,**argv;
61 STRLEN n_a;
b4bcd662
GS
62
63 if (sp<=mark)
64 return -1;
a4ec4e68
JHR
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
JHR
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 165 char *oldlocale;
a0b53297
KW
166
167 /* Here and elsewhere in this file, we have a critical section to prevent
168 * another thread from changing the locale out from under us. XXX But why
169 * not just use uvchr_to_utf8? */
170 LOCALE_LOCK;
171
172 oldlocale = setlocale(LC_CTYPE, NULL);
803e389c
RU
173 setlocale(LC_CTYPE, "utf-8");
174
c80e42f3 175 /* uvchr_to_utf8(buf, chr) or Encoding::_bytes_to_utf8(sv, "UCS-2BE"); */
803e389c
RU
176 wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL);
177 buf = (char *) safemalloc(wlen+1);
178 wcsrtombs(buf, (const wchar_t **)&wbuf, wlen, NULL);
179
180 if (oldlocale) setlocale(LC_CTYPE, oldlocale);
181 else setlocale(LC_CTYPE, "C");
a0b53297
KW
182
183 LOCALE_UNLOCK;
184
803e389c
RU
185 return buf;
186}
187
188wchar_t*
189utf8_to_wide(const char *buf)
190{
191 wchar_t *wbuf;
192 mbstate_t mbs;
a0b53297 193 char *oldlocale;
803e389c 194 int wlen = sizeof(wchar_t)*strlen(buf);
a0b53297
KW
195
196 LOCALE_LOCK;
197
198 oldlocale = setlocale(LC_CTYPE, NULL);
803e389c
RU
199
200 setlocale(LC_CTYPE, "utf-8");
201 wbuf = (wchar_t *) safemalloc(wlen);
c80e42f3 202 /* utf8_to_uvchr_buf(pathname, pathname + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */
803e389c
RU
203 wlen = mbsrtowcs(wbuf, (const char**)&buf, wlen, &mbs);
204
205 if (oldlocale) setlocale(LC_CTYPE, oldlocale);
206 else setlocale(LC_CTYPE, "C");
a0b53297
KW
207
208 LOCALE_UNLOCK;
209
803e389c
RU
210 return wbuf;
211}
212#endif /* cygwin 1.7 */
213
5db16f6a 214/* see also Cwd.pm */
5db16f6a
FE
215XS(Cygwin_cwd)
216{
217 dXSARGS;
218 char *cwd;
219
8034715d 220 /* See https://github.com/Perl/perl5/issues/8345
482150a7
JH
221 There is Cwd->cwd() usage in the wild, and previous versions didn't die.
222 */
223 if(items > 1)
5db16f6a 224 Perl_croak(aTHX_ "Usage: Cwd::cwd()");
47dafe4d 225 if((cwd = getcwd(NULL, -1))) {
5db16f6a 226 ST(0) = sv_2mortal(newSVpv(cwd, 0));
a236cecb 227 free(cwd);
6be3b590 228 SvTAINTED_on(ST(0));
5db16f6a
FE
229 XSRETURN(1);
230 }
231 XSRETURN_UNDEF;
232}
233
49fd6edc
YST
234XS(XS_Cygwin_pid_to_winpid)
235{
236 dXSARGS;
d2dc0126
YST
237 dXSTARG;
238 pid_t pid, RETVAL;
239
49fd6edc
YST
240 if (items != 1)
241 Perl_croak(aTHX_ "Usage: Cygwin::pid_to_winpid(pid)");
d2dc0126
YST
242
243 pid = (pid_t)SvIV(ST(0));
244
49fd6edc
YST
245 if ((RETVAL = cygwin_internal(CW_CYGWIN_PID_TO_WINPID, pid)) > 0) {
246 XSprePUSH; PUSHi((IV)RETVAL);
247 XSRETURN(1);
248 }
249 XSRETURN_UNDEF;
250}
251
49fd6edc
YST
252XS(XS_Cygwin_winpid_to_pid)
253{
254 dXSARGS;
d2dc0126
YST
255 dXSTARG;
256 pid_t pid, RETVAL;
257
49fd6edc
YST
258 if (items != 1)
259 Perl_croak(aTHX_ "Usage: Cygwin::winpid_to_pid(pid)");
d2dc0126
YST
260
261 pid = (pid_t)SvIV(ST(0));
262
803e389c
RU
263#if (CYGWIN_VERSION_API_MINOR >= 181)
264 RETVAL = cygwin_winpid_to_pid(pid);
265#else
266 RETVAL = cygwin32_winpid_to_pid(pid);
267#endif
268 if (RETVAL > 0) {
49fd6edc
YST
269 XSprePUSH; PUSHi((IV)RETVAL);
270 XSRETURN(1);
271 }
272 XSRETURN_UNDEF;
273}
274
15414d2b 275XS(XS_Cygwin_win_to_posix_path)
803e389c 276
15414d2b
RU
277{
278 dXSARGS;
279 int absolute_flag = 0;
280 STRLEN len;
ba495c01 281 int err = 0;
803e389c
RU
282 char *src_path;
283 char *posix_path;
284 int isutf8 = 0;
15414d2b
RU
285
286 if (items < 1 || items > 2)
287 Perl_croak(aTHX_ "Usage: Cygwin::win_to_posix_path(pathname, [absolute])");
288
803e389c 289 src_path = SvPV(ST(0), len);
15414d2b
RU
290 if (items == 2)
291 absolute_flag = SvTRUE(ST(1));
292
293 if (!len)
294 Perl_croak(aTHX_ "can't convert empty path");
803e389c 295 isutf8 = SvUTF8(ST(0));
15414d2b 296
803e389c
RU
297#if (CYGWIN_VERSION_API_MINOR >= 181)
298 /* Check utf8 flag and use wide api then.
299 Size calculation: On overflow let cygwin_conv_path calculate the final size.
300 */
301 if (isutf8) {
302 int what = absolute_flag ? CCP_WIN_W_TO_POSIX : CCP_WIN_W_TO_POSIX | CCP_RELATIVE;
dad3daef 303 STRLEN wlen = sizeof(wchar_t)*(len + 260 + 1001);
803e389c
RU
304 wchar_t *wpath = (wchar_t *) safemalloc(sizeof(wchar_t)*len);
305 wchar_t *wbuf = (wchar_t *) safemalloc(wlen);
306 if (!IN_BYTES) {
307 mbstate_t mbs;
a0b53297 308 char *oldlocale;
a0b53297
KW
309
310 LOCALE_LOCK;
311
312 oldlocale = setlocale(LC_CTYPE, NULL);
803e389c 313 setlocale(LC_CTYPE, "utf-8");
c80e42f3 314 /* utf8_to_uvchr_buf(src_path, src_path + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */
803e389c
RU
315 wlen = mbsrtowcs(wpath, (const char**)&src_path, wlen, &mbs);
316 if (wlen > 0)
317 err = cygwin_conv_path(what, wpath, wbuf, wlen);
318 if (oldlocale) setlocale(LC_CTYPE, oldlocale);
319 else setlocale(LC_CTYPE, "C");
a0b53297
KW
320
321 LOCALE_UNLOCK;
803e389c
RU
322 } else { /* use bytes; assume already ucs-2 encoded bytestream */
323 err = cygwin_conv_path(what, src_path, wbuf, wlen);
324 }
325 if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
326 int newlen = cygwin_conv_path(what, wpath, wbuf, 0);
327 wbuf = (wchar_t *) realloc(&wbuf, newlen);
328 err = cygwin_conv_path(what, wpath, wbuf, newlen);
329 wlen = newlen;
330 }
331 /* utf16_to_utf8(*p, *d, bytlen, *newlen) */
332 posix_path = (char *) safemalloc(wlen*3);
dad3daef 333 Perl_utf16_to_utf8(aTHX_ (U8*)&wpath, (U8*)posix_path, wlen*2, &len);
803e389c
RU
334 /*
335 wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL);
336 posix_path = (char *) safemalloc(wlen+1);
337 wcsrtombs(posix_path, (const wchar_t **)&wbuf, wlen, NULL);
338 */
339 } else {
340 int what = absolute_flag ? CCP_WIN_A_TO_POSIX : CCP_WIN_A_TO_POSIX | CCP_RELATIVE;
341 posix_path = (char *) safemalloc (len + 260 + 1001);
342 err = cygwin_conv_path(what, src_path, posix_path, len + 260 + 1001);
343 if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
344 int newlen = cygwin_conv_path(what, src_path, posix_path, 0);
345 posix_path = (char *) realloc(&posix_path, newlen);
346 err = cygwin_conv_path(what, src_path, posix_path, newlen);
347 }
348 }
349#else
350 posix_path = (char *) safemalloc (len + 260 + 1001);
15414d2b 351 if (absolute_flag)
803e389c 352 err = cygwin_conv_to_full_posix_path(src_path, posix_path);
15414d2b 353 else
803e389c
RU
354 err = cygwin_conv_to_posix_path(src_path, posix_path);
355#endif
15414d2b 356 if (!err) {
803e389c
RU
357 EXTEND(SP, 1);
358 ST(0) = sv_2mortal(newSVpv(posix_path, 0));
359 if (isutf8) { /* src was utf-8, so result should also */
360 /* TODO: convert ANSI (local windows encoding) to utf-8 on cygwin-1.5 */
361 SvUTF8_on(ST(0));
362 }
363 safefree(posix_path);
364 XSRETURN(1);
15414d2b 365 } else {
803e389c 366 safefree(posix_path);
15414d2b
RU
367 XSRETURN_UNDEF;
368 }
369}
370
371XS(XS_Cygwin_posix_to_win_path)
372{
373 dXSARGS;
374 int absolute_flag = 0;
375 STRLEN len;
ba495c01 376 int err = 0;
803e389c
RU
377 char *src_path, *win_path;
378 int isutf8 = 0;
15414d2b
RU
379
380 if (items < 1 || items > 2)
381 Perl_croak(aTHX_ "Usage: Cygwin::posix_to_win_path(pathname, [absolute])");
382
803e389c 383 src_path = SvPVx(ST(0), len);
15414d2b
RU
384 if (items == 2)
385 absolute_flag = SvTRUE(ST(1));
386
387 if (!len)
388 Perl_croak(aTHX_ "can't convert empty path");
803e389c
RU
389 isutf8 = SvUTF8(ST(0));
390#if (CYGWIN_VERSION_API_MINOR >= 181)
391 /* Check utf8 flag and use wide api then.
392 Size calculation: On overflow let cygwin_conv_path calculate the final size.
393 */
394 if (isutf8) {
395 int what = absolute_flag ? CCP_POSIX_TO_WIN_W : CCP_POSIX_TO_WIN_W | CCP_RELATIVE;
396 int wlen = sizeof(wchar_t)*(len + 260 + 1001);
397 wchar_t *wpath = (wchar_t *) safemalloc(sizeof(wchar_t)*len);
398 wchar_t *wbuf = (wchar_t *) safemalloc(wlen);
a0b53297 399 char *oldlocale;
a0b53297
KW
400
401 LOCALE_LOCK;
402
403 oldlocale = setlocale(LC_CTYPE, NULL);
803e389c
RU
404 setlocale(LC_CTYPE, "utf-8");
405 if (!IN_BYTES) {
406 mbstate_t mbs;
c80e42f3 407 /* utf8_to_uvchr_buf(src_path, src_path + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */
803e389c
RU
408 wlen = mbsrtowcs(wpath, (const char**)&src_path, wlen, &mbs);
409 if (wlen > 0)
410 err = cygwin_conv_path(what, wpath, wbuf, wlen);
411 } else { /* use bytes; assume already ucs-2 encoded bytestream */
412 err = cygwin_conv_path(what, src_path, wbuf, wlen);
413 }
414 if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
415 int newlen = cygwin_conv_path(what, wpath, wbuf, 0);
416 wbuf = (wchar_t *) realloc(&wbuf, newlen);
417 err = cygwin_conv_path(what, wpath, wbuf, newlen);
418 wlen = newlen;
419 }
420 /* also see utf8.c: Perl_utf16_to_utf8() or Encoding::_bytes_to_utf8(sv, "UCS-2BE"); */
421 wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL);
422 win_path = (char *) safemalloc(wlen+1);
423 wcsrtombs(win_path, (const wchar_t **)&wbuf, wlen, NULL);
424 if (oldlocale) setlocale(LC_CTYPE, oldlocale);
425 else setlocale(LC_CTYPE, "C");
a0b53297
KW
426
427 LOCALE_UNLOCK;
803e389c
RU
428 } else {
429 int what = absolute_flag ? CCP_POSIX_TO_WIN_A : CCP_POSIX_TO_WIN_A | CCP_RELATIVE;
430 win_path = (char *) safemalloc(len + 260 + 1001);
431 err = cygwin_conv_path(what, src_path, win_path, len + 260 + 1001);
432 if (err == ENOSPC) { /* our space assumption was wrong, not enough space */
433 int newlen = cygwin_conv_path(what, src_path, win_path, 0);
434 win_path = (char *) realloc(&win_path, newlen);
435 err = cygwin_conv_path(what, src_path, win_path, newlen);
436 }
437 }
438#else
439 if (isutf8)
440 Perl_warn(aTHX_ "can't convert utf8 path");
441 win_path = (char *) safemalloc(len + 260 + 1001);
15414d2b 442 if (absolute_flag)
803e389c 443 err = cygwin_conv_to_full_win32_path(src_path, win_path);
15414d2b 444 else
803e389c
RU
445 err = cygwin_conv_to_win32_path(src_path, win_path);
446#endif
15414d2b 447 if (!err) {
803e389c
RU
448 EXTEND(SP, 1);
449 ST(0) = sv_2mortal(newSVpv(win_path, 0));
450 if (isutf8) {
451 SvUTF8_on(ST(0));
452 }
453 safefree(win_path);
454 XSRETURN(1);
15414d2b 455 } else {
803e389c 456 safefree(win_path);
15414d2b
RU
457 XSRETURN_UNDEF;
458 }
459}
460
a25ce5f3
RU
461XS(XS_Cygwin_mount_table)
462{
463 dXSARGS;
464 struct mntent *mnt;
465
466 if (items != 0)
467 Perl_croak(aTHX_ "Usage: Cygwin::mount_table");
468 /* => array of [mnt_dir mnt_fsname mnt_type mnt_opts] */
469
470 setmntent (0, 0);
471 while ((mnt = getmntent (0))) {
472 AV* av = newAV();
473 av_push(av, newSVpvn(mnt->mnt_dir, strlen(mnt->mnt_dir)));
474 av_push(av, newSVpvn(mnt->mnt_fsname, strlen(mnt->mnt_fsname)));
475 av_push(av, newSVpvn(mnt->mnt_type, strlen(mnt->mnt_type)));
476 av_push(av, newSVpvn(mnt->mnt_opts, strlen(mnt->mnt_opts)));
477 XPUSHs(sv_2mortal(newRV_noinc((SV*)av)));
478 }
479 endmntent (0);
480 PUTBACK;
481}
482
483XS(XS_Cygwin_mount_flags)
484{
485 dXSARGS;
486 char *pathname;
803e389c
RU
487 char flags[PATH_MAX];
488 flags[0] = '\0';
a25ce5f3
RU
489
490 if (items != 1)
803e389c 491 Perl_croak(aTHX_ "Usage: Cygwin::mount_flags( mnt_dir | '/cygdrive' )");
a25ce5f3
RU
492
493 pathname = SvPV_nolen(ST(0));
74dc058d 494
083b2a61 495 if (strEQ(pathname, "/cygdrive")) {
803e389c
RU
496 char user[PATH_MAX];
497 char system[PATH_MAX];
498 char user_flags[PATH_MAX];
499 char system_flags[PATH_MAX];
74dc058d 500
803e389c
RU
501 cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system,
502 user_flags, system_flags);
74dc058d
JH
503
504 if (strlen(user) > 0) {
505 sprintf(flags, "%s,cygdrive,%s", user_flags, user);
506 } else {
507 sprintf(flags, "%s,cygdrive,%s", system_flags, system);
508 }
509
a25ce5f3
RU
510 ST(0) = sv_2mortal(newSVpv(flags, 0));
511 XSRETURN(1);
74dc058d 512
a25ce5f3
RU
513 } else {
514 struct mntent *mnt;
803e389c 515 int found = 0;
a25ce5f3
RU
516 setmntent (0, 0);
517 while ((mnt = getmntent (0))) {
083b2a61 518 if (strEQ(pathname, mnt->mnt_dir)) {
a25ce5f3
RU
519 strcpy(flags, mnt->mnt_type);
520 if (strlen(mnt->mnt_opts) > 0) {
521 strcat(flags, ",");
522 strcat(flags, mnt->mnt_opts);
523 }
803e389c 524 found++;
a25ce5f3
RU
525 break;
526 }
527 }
528 endmntent (0);
803e389c
RU
529
530 /* Check if arg is the current volume moint point if not default,
531 * and then use CW_GET_CYGDRIVE_INFO also.
532 */
533 if (!found) {
534 char user[PATH_MAX];
535 char system[PATH_MAX];
536 char user_flags[PATH_MAX];
537 char system_flags[PATH_MAX];
538
539 cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system,
540 user_flags, system_flags);
541
542 if (strlen(user) > 0) {
083b2a61 543 if (strNE(user,pathname)) {
803e389c
RU
544 sprintf(flags, "%s,cygdrive,%s", user_flags, user);
545 found++;
546 }
547 } else {
083b2a61 548 if (strNE(user,pathname)) {
803e389c
RU
549 sprintf(flags, "%s,cygdrive,%s", system_flags, system);
550 found++;
551 }
552 }
553 }
554 if (found) {
555 ST(0) = sv_2mortal(newSVpv(flags, 0));
556 XSRETURN(1);
557 } else {
558 XSRETURN_UNDEF;
559 }
a25ce5f3
RU
560 }
561}
562
15414d2b
RU
563XS(XS_Cygwin_is_binmount)
564{
565 dXSARGS;
566 char *pathname;
567
568 if (items != 1)
569 Perl_croak(aTHX_ "Usage: Cygwin::is_binmount(pathname)");
570
571 pathname = SvPV_nolen(ST(0));
572
573 ST(0) = boolSV(cygwin_internal(CW_GET_BINMODE, pathname));
574 XSRETURN(1);
575}
576
286f8194
RU
577XS(XS_Cygwin_sync_winenv){ cygwin_internal(CW_SYNC_WINENV); }
578
5db16f6a
FE
579void
580init_os_extras(void)
581{
5db16f6a 582 dTHX;
a4ec4e68 583 char const *file = __FILE__;
9fb265f7 584 void *handle;
5db16f6a
FE
585
586 newXS("Cwd::cwd", Cygwin_cwd, file);
15414d2b
RU
587 newXSproto("Cygwin::winpid_to_pid", XS_Cygwin_winpid_to_pid, file, "$");
588 newXSproto("Cygwin::pid_to_winpid", XS_Cygwin_pid_to_winpid, file, "$");
589 newXSproto("Cygwin::win_to_posix_path", XS_Cygwin_win_to_posix_path, file, "$;$");
590 newXSproto("Cygwin::posix_to_win_path", XS_Cygwin_posix_to_win_path, file, "$;$");
a25ce5f3
RU
591 newXSproto("Cygwin::mount_table", XS_Cygwin_mount_table, file, "");
592 newXSproto("Cygwin::mount_flags", XS_Cygwin_mount_flags, file, "$");
15414d2b 593 newXSproto("Cygwin::is_binmount", XS_Cygwin_is_binmount, file, "$");
286f8194 594 newXS("Cygwin::sync_winenv", XS_Cygwin_sync_winenv, file);
78ff2d7b 595
9fb265f7
JD
596 /* Initialize Win32CORE if it has been statically linked. */
597 handle = dlopen(NULL, RTLD_LAZY);
598 if (handle) {
599 void (*pfn_init)(pTHX);
600 pfn_init = (void (*)(pTHX))dlsym(handle, "init_Win32CORE");
601 if (pfn_init)
602 pfn_init(aTHX);
603 dlclose(handle);
78ff2d7b 604 }
5db16f6a 605}