fix for Win32::DomainName

Message-ID: <0o9rps458r29eb97h5csuq81b1eip4no33@4ax.com>

p4raw-id: //depot/perl@6705

2 files changed, 71 insertions, 54 deletions

diff --git a/lib/Win32.pod b/lib/Win32.pod
index bd1d06581e..f242eccc2f 100644
--- a/lib/Win32.pod
+++ b/lib/Win32.pod
@@ -43,7 +43,9 @@ yourself.
 =item Win32::DomainName()
 
 [CORE] Returns the name of the Microsoft Network domain that the
-owner of the current perl process is logged into.
+owner of the current perl process is logged into.  This information
+is not available to 32 bit programs on Win 9X.  Therefore this function
+will return C<undef> on these systems.
 
 =item Win32::ExpandEnvironmentStrings(STRING)
 
diff --git a/win32/win32.c b/win32/win32.c
index 687ffe04b8..914ebfd78f 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -3685,65 +3685,80 @@ XS(w32_NodeName)
 static
 XS(w32_DomainName)
 {
+    /*
+     * HOWTO: Retrieve Current User and Domain Names on Windows NT
+     * http://support.microsoft.com/support/kb/articles/Q111/5/44.ASP
+     *
+     * This information is unfortunately unavailable from 32 bit code on
+     * Win9X.  If anyone wants to write a thunking DLL to make the 16 bit
+     * Lan Manager APIs available to Perl, here are some relevant KB articles:
+     *
+     * HOWTO: Retrieve Current User and Domain Names on Windows 95 and Windows 98
+     * http://support.microsoft.com/support/kb/articles/Q155/6/98.ASP
+     *
+     * HOWTO: Call 16-bit Code from 32-bit Code Under Windows 95
+     * http://support.microsoft.com/support/kb/articles/Q155/7/63.ASP
+     */
+
     dXSARGS;
-    HINSTANCE hNetApi32 = LoadLibrary("netapi32.dll");
-    DWORD (__stdcall *pfnNetApiBufferFree)(LPVOID Buffer);
-    DWORD (__stdcall *pfnNetWkstaGetInfo)(LPWSTR servername, DWORD level,
-					  void *bufptr);
 
-    if (hNetApi32) {
-	pfnNetApiBufferFree = (DWORD (__stdcall *)(void *))
-	    GetProcAddress(hNetApi32, "NetApiBufferFree");
-	pfnNetWkstaGetInfo = (DWORD (__stdcall *)(LPWSTR, DWORD, void *))
-	    GetProcAddress(hNetApi32, "NetWkstaGetInfo");
-    }
+    char szUser[256];
+    DWORD cchUser = sizeof(szUser);
+    char szDomain[256];
+    DWORD cchDomain = sizeof(szDomain);
+
+    HANDLE       hToken   = NULL;
+    PTOKEN_USER  ptiUser  = NULL;
+    DWORD        cbti     = 0;
+    SID_NAME_USE snu;
+
     EXTEND(SP,1);
-    if (hNetApi32 && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
-	/* this way is more reliable, in case user has a local account. */
-	char dname[256];
-	DWORD dnamelen = sizeof(dname);
-	struct {
-	    DWORD   wki100_platform_id;
-	    LPWSTR  wki100_computername;
-	    LPWSTR  wki100_langroup;
-	    DWORD   wki100_ver_major;
-	    DWORD   wki100_ver_minor;
-	} *pwi;
-	/* NERR_Success *is* 0*/
-	if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) {
-	    if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
-		WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup,
-				    -1, (LPSTR)dname, dnamelen, NULL, NULL);
-	    }
-	    else {
-		WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername,
-				    -1, (LPSTR)dname, dnamelen, NULL, NULL);
-	    }
-	    pfnNetApiBufferFree(pwi);
-	    FreeLibrary(hNetApi32);
-	    XSRETURN_PV(dname);
-	}
-	FreeLibrary(hNetApi32);
+    ST(0) = &PL_sv_undef;
+
+    // Get the calling thread's access token.
+    if (!OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, TRUE, &hToken)) {
+        if (GetLastError() != ERROR_NO_TOKEN)
+            goto leave;
+        // Retry against process token if no thread token exists.
+        if (!OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hToken))
+            goto leave;
+    }
+
+    // Obtain the size of the user information in the token.
+    if (GetTokenInformation(hToken, TokenUser, NULL, 0, &cbti)) {
+        // Call should have failed due to zero-length buffer.
+        goto leave;
     }
     else {
-	/* Win95 doesn't have NetWksta*(), so do it the old way */
-	char name[256];
-	DWORD size = sizeof(name);
-	if (hNetApi32)
-	    FreeLibrary(hNetApi32);
-	if (GetUserName(name,&size)) {
-	    char sid[ONE_K_BUFSIZE];
-	    DWORD sidlen = sizeof(sid);
-	    char dname[256];
-	    DWORD dnamelen = sizeof(dname);
-	    SID_NAME_USE snu;
-	    if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
-				  dname, &dnamelen, &snu)) {
-		XSRETURN_PV(dname);		/* all that for this */
-	    }
-	}
+        // Call should have failed due to zero-length buffer.
+        if (GetLastError() != ERROR_INSUFFICIENT_BUFFER)
+            goto leave;
     }
-    XSRETURN_UNDEF;
+
+    // Allocate buffer for user information in the token.
+    ptiUser = (PTOKEN_USER) HeapAlloc(GetProcessHeap(), 0, cbti);
+    if (!ptiUser)
+        goto leave;
+
+    // Retrieve the user information from the token.
+    if (!GetTokenInformation(hToken, TokenUser, ptiUser, cbti, &cbti))
+        goto leave;
+
+    // Retrieve user name and domain name based on user's SID.
+    if (!LookupAccountSid(NULL, ptiUser->User.Sid, szUser, &cchUser,
+                          szDomain, &cchDomain, &snu))
+        goto leave;
+
+    ST(0) = sv_2mortal(newSVpvn(szDomain, cchDomain));
+
+ leave:
+    if (hToken)
+        CloseHandle(hToken);
+
+    if (ptiUser)
+        HeapFree(GetProcessHeap(), 0, ptiUser);
+
+    XSRETURN(1);
 }
 
 static