Cygwin::mount_table, Cygwin::mount_flags

Message-Id: <46C14E6C.8020809@x-ray.at>

p4raw-id: //depot/perl@31708

3 files changed, 132 insertions, 7 deletions

diff --git a/README.cygwin b/README.cygwin
index d618b9d3b5..ac85a9d5cf 100644
--- a/README.cygwin
+++ b/README.cygwin
@@ -520,6 +520,38 @@ Translates a cygwin path to the corresponding cygwin path respecting
 the current mount points. With a second non-null argument returns an
 absolute path. Double-byte characters will not be translated.
 
+=item C<Cygwin::mount_table()>
+
+Returns an array of [mnt_dir, mnt_fsname, mnt_type, mnt_opts].
+
+  perl -e 'for $i (Cygwin::mount_table) {print join(" ",@$i),"\n";}'
+  /bin c:\cygwin\bin system binmode,cygexec
+  /usr/bin c:\cygwin\bin system binmode
+  /usr/lib c:\cygwin\lib system binmode
+  / c:\cygwin system binmode
+  /cygdrive/c c: system binmode,noumount
+  /cygdrive/d d: system binmode,noumount
+  /cygdrive/e e: system binmode,noumount 
+
+=item C<Cygwin::mount_flags>
+
+Returns the mount type and flags for a specified mount point.
+A comma-seperated string of mntent->mnt_type (always
+"system" or "user"), then the mntent->mnt_opts, where
+the first is always "binmode" or "textmode".
+
+  system|user,binmode|textmode,exec,cygexec,cygdrive,mixed,
+  notexec,managed,nosuid,devfs,proc,noumount
+
+If the argument is "/cygdrive", just the volume mount settings are returned. 
+
+User mounts override system mounts.
+
+  $ perl -e 'print Cygwin::mount_flags "/usr/bin"'
+  system,binmode,cygexec
+  $ perl -e 'print Cygwin::mount_flags "/cygdrive"'
+  binmode,cygdrive 
+
 =item C<Cygwin::is_binmount>
 
 Returns true if the given cygwin path is binary mounted, false if the
@@ -596,8 +628,7 @@ be kept as clean as possible (listing not updated yet).
 
   EXTERN.h              - __declspec(dllimport)
   XSUB.h                - __declspec(dllexport)
-  cygwin/cygwin.c       - os_extras (getcwd, spawn, Cygwin::winpid_to_pid, 
-                          Cygwin::pid_to_winpid)
+  cygwin/cygwin.c       - os_extras (getcwd, spawn, and several Cygwin:: functions)
   perl.c                - os_extras
   perl.h                - binmode
   doio.c                - win9x can not rename a file when it is open
@@ -620,6 +651,7 @@ be kept as clean as possible (listing not updated yet).
   lib/ExtUtils/MM_Cygwin.pm
                         - canonpath, cflags, manifypods, perl_archive
   lib/File/Find.pm      - on remote drives stat() always sets st_nlink to 1
+  lib/File/Spec/Cygwin.pm - case_tolerant
   lib/File/Spec/Unix.pm - preserve //unc
   lib/File/Temp.pm      - no directory sticky bit
   lib/perl5db.pl        - use stdin not /dev/tty
@@ -642,8 +674,10 @@ alexander smishlajev <als@turnhere.com>,
 Steven Morlock <newspost@morlock.net>,
 Sebastien Barre <Sebastien.Barre@utc.fr>,
 Teun Burgers <burgers@ecn.nl>,
-Gerrit P. Haase <gp@familiehaase.de>.
+Gerrit P. Haase <gp@familiehaase.de>,
+Reini Urban <rurban@cpan.org>,
+Jan Dubois <jand@activestate.com>.
 
 =head1 HISTORY
 
-Last updated: 2005-02-11
+Last updated: 2007-08-12
diff --git a/cygwin/cygwin.c b/cygwin/cygwin.c
index 57f3b6a37c..84915f811e 100644
--- a/cygwin/cygwin.c
+++ b/cygwin/cygwin.c
@@ -10,6 +10,7 @@
 #include <unistd.h>
 #include <process.h>
 #include <sys/cygwin.h>
+#include <mntent.h>
 #include <alloca.h>
 #include <dlfcn.h>
 
@@ -259,6 +260,76 @@ XS(XS_Cygwin_posix_to_win_path)
     }
 }
 
+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)");
+
+    pathname = SvPV_nolen(ST(0));
+    
+    /* TODO: check for cygdrive registry setting. use CW_GET_CYGDRIVE_INFO then
+     */
+    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(system) > 0)
+	    strcpy (flags, system_flags);
+	if (strlen(user) > 0)
+	    strcpy(flags, user_flags);
+	if (strlen(flags) > 0)
+	    strcat(flags, ",");
+	strcat(flags, "cygdrive");
+	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;
@@ -299,6 +370,8 @@ init_os_extras(void)
     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, "$");
     newXSproto("Cygwin::is_textmount", XS_Cygwin_is_textmount, file, "$");
 
diff --git a/t/lib/cygwin.t b/t/lib/cygwin.t
index 18ada21023..3623f9a0bc 100644
--- a/t/lib/cygwin.t
+++ b/t/lib/cygwin.t
@@ -9,7 +9,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 8;
+use Test::More tests => 14;
 
 is(Cygwin::winpid_to_pid(Cygwin::pid_to_winpid($$)), $$,
    "perl pid translates to itself");
@@ -35,9 +35,27 @@ is(Cygwin::posix_to_win_path("t/lib"), "t\\lib", "posix to win path: t\\lib");
 
 use Win32;
 use Cwd;
-$pwd = getcwd();
+my $pwd = getcwd();
 chdir("/");
-$winpath = Win32::GetCwd();
+my $winpath = Win32::GetCwd();
 is(Cygwin::posix_to_win_path("/", 1), $winpath, "posix to absolute win path");
 chdir($pwd);
 is(Cygwin::win_to_posix_path($winpath, 1), "/", "win to absolute posix path");
+
+my $mount = join '', `/usr/bin/mount`;
+$mount =~ m|on /usr/bin type .+ \((\w+mode)\)|m;
+my $binmode = $1 eq 'binmode';
+is(Cygwin::is_binmount("/"),  $binmode ? 1 : '', "check / for binmount");
+is(Cygwin::is_textmount("/"), $binmode ? '' : 1, "check / for textmount");
+
+my $rootmnt = Cygwin::mount_flags("/");
+ok($binmode ? ($rootmnt =~ /,binmode/) : ($rootmnt =~ /,textmode/), "check / mount_flags");
+is(Cygwin::mount_flags("/cygdrive") =~ /,cygdrive/,  1, "check cygdrive mount_flags");
+
+my @mnttbl = Cygwin::mount_table();
+ok(@mnttbl > 0, "non empty mount_table");
+for $i (@mnttbl) {
+  if ($i->[0] eq '/') {
+    is($i->[2].",".$i->[3], $rootmnt, "same root mount flags");
+  }
+}