[perl5.git] / cygwin / cygwin.c

/*
 * Cygwin extras
 */

#include "EXTERN.h"
#include "perl.h"
#undef USE_DYNAMIC_LOADING
#include "XSUB.h"

#include <unistd.h>
#include <process.h>
#include <sys/cygwin.h>
#include <mntent.h>
#include <alloca.h>
#include <dlfcn.h>

/*
 * pp_system() implemented via spawn()
 * - more efficient and useful when embedding Perl in non-Cygwin apps
 * - code mostly borrowed from djgpp.c
 */
static int
do_spawnvp (const char *path, const char * const *argv)
{
    dTHX;
    Sigsave_t ihand,qhand;
    int childpid, result, status;

    rsignal_save(SIGINT, (Sighandler_t) SIG_IGN, &ihand);
    rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand);
    childpid = spawnvp(_P_NOWAIT,path,argv);
    if (childpid < 0) {
	status = -1;
	if(ckWARN(WARN_EXEC))
	    Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't spawn \"%s\": %s",
		    path,Strerror (errno));
    } else {
	do {
	    result = wait4pid(childpid, &status, 0);
	} while (result == -1 && errno == EINTR);
	if(result < 0)
	    status = -1;
    }
    (void)rsignal_restore(SIGINT, &ihand);
    (void)rsignal_restore(SIGQUIT, &qhand);
    return status;
}

int
do_aspawn (SV *really, void **mark, void **sp)
{
    dTHX;
    int  rc;
    char const **a;
    char *tmps,**argv;
    STRLEN n_a;

    if (sp<=mark)
        return -1;
    argv=(char**) alloca ((sp-mark+3)*sizeof (char*));
    a=(char const **)argv;

    while (++mark <= sp)
        if (*mark)
            *a++ = SvPVx((SV *)*mark, n_a);
        else
            *a++ = "";
    *a = (char*)NULL;

    if (argv[0][0] != '/' && argv[0][0] != '\\'
        && !(argv[0][0] && argv[0][1] == ':'
        && (argv[0][2] == '/' || argv[0][2] != '\\'))
     ) /* will swawnvp use PATH? */
         TAINT_ENV();	/* testing IFS here is overkill, probably */

    if (really && *(tmps = SvPV(really, n_a)))
        rc=do_spawnvp (tmps,(const char * const *)argv);
    else
        rc=do_spawnvp (argv[0],(const char *const *)argv);

    return rc;
}

int
do_spawn (char *cmd)
{
    dTHX;
    char const **a;
    char *s;
    char const *metachars = "$&*(){}[]'\";\\?>|<~`\n";
    const char *command[4];

    while (*cmd && isSPACE(*cmd))
	cmd++;

    if (strnEQ (cmd,"/bin/sh",7) && isSPACE (cmd[7]))
        cmd+=5;

    /* save an extra exec if possible */
    /* see if there are shell metacharacters in it */
    if (strstr (cmd,"..."))
	goto doshell;
    if (*cmd=='.' && isSPACE (cmd[1]))
	goto doshell;
    if (strnEQ (cmd,"exec",4) && isSPACE (cmd[4]))
	goto doshell;
    for (s=cmd; *s && isALPHA (*s); s++) ;	/* catch VAR=val gizmo */
	if (*s=='=')
	    goto doshell;

    for (s=cmd; *s; s++)
	if (strchr (metachars,*s))
	{
	    if (*s=='\n' && s[1]=='\0')
	    {
		*s='\0';
		break;
	    }
	doshell:
	    command[0] = "sh";
	    command[1] = "-c";
	    command[2] = cmd;
	    command[3] = NULL;

	    return do_spawnvp("sh",command);
	}

    Newx (PL_Argv,(s-cmd)/2+2,const char*);
    PL_Cmd=savepvn (cmd,s-cmd);
    a=PL_Argv;
    for (s=PL_Cmd; *s;) {
	while (*s && isSPACE (*s)) s++;
	if (*s)
	    *(a++)=s;
	while (*s && !isSPACE (*s)) s++;
	if (*s)
	    *s++='\0';
    }
    *a = (char*)NULL;
    if (!PL_Argv[0])
        return -1;

    return do_spawnvp(PL_Argv[0],(const char * const *)PL_Argv);
}

/* see also Cwd.pm */
XS(Cygwin_cwd)
{
    dXSARGS;
    char *cwd;

    /* See http://rt.perl.org/rt3/Ticket/Display.html?id=38628 
       There is Cwd->cwd() usage in the wild, and previous versions didn't die.
     */
    if(items > 1)
	Perl_croak(aTHX_ "Usage: Cwd::cwd()");
    if((cwd = getcwd(NULL, -1))) {
	ST(0) = sv_2mortal(newSVpv(cwd, 0));
	free(cwd);
#ifndef INCOMPLETE_TAINTS
	SvTAINTED_on(ST(0));
#endif
	XSRETURN(1);
    }
    XSRETURN_UNDEF;
}

XS(XS_Cygwin_pid_to_winpid)
{
    dXSARGS;
    dXSTARG;
    pid_t pid, RETVAL;

    if (items != 1)
        Perl_croak(aTHX_ "Usage: Cygwin::pid_to_winpid(pid)");

    pid = (pid_t)SvIV(ST(0));

    if ((RETVAL = cygwin_internal(CW_CYGWIN_PID_TO_WINPID, pid)) > 0) {
	XSprePUSH; PUSHi((IV)RETVAL);
        XSRETURN(1);
    }
    XSRETURN_UNDEF;
}

XS(XS_Cygwin_winpid_to_pid)
{
    dXSARGS;
    dXSTARG;
    pid_t pid, RETVAL;

    if (items != 1)
        Perl_croak(aTHX_ "Usage: Cygwin::winpid_to_pid(pid)");

    pid = (pid_t)SvIV(ST(0));

    if ((RETVAL = cygwin32_winpid_to_pid(pid)) > 0) {
        XSprePUSH; PUSHi((IV)RETVAL);
        XSRETURN(1);
    }
    XSRETURN_UNDEF;
}

XS(XS_Cygwin_win_to_posix_path)
{
    dXSARGS;
    int absolute_flag = 0;
    STRLEN len;
    int err;
    char *pathname, *buf;

    if (items < 1 || items > 2)
        Perl_croak(aTHX_ "Usage: Cygwin::win_to_posix_path(pathname, [absolute])");

    pathname = SvPV(ST(0), len);
    if (items == 2)
	absolute_flag = SvTRUE(ST(1));

    if (!len)
	Perl_croak(aTHX_ "can't convert empty path");
    buf = (char *) safemalloc (len + 260 + 1001);

    if (absolute_flag)
	err = cygwin_conv_to_full_posix_path(pathname, buf);
    else
	err = cygwin_conv_to_posix_path(pathname, buf);
    if (!err) {
	ST(0) = sv_2mortal(newSVpv(buf, 0));
	safefree(buf);
       XSRETURN(1);
    } else {
	safefree(buf);
	XSRETURN_UNDEF;
    }
}

XS(XS_Cygwin_posix_to_win_path)
{
    dXSARGS;
    int absolute_flag = 0;
    STRLEN len;
    int err;
    char *pathname, *buf;

    if (items < 1 || items > 2)
        Perl_croak(aTHX_ "Usage: Cygwin::posix_to_win_path(pathname, [absolute])");

    pathname = SvPV(ST(0), len);
    if (items == 2)
	absolute_flag = SvTRUE(ST(1));

    if (!len)
	Perl_croak(aTHX_ "can't convert empty path");
    buf = (char *) safemalloc(len + 260 + 1001);

    if (absolute_flag)
	err = cygwin_conv_to_full_win32_path(pathname, buf);
    else
	err = cygwin_conv_to_win32_path(pathname, buf);
    if (!err) {
	ST(0) = sv_2mortal(newSVpv(buf, 0));
	safefree(buf);
       XSRETURN(1);
    } else {
	safefree(buf);
	XSRETURN_UNDEF;
    }
}

XS(XS_Cygwin_mount_table)
{
    dXSARGS;
    struct mntent *mnt;

    if (items != 0)
        Perl_croak(aTHX_ "Usage: Cygwin::mount_table");
    /* => array of [mnt_dir mnt_fsname mnt_type mnt_opts] */

    setmntent (0, 0);
    while ((mnt = getmntent (0))) {
	AV* av = newAV();
	av_push(av, newSVpvn(mnt->mnt_dir, strlen(mnt->mnt_dir)));
	av_push(av, newSVpvn(mnt->mnt_fsname, strlen(mnt->mnt_fsname)));
	av_push(av, newSVpvn(mnt->mnt_type, strlen(mnt->mnt_type)));
	av_push(av, newSVpvn(mnt->mnt_opts, strlen(mnt->mnt_opts)));
	XPUSHs(sv_2mortal(newRV_noinc((SV*)av)));
    }
    endmntent (0);
    PUTBACK;
}

XS(XS_Cygwin_mount_flags)
{
    dXSARGS;
    char *pathname;
    char flags[260];

    if (items != 1)
        Perl_croak(aTHX_ "Usage: Cygwin::mount_flags(mnt_dir|'/cygwin')");

    pathname = SvPV_nolen(ST(0));

    /* TODO: Check for cygdrive registry setting,
     *       and then use CW_GET_CYGDRIVE_INFO
     */
    if (!strcmp(pathname, "/cygdrive")) {
	char user[260];
	char system[260];
	char user_flags[260];
	char system_flags[260];

	cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system, user_flags,
			 system_flags);

        if (strlen(user) > 0) {
            sprintf(flags, "%s,cygdrive,%s", user_flags, user);
        } else {
            sprintf(flags, "%s,cygdrive,%s", system_flags, system);
        }

	ST(0) = sv_2mortal(newSVpv(flags, 0));
	XSRETURN(1);

    } else {
	struct mntent *mnt;
	setmntent (0, 0);
	while ((mnt = getmntent (0))) {
	    if (!strcmp(pathname, mnt->mnt_dir)) {
		strcpy(flags, mnt->mnt_type);
		if (strlen(mnt->mnt_opts) > 0) {
		    strcat(flags, ",");
		    strcat(flags, mnt->mnt_opts);
		}
		break;
	    }
	}
	endmntent (0);
	ST(0) = sv_2mortal(newSVpv(flags, 0));
	XSRETURN(1);
    }
}

XS(XS_Cygwin_is_binmount)
{
    dXSARGS;
    char *pathname;

    if (items != 1)
        Perl_croak(aTHX_ "Usage: Cygwin::is_binmount(pathname)");

    pathname = SvPV_nolen(ST(0));

    ST(0) = boolSV(cygwin_internal(CW_GET_BINMODE, pathname));
    XSRETURN(1);
}

void
init_os_extras(void)
{
    dTHX;
    char const *file = __FILE__;
    void *handle;

    newXS("Cwd::cwd", Cygwin_cwd, file);
    newXSproto("Cygwin::winpid_to_pid", XS_Cygwin_winpid_to_pid, file, "$");
    newXSproto("Cygwin::pid_to_winpid", XS_Cygwin_pid_to_winpid, file, "$");
    newXSproto("Cygwin::win_to_posix_path", XS_Cygwin_win_to_posix_path, file, "$;$");
    newXSproto("Cygwin::posix_to_win_path", XS_Cygwin_posix_to_win_path, file, "$;$");
    newXSproto("Cygwin::mount_table", XS_Cygwin_mount_table, file, "");
    newXSproto("Cygwin::mount_flags", XS_Cygwin_mount_flags, file, "$");
    newXSproto("Cygwin::is_binmount", XS_Cygwin_is_binmount, file, "$");

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