[5.005_62 PATCH] support link() on WinNT and NTFS

To: perl5-porters@perl.org, Perl-Win32-Porters@activestate.com
Cc: Douglas Lankshear <dougl@activestate.com>,
        Gurusamy Sarathy <gsar@activestate.com>
Message-ID: <382b5d24.10899522@smtprelay.t-online.de>

p4raw-id: //depot/cfgperl@4571

13 files changed, 139 insertions, 14 deletions

diff --git a/XSUB.h b/XSUB.h
index c2e621cc9a..9eee838083 100644
--- a/XSUB.h
+++ b/XSUB.h
@@ -196,6 +196,7 @@
 #    define fstat		PerlLIO_fstat
 #    define ioctl		PerlLIO_ioctl
 #    define isatty		PerlLIO_isatty
+#    define link                PerlLIO_link
 #    define lseek		PerlLIO_lseek
 #    define lstat		PerlLIO_lstat
 #    define mktemp		PerlLIO_mktemp
diff --git a/iperlsys.h b/iperlsys.h
index d130b739d3..9404d184c8 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -682,6 +682,8 @@ typedef int		(*LPLIOFileStat)(struct IPerlLIO*, int, struct stat*);
 typedef int		(*LPLIOIOCtl)(struct IPerlLIO*, int, unsigned int,
 			    char*);
 typedef int		(*LPLIOIsatty)(struct IPerlLIO*, int);
+typedef int		(*LPLIOLink)(struct IPerlLIO*, const char*,
+				     const char *);
 typedef long		(*LPLIOLseek)(struct IPerlLIO*, int, long, int);
 typedef int		(*LPLIOLstat)(struct IPerlLIO*, const char*,
 			    struct stat*);
@@ -714,6 +716,7 @@ struct IPerlLIO
     LPLIOFileStat	pFileStat;
     LPLIOIOCtl		pIOCtl;
     LPLIOIsatty		pIsatty;
+    LPLIOLink		pLink;
     LPLIOLseek		pLseek;
     LPLIOLstat		pLstat;
     LPLIOMktemp		pMktemp;
@@ -758,6 +761,8 @@ struct IPerlLIOInfo
 	(*PL_LIO->pIOCtl)(PL_LIO, (fd), (u), (buf))
 #define PerlLIO_isatty(fd)						\
 	(*PL_LIO->pIsatty)(PL_LIO, (fd))
+#define PerlLIO_link(oldname, newname)					\
+	(*PL_LIO->pLink)(PL_LIO, (oldname), (newname))
 #define PerlLIO_lseek(fd, offset, mode)					\
 	(*PL_LIO->pLseek)(PL_LIO, (fd), (offset), (mode))
 #define PerlLIO_lstat(name, buf)					\
@@ -800,6 +805,7 @@ struct IPerlLIOInfo
 #define PerlLIO_fstat(fd, buf)		Fstat((fd), (buf))
 #define PerlLIO_ioctl(fd, u, buf)	ioctl((fd), (u), (buf))
 #define PerlLIO_isatty(fd)		isatty((fd))
+#define PerlLIO_link(oldname, newname)	link((oldname), (newname))
 #define PerlLIO_lseek(fd, offset, mode)	lseek((fd), (offset), (mode))
 #define PerlLIO_stat(name, buf)		Stat((name), (buf))
 #ifdef HAS_LSTAT
diff --git a/pp_sys.c b/pp_sys.c
index b7c2cd00f4..e4ec41ef03 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3200,7 +3200,7 @@ PP(pp_link)
     char *tmps2 = POPpx;
     char *tmps = SvPV(TOPs, n_a);
     TAINT_PROPER("link");
-    SETi( link(tmps, tmps2) >= 0 );
+    SETi( PerlLIO_link(tmps, tmps2) >= 0 );
 #else
     DIE(aTHX_ PL_no_func, "Unsupported function link");
 #endif
diff --git a/t/io/fs.t b/t/io/fs.t
index 31929708a4..72e9552037 100755
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -12,6 +12,10 @@ use Config;
 $Is_Dosish = ($^O eq 'MSWin32' or $^O eq 'dos' or
 	      $^O eq 'os2' or $^O eq 'mint');
 
+if (defined &Win32::IsWinNT && Win32::IsWinNT()) {
+    $Is_Dosish = '' if Win32::FsType() eq 'NTFS';
+}
+
 print "1..28\n";
 
 $wd = (($^O eq 'MSWin32') ? `cd` : `pwd`);
@@ -54,28 +58,35 @@ elsif (($mode & 0777) == 0666)
     {print "ok 5\n";} 
 else {print "not ok 5\n";}
 
-if ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
+$newmode = $^O eq 'MSWin32' ? 0444 : 0777;
+if ((chmod $newmode,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('c');
 if ($Is_Dosish) {print "ok 7 # skipped: no link\n";} 
-elsif (($mode & 0777) == 0777) {print "ok 7\n";} 
+elsif (($mode & 0777) == $newmode) {print "ok 7\n";} 
 else {print "not ok 7\n";}
 
+$newmode = 0700;
+if ($^O eq 'MSWin32') {
+    chmod 0444, 'x';
+    $newmode = 0666;
+}
+
 if ($Is_Dosish) {print "ok 8 # skipped: no link\n";} 
-elsif ((chmod 0700,'c','x') == 2) {print "ok 8\n";} 
+elsif ((chmod $newmode,'c','x') == 2) {print "ok 8\n";} 
 else {print "not ok 8\n";}
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('c');
 if ($Is_Dosish) {print "ok 9 # skipped: no link\n";} 
-elsif (($mode & 0777) == 0700) {print "ok 9\n";} 
+elsif (($mode & 0777) == $newmode) {print "ok 9\n";} 
 else {print "not ok 9\n";}
 
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat('x');
 if ($Is_Dosish) {print "ok 10 # skipped: no link\n";} 
-elsif (($mode & 0777) == 0700) {print "ok 10\n";} 
+elsif (($mode & 0777) == $newmode) {print "ok 10\n";} 
 else {print "not ok 10\n";}
 
 if ($Is_Dosish) {print "ok 11 # skipped: no link\n"; unlink 'b','x'; } 
diff --git a/win32/config.bc b/win32/config.bc
index f2b7d392e5..81ec602bac 100644
--- a/win32/config.bc
+++ b/win32/config.bc
@@ -186,7 +186,7 @@ d_isascii='define'
 d_killpg='undef'
 d_ldbl_dig='define'
 d_lchown='undef'
-d_link='undef'
+d_link='define'
 d_locconv='define'
 d_lockf='undef'
 d_longdbl='define'
diff --git a/win32/config.gc b/win32/config.gc
index 7f033dfec1..ac0345f262 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -186,7 +186,7 @@ d_isascii='define'
 d_killpg='undef'
 d_ldbl_dig='define'
 d_lchown='undef'
-d_link='undef'
+d_link='define'
 d_locconv='define'
 d_lockf='undef'
 d_longdbl='define'
diff --git a/win32/config.vc b/win32/config.vc
index 57506f7f69..a294dbcf43 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -186,7 +186,7 @@ d_isascii='define'
 d_killpg='undef'
 d_ldbl_dig='define'
 d_lchown='undef'
-d_link='undef'
+d_link='define'
 d_locconv='define'
 d_lockf='undef'
 d_longdbl='define'
diff --git a/win32/config_H.bc b/win32/config_H.bc
index 1ad81d3fb4..de0fb35bd6 100644
--- a/win32/config_H.bc
+++ b/win32/config_H.bc
@@ -273,7 +273,7 @@
  *	This symbol, if defined, indicates that the link routine is
  *	available to create hard links.
  */
-/*#define HAS_LINK	/**/
+#define HAS_LINK	/**/
 
 /* HAS_LOCALECONV:
  *	This symbol, if defined, indicates that the localeconv routine is
diff --git a/win32/config_H.gc b/win32/config_H.gc
index 0c9f1015b9..cd4efc2a2e 100644
--- a/win32/config_H.gc
+++ b/win32/config_H.gc
@@ -273,7 +273,7 @@
  *	This symbol, if defined, indicates that the link routine is
  *	available to create hard links.
  */
-/*#define HAS_LINK	/**/
+#define HAS_LINK	/**/
 
 /* HAS_LOCALECONV:
  *	This symbol, if defined, indicates that the localeconv routine is
diff --git a/win32/config_H.vc b/win32/config_H.vc
index d914500055..032a9c8cbc 100644
--- a/win32/config_H.vc
+++ b/win32/config_H.vc
@@ -273,7 +273,7 @@
  *	This symbol, if defined, indicates that the link routine is
  *	available to create hard links.
  */
-/*#define HAS_LINK	/**/
+#define HAS_LINK	/**/
 
 /* HAS_LOCALECONV:
  *	This symbol, if defined, indicates that the localeconv routine is
diff --git a/win32/perllib.c b/win32/perllib.c
index 0cf21cb627..22ac61d489 100644
--- a/win32/perllib.c
+++ b/win32/perllib.c
@@ -548,6 +548,12 @@ PerlLIOIsatty(struct IPerlLIO *I, int fd)
     return isatty(fd);
 }
 
+int
+PerlLIOLink(struct IPerlLIO*, const char*oldname, const char *newname)
+{
+    return win32_link(oldname, newname);
+}
+
 long
 PerlLIOLseek(struct IPerlLIO *I, int handle, long offset, int origin)
 {
@@ -652,6 +658,7 @@ struct IPerlLIO perlLIO =
     PerlLIOFileStat,
     PerlLIOIOCtl,
     PerlLIOIsatty,
+    PerlLIOLink,
     PerlLIOLseek,
     PerlLIOLstat,
     PerlLIOMktemp,
diff --git a/win32/win32.c b/win32/win32.c
index 4abb60df66..6566f9a7f4 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -966,6 +966,8 @@ win32_stat(const char *path, struct stat *buffer)
     int		l = strlen(path);
     int		res;
     WCHAR	wbuffer[MAX_PATH];
+    HANDLE      handle;
+    int         nlink = 1;
 
     if (l > 1) {
 	switch(path[l - 1]) {
@@ -987,13 +989,30 @@ win32_stat(const char *path, struct stat *buffer)
 	    break;
 	}
     }
+
+    /* We *must* open & close the file once; otherwise file attribute changes */
+    /* might not yet have propagated to "other" hard links of the same file.  */
+    /* This also gives us an opportunity to determine the number of links.    */
     if (USING_WIDE()) {
 	A2WHELPER(path, wbuffer, sizeof(wbuffer));
-	res = _wstat(wbuffer, (struct _stat *)buffer);
+	handle = CreateFileW(wbuffer, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
     }
     else {
-	res = stat(path, buffer);
+	handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
     }
+    if (handle != INVALID_HANDLE_VALUE) {
+	BY_HANDLE_FILE_INFORMATION bhi;
+	if (GetFileInformationByHandle(handle, &bhi))
+	    nlink = bhi.nNumberOfLinks;
+	CloseHandle(handle);
+    }
+
+    if (USING_WIDE())
+	res = _wstat(wbuffer, (struct _stat *)buffer);
+    else
+	res = stat(path, buffer);
+    buffer->st_nlink = nlink;
+
     if (res < 0) {
 	/* CRT is buggy on sharenames, so make sure it really isn't.
 	 * XXX using GetFileAttributesEx() will enable us to set
@@ -2154,6 +2173,85 @@ win32_pclose(FILE *pf)
 #endif /* USE_RTL_POPEN */
 }
 
+static BOOL WINAPI
+Nt4CreateHardLinkW(
+    LPCWSTR lpFileName,
+    LPCWSTR lpExistingFileName,
+    LPSECURITY_ATTRIBUTES lpSecurityAttributes)
+{
+    HANDLE handle;
+    WCHAR wFullName[MAX_PATH+1];
+    LPVOID lpContext = NULL;
+    WIN32_STREAM_ID StreamId;
+    DWORD dwSize = (char*)&StreamId.cStreamName - (char*)&StreamId;
+    DWORD dwWritten;
+    DWORD dwLen;
+    BOOL bSuccess;
+
+    BOOL (__stdcall *pfnBackupWrite)(HANDLE, LPBYTE, DWORD, LPDWORD,
+				     BOOL, BOOL, LPVOID*) =
+	(BOOL (__stdcall *)(HANDLE, LPBYTE, DWORD, LPDWORD,
+			    BOOL, BOOL, LPVOID*))
+	GetProcAddress(GetModuleHandle("kernel32.dll"), "BackupWrite");
+    if (pfnBackupWrite == NULL)
+	return 0;
+
+    dwLen = GetFullPathNameW(lpFileName, MAX_PATH, wFullName, NULL);
+    if (dwLen == 0)
+	return 0;
+    dwLen = (dwLen+1)*sizeof(WCHAR);
+
+    handle = CreateFileW(lpExistingFileName, FILE_WRITE_ATTRIBUTES,
+			 FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
+			 NULL, OPEN_EXISTING, 0, NULL);
+    if (handle == INVALID_HANDLE_VALUE)
+	return 0;
+
+    StreamId.dwStreamId = BACKUP_LINK;
+    StreamId.dwStreamAttributes = 0;
+    StreamId.dwStreamNameSize = 0;
+    StreamId.Size.HighPart = 0;
+    StreamId.Size.LowPart = dwLen;
+
+    bSuccess = pfnBackupWrite(handle, (LPBYTE)&StreamId, dwSize, &dwWritten,
+			      FALSE, FALSE, &lpContext);
+    if (bSuccess) {
+	bSuccess = pfnBackupWrite(handle, (LPBYTE)wFullName, dwLen, &dwWritten,
+				  FALSE, FALSE, &lpContext);
+	pfnBackupWrite(handle, NULL, 0, &dwWritten, TRUE, FALSE, &lpContext);
+    }
+
+    CloseHandle(handle);
+    return bSuccess;
+}
+
+DllExport int
+win32_link(const char *oldname, const char *newname)
+{
+    dTHXo;
+    BOOL (__stdcall *pfnCreateHardLinkW)(LPCWSTR,LPCWSTR,LPSECURITY_ATTRIBUTES);
+    WCHAR wOldName[MAX_PATH];
+    WCHAR wNewName[MAX_PATH];
+
+    if (IsWin95())
+	Perl_die(aTHX_ PL_no_func, "link");
+
+    pfnCreateHardLinkW =
+	(BOOL (__stdcall *)(LPCWSTR, LPCWSTR, LPSECURITY_ATTRIBUTES))
+	GetProcAddress(GetModuleHandle("kernel32.dll"), "CreateHardLinkW");
+    if (pfnCreateHardLinkW == NULL)
+	pfnCreateHardLinkW = Nt4CreateHardLinkW;
+
+    if ((A2WHELPER(oldname, wOldName, sizeof(wOldName))) &&
+	(A2WHELPER(newname, wNewName, sizeof(wNewName))) &&
+	pfnCreateHardLinkW(wNewName, wOldName, NULL))
+    {
+	return 0;
+    }
+    errno = (GetLastError() == ERROR_FILE_NOT_FOUND) ? ENOENT : EINVAL;
+    return -1;
+}
+
 DllExport int
 win32_rename(const char *oname, const char *newname)
 {
diff --git a/win32/win32iop.h b/win32/win32iop.h
index e23000bc60..566ed57d51 100644
--- a/win32/win32iop.h
+++ b/win32/win32iop.h
@@ -131,6 +131,7 @@ DllExport  unsigned 	win32_alarm(unsigned int sec);
 DllExport  int		win32_stat(const char *path, struct stat *buf);
 DllExport  char*	win32_longpath(char *path);
 DllExport  int		win32_ioctl(int i, unsigned int u, char *data);
+DllExport  int          win32_link(const char *oldname, const char *newname);
 DllExport  int		win32_utime(const char *f, struct utimbuf *t);
 DllExport  int		win32_uname(struct utsname *n);
 DllExport  int		win32_wait(int *status);
@@ -271,6 +272,7 @@ END_EXTERN_C
 #define times			win32_times
 #define alarm			win32_alarm
 #define ioctl			win32_ioctl
+#define link			win32_link
 #define utime			win32_utime
 #define uname			win32_uname
 #define wait			win32_wait