Add unit tests for DP API protect/unprotect (#314)

Core/Object Arts/Dolphin/Base/BootSessionManager.cls

@@ -136,7 +136,7 @@ reloadSystemPackage
 		collect: [:each | srcMgr fileIn: (File relativePathOf: each value fileOutName to: imageDir)].
 	Notification signal: 'Updating ClassBuilder...'.
 	self fileInClass: ClassBuilder.
-	classesBefore := Object withAllSubclasses.
+	classesBefore := basePackage classes.
 	Notification signal: 'Reloading BCL class definitions...'.
 	srcMgr fileIn: (File relativePathOf: basePackage classDefinitionsFileName to: imageDir).
 	Class subclasses: nil.

Core/Object Arts/Dolphin/Base/ExternalArray.cls

@@ -466,13 +466,11 @@ fromAddress: anAddress length: anInteger
 	Implementation Note: If the length is zero, then we ignore the address (even if invalid).
 	If the length is non-zero then we answer nil if the address is the Null pointer."
 
-	^anInteger == 0 
-		ifTrue: [self basicNew basicLength: 0]
-		ifFalse: [
-			anAddress isNull ifFalse: [
-				self basicNew
-					initializeAtAddress: anAddress;
-					basicLength: anInteger]]!
+	^anAddress isNull
+		ifFalse: 
+			[(self basicNew)
+				initializeAtAddress: anAddress;
+				basicLength: anInteger]!
 
 icon
 	"Answers an Icon that can be used to represent this class"

Core/Object Arts/Dolphin/Base/Win32Errors.st

@@ -18,6 +18,7 @@ Win32Errors at: 'E_UNEXPECTED' put: -16r7FFF0001!
 Win32Errors at: 'ERROR_ACCESS_DENIED' put: 16r5!
 Win32Errors at: 'ERROR_ALREADY_EXISTS' put: 16rB7!
 Win32Errors at: 'ERROR_FILE_NOT_FOUND' put: 16r2!
+Win32Errors at: 'ERROR_INVALID_DATA' put: 16rD!
 Win32Errors at: 'ERROR_INVALID_HANDLE' put: 16r6!
 Win32Errors at: 'ERROR_INVALID_NAME' put: 16r7B!
 Win32Errors at: 'ERROR_MORE_DATA' put: 16rEA!

Core/Object Arts/Dolphin/IDE/Base/VMTest.cls

@@ -1416,6 +1416,23 @@ testPrimitiveSubtract
 			self assert: result class == expected class.
 			self assert: expected equals: result]!
 
+testPrimitiveYourAddress
+	| method |
+	method := self createPrimitiveMethodLike: Object >> #yourAddress setsFailCode: false.
+	#('' 'abc') do: 
+			[:each || addr |
+			addr := method value: each withArguments: #().
+			self deny: addr == 0.
+			self assert: (String fromAddress: each) equals: each].
+	"Bug: #yourAddress returns 0 for an empty byte array?"
+	#(#[]#[1 2 3]) do: 
+			[:each || addr |
+			addr := method value: each withArguments: #().
+			self deny: addr == 0.
+			self assert: (ByteArray fromAddress: addr length: each size) equals: each].
+	self assert: 0 equals: (method value: nil withArguments: #()).
+!
+
 testSignedFromUnsigned
 	"Test SmallIntegers and 4 & 8 byte LargeIntegers"
 
@@ -1549,6 +1566,7 @@ testWeakMournerNotifications
 !VMTest categoriesFor: #testPrimitiveStringAtPut!public!unit tests! !
 !VMTest categoriesFor: #testPrimitiveStringCmp!public!unit tests! !
 !VMTest categoriesFor: #testPrimitiveSubtract!public!unit tests! !
+!VMTest categoriesFor: #testPrimitiveYourAddress!public!unit tests! !
 !VMTest categoriesFor: #testSignedFromUnsigned!public!unit tests! !
 !VMTest categoriesFor: #testVMPointersImmutable!public!unit tests! !
 !VMTest categoriesFor: #testWeakMournerNotifications!public!unit tests! !

Core/Object Arts/Dolphin/Installation Manager/DolphinProfessional.cls

@@ -38,7 +38,11 @@ contents
 		add: #('Core\Object Arts\Dolphin\Lagoon\Lagoon Image Stripper.pax' #encrypted #imageBased);
 		add: #('Core\Object Arts\Dolphin\Lagoon\Application Deployment Kit.pax' #encrypted #imageBased);
 		add: #('Core\Object Arts\Dolphin\Lagoon\ActiveX DLL Server Kit.pax' #encrypted #imageBased);
-		addAll: #(#('Core\Object Arts\Dolphin\System\Win32\Dolphin File System Watcher.pax' #encrypted #imageBased) #('Core\Object Arts\Dolphin\System\Win32\Dolphin Memory-Mapped Files.pax' #encrypted #imageBased) #('Core\Object Arts\Dolphin\System\Win32\Dolphin Overlapped IO.pax' #encrypted #imageBased) #('Core\Object Arts\Dolphin\System\Win32\Windows HTTP Server.pax' #encrypted #imageBased));
+		add: #('Core\Object Arts\Dolphin\System\Win32\Dolphin File System Watcher.pax' #encrypted #imageBased);
+		add: #('Core\Object Arts\Dolphin\System\Win32\Dolphin Memory-Mapped Files.pax' #encrypted #imageBased);
+		add: #('Core\Object Arts\Dolphin\System\Win32\Dolphin Overlapped IO.pax' #encrypted #imageBased);
+		add: #('Core\Object Arts\Dolphin\System\Win32\Windows HTTP Server.pax' #encrypted #imageBased);
+		add: #('Core\Object Arts\Dolphin\System\Win32\Windows Data Protection API.pax' #encrypted #imageBased);
 		add: #('Core\Object Arts\Dolphin\ActiveX\Property Bags\ActiveX Property Bags.pax' #encrypted #imageBased);
 		addAll: #(#('Core\Object Arts\Dolphin\MVP\Metafiles\Dolphin Metafile Records.pax' #encrypted #imageBased) #('Core\Object Arts\Dolphin\MVP\Metafiles\Dolphin Metafiles.pax' #encrypted #imageBased));
 		add: #('Core\Object Arts\Dolphin\Utilities\Tutorials\Tutorial Player.pax' #encrypted #imageBased);

Core/Object Arts/Dolphin/System/Win32/Crypt32Library.cls

@@ -12,64 +12,6 @@ The type library contains the following helpstring for this module
 	"Crypto API"
 
 Warning: This comment was automatically generated from the module''s type information, but any changes made here will not be overwritten if the wrapper class is regenerated.
-
-IDL definition follows:
-
-[
-	dllname("Crypt32.dll"), 
-	uuid(02c78993-ba10-47a1-953f-63f60b7693ab), 
-	helpstring("Crypto API")
-]
-module Crypt32
-{
-	const unsigned long CRYPTPROTECT_PROMPT_ON_UNPROTECT = 1;
-	const unsigned long CRYPTPROTECT_PROMPT_ON_PROTECT = 2;
-	const unsigned long CRYPTPROTECT_PROMPT_RESERVED = 4;
-	const unsigned long CRYPTPROTECT_PROMPT_STRONG = 8;
-	const unsigned long CRYPTPROTECT_PROMPT_REQUIRE_STRONG = 16;
-	const unsigned long CRYPTPROTECT_UI_FORBIDDEN = 1;
-	const unsigned long CRYPTPROTECT_LOCAL_MACHINE = 4;
-	const unsigned long CRYPTPROTECT_CRED_SYNC = 8;
-	const unsigned long CRYPTPROTECT_AUDIT = 16;
-	const unsigned long CRYPTPROTECT_NO_RECOVERY = 32;
-	const unsigned long CRYPTPROTECT_VERIFY_PROTECTION = 64;
-	const unsigned long CRYPTPROTECT_CRED_REGENERATE = 128;
-	const unsigned long CRYPTPROTECT_FIRST_RESERVED_FLAGVAL = 268435455;
-	const unsigned long CRYPTPROTECT_LAST_RESERVED_FLAGVAL = 4294967295;
-	const unsigned long CRYPTPROTECTMEMORY_BLOCK_SIZE = 16;
-	const unsigned long CRYPTPROTECTMEMORY_SAME_PROCESS = 0;
-	const unsigned long CRYPTPROTECTMEMORY_CROSS_PROCESS = 1;
-	const unsigned long CRYPTPROTECTMEMORY_SAME_LOGON = 2;
-
-	[entry(0x60000000)]
-	BOOL __stdcall CryptProtectData(
-		DATA_BLOB* pDataIn,
-		LPCWSTR szDataDescr,
-		DATA_BLOB* pOptionalEntropy,
-		void* pvReserved,
-		CRYPTPROTECT_PROMPTSTRUCT* pPromptStruct,
-		unsigned long dwFlags,
-		DATA_BLOB* pDataOut);
-	[entry(0x60000001)]
-	BOOL __stdcall CryptUnprotectData(
-		DATA_BLOB* pDataIn,
-		LPWSTR* ppszDataDescr,
-		DATA_BLOB* pOptionalEntropy,
-		void* pvReserved,
-		CRYPTPROTECT_PROMPTSTRUCT* pPromptStruct,
-		unsigned long dwFlags,
-		DATA_BLOB* pDataOut);
-	[entry(0x60000002)]
-	BOOL __stdcall CryptProtectMemory(
-		LPVOID pDataIn,
-		unsigned long cbDataIn,
-		unsigned long dwFlags);
-	[entry(0x60000003)]
-	BOOL __stdcall CryptUnprotectMemory(
-		LPVOID pDataIn,
-		unsigned long cbDataIn,
-		unsigned long dwFlags);
-};
 '!
 !Crypt32Library categoriesForClass!Win32-Modules! !
 !Crypt32Library methodsFor!
@@ -133,9 +75,11 @@ cryptUnprotectMemory: pDataIn cbDataIn: cbDataIn dwFlags: dwFlags
 !Crypt32Library class methodsFor!
 
 example1
-	| encrypted decrypted |
-	encrypted := self protectData: 'Hello world'.
-	decrypted := self unprotectData: encrypted!
+	| encrypted decrypted original |
+	original := 'Hello world'.
+	encrypted := self protectData: original.
+	decrypted := self unprotectData: encrypted.
+	self assert: [decrypted = original]!
 
 fileName
 	"Answer the host system file name for the library."
@@ -159,30 +103,33 @@ protectData: aByteObject additionalEntropy: aByteArrayOrNil
 		additionalEntropy: aByteArrayOrNil
 		machineWide: false!
 
-protectData: aByteObject additionalEntropy: aByteArray machineWide: aBoolean
+protectData: aByteObject additionalEntropy: aByteArrayOrNil machineWide: aBoolean
 	"Answer an encrypted representation of the data in the byte object argument, aByteObject.
 	Additional entropy to increase the complexity of the encryption can be specified by
-	providing a suitable <ByteArray> argument.. The encrypted data is usually associated with
-	the current user, but passing true as the <Boolean> argument will yield data associated with
-	the machine context that can subsequently be decrypted by any process running for any
-	principal. Machine-wide protection is normally only appropriate for service applications not
-	running for a specific user."
+	providing a suitable <ByteArray> as the second argument. The encrypted data is usually
+	associated with the current user, but passing true as the <Boolean> argument will yield data
+	associated with the machine context that can subsequently be decrypted by *any* process
+	running for any principal. Machine-wide protection is normally only appropriate for service
+	applications not running for a specific user."
 
-	| unencrypted encrypted flags description answer |
+	| unencrypted encrypted flags description answer entropy |
 	unencrypted := CRYPTOAPI_BLOB fromBytes: aByteObject.
 	encrypted := CRYPTOAPI_BLOB new.
 	flags := WinCryptConstants.CRYPTPROTECT_UI_FORBIDDEN.
 	aBoolean ifTrue: [flags := flags | WinCryptConstants.CRYPTPROTECT_LOCAL_MACHINE].
 	description := aByteObject class name asUnicodeString.
+	entropy := aByteArrayOrNil ifNotNil: [CRYPTOAPI_BLOB fromBytes: aByteArrayOrNil].
 	(self default
 		cryptProtectData: unencrypted
 		szDataDescr: description
-		pOptionalEntropy: aByteArray
+		pOptionalEntropy: entropy
 		pvReserved: nil
 		pPromptStruct: nil
 		dwFlags: flags
 		pDataOut: encrypted) ifFalse: [^Win32Error signal].
 	answer := encrypted data copy.
+	"The encrypted data is allocated by the API function using LocalAlloc, so free it now to
+	avoid generating finalizable garbage"
 	encrypted free.
 	^answer!
 
@@ -203,37 +150,39 @@ unprotectData: dataByteArray additionalEntropy: aByteArrayOrNil
 		additionalEntropy: aByteArrayOrNil
 		machineWide: false!
 
-unprotectData: aByteObject additionalEntropy: aByteArray machineWide: aBoolean
-	"Decrypt the protected data in the <ByteArray> argument, dataByteArray.
-	Additional entropy to increase the complexity of the encryption can be specified by
-	providing a suitable <ByteArray> argument.. The encrypted data is usually associated with
-	the current user, but passing true as the <Boolean> argument will yield data associated with
-	the machine context that can subsequently be decrypted by any process running for any
-	principal. Machine-wide protection is normally only appropriate for service applications not
-	running for a specific user."
-
-	| unencrypted encrypted flags description answer dataClass |
+unprotectData: aByteObject additionalEntropy: aByteArrayOrNil machineWide: aBoolean
+	"Decrypt the protected data in the byte object argument, aByteObject, answering the
+	decrypted data as an instance of the same class as that of the original data. Additional
+	entropy to increase the complexity of the encryption can be specified by providing a
+	suitable <ByteArray> argument. The encrypted data is usually associated with the current
+	user, but passing true as the <Boolean> argument will yield data associated with the machine
+	context that can subsequently be decrypted by *any* process running for any user.
+	Machine-wide protection is, therefore, normally only appropriate for service applications
+	not running for a specific user."
+
+	| unencrypted encrypted flags description answer dataClass entropy size |
 	encrypted := CRYPTOAPI_BLOB fromBytes: aByteObject.
 	unencrypted := CRYPTOAPI_BLOB new.
 	flags := WinCryptConstants.CRYPTPROTECT_UI_FORBIDDEN.
 	aBoolean ifTrue: [flags := flags | WinCryptConstants.CRYPTPROTECT_LOCAL_MACHINE].
 	description := aByteObject class name asUnicodeString.
 	description := ExternalAddress new.
+	entropy := aByteArrayOrNil ifNotNil: [CRYPTOAPI_BLOB fromBytes: aByteArrayOrNil].
 	(self default
 		cryptUnprotectData: encrypted
 		ppszDataDescr: description
-		pOptionalEntropy: aByteArray
+		pOptionalEntropy: entropy
 		pvReserved: nil
 		pPromptStruct: nil
 		dwFlags: flags
 		pDataOut: unencrypted) ifFalse: [^Win32Error signal].
 	description := UnicodeString fromAddress: description.
 	dataClass := Smalltalk at: description asString ifAbsent: [ByteArray].
-	answer := unencrypted data.
-	answer := answer
+	size := unencrypted cbData.
+	answer := unencrypted data
 				copy: dataClass
 				from: 1
-				to: answer byteSize.
+				to: size.
 	unencrypted free.
 	^answer! !
 !Crypt32Library class categoriesFor: #example1!examples!must strip!public! !

Core/Object Arts/Dolphin/System/Win32/DpApiTest.cls

@@ -0,0 +1,41 @@
+"Filed out from Dolphin Smalltalk 7"!
+
+DolphinTest subclass: #DpApiTest
+	instanceVariableNames: ''
+	classVariableNames: ''
+	poolDictionaries: ''
+	classInstanceVariableNames: ''!
+DpApiTest guid: (GUID fromString: '{9165806D-C1A3-45E6-BF08-54EA3A21B04C}')!
+DpApiTest comment: ''!
+!DpApiTest categoriesForClass!Unclassified! !
+!DpApiTest methodsFor!
+
+testProtectUnprotectData
+	#('' 'a' 'abc' #[] #[0] #[128 255 1]) do: [:each | self verifyRoundTrip: each]!
+
+verifyRoundTrip: aByteObject
+	| entropy decrypted encryptedExtra encrypted |
+	entropy := #[1 2 3 4].
+	encrypted := Crypt32Library protectData: aByteObject.
+	encryptedExtra := Crypt32Library protectData: aByteObject additionalEntropy: entropy.
+	decrypted := Crypt32Library unprotectData: encrypted.
+	self assert: aByteObject equals: decrypted.
+	"Unprotect with entropy not used on protect should fail."
+	self
+		should: [Crypt32Library unprotectData: encryptedExtra]
+		raise: Win32Error
+		matching: [:ex | ex tag statusCode = Win32Errors.ERROR_INVALID_DATA].
+	decrypted := Crypt32Library unprotectData: encryptedExtra additionalEntropy: entropy.
+	self assert: aByteObject equals: decrypted.
+	"Unprotect without entropy used on protect should fail."
+	self
+		should: [Crypt32Library unprotectData: encryptedExtra]
+		raise: Win32Error
+		matching: [:ex | ex tag statusCode = Win32Errors.ERROR_INVALID_DATA].
+	self
+		should: [Crypt32Library unprotectData: encryptedExtra additionalEntropy: #[4 5 6]]
+		raise: Win32Error
+		matching: [:ex | ex tag statusCode = Win32Errors.ERROR_INVALID_DATA]! !
+!DpApiTest categoriesFor: #testProtectUnprotectData!public!unit tests! !
+!DpApiTest categoriesFor: #verifyRoundTrip:!helpers!private! !
+

Core/Object Arts/Dolphin/System/Win32/Windows Data Protection API Tests.pax

@@ -0,0 +1,39 @@
+| package |
+package := Package name: 'Windows Data Protection API Tests'.
+package paxVersion: 1;
+	basicComment: ''.
+
+
+package classNames
+	add: #DpApiTest;
+	yourself.
+
+package binaryGlobalNames: (Set new
+	yourself).
+
+package globalAliases: (Set new
+	yourself).
+
+package setPrerequisites: (IdentitySet new
+	add: '..\..\Base\Dolphin';
+	add: '..\..\Base\Dolphin Base Tests';
+	add: 'Windows Data Protection API';
+	yourself).
+
+package!
+
+"Class Definitions"!
+
+DolphinTest subclass: #DpApiTest
+	instanceVariableNames: ''
+	classVariableNames: ''
+	poolDictionaries: ''
+	classInstanceVariableNames: ''!
+
+"Global Aliases"!
+
+
+"Loose Methods"!
+
+"End of package definition"!
+

Core/Object Arts/Dolphin/System/Win32/Windows Data Protection API.pax

@@ -3,7 +3,11 @@ package := Package name: 'Windows Data Protection API'.
 package paxVersion: 1;
 	basicComment: 'Dolphin Smalltalk Win32 Data Protection API
 
-This package contains classes and methods for using the Windows Data Protection API (aka DP API)'.
+This package contains classes and methods for using the Windows Data Protection API (aka DP API).
+
+The API is very simple to use - see Crypt32Library class>>#example1.
+
+Note that care should be taken to prevent unencrypted secrets persisting in the Dolphin object memory. Even after an object has been GC''d, its content may remain in the object heap for some indeterminate time. This means that the secret may be visible to any code running within the process, or in a memory dump. To minimize the time that unencrypted secrets are present in memory associated objects should be zero''d out before they go out of scope.'.
 
 
 package classNames

FetchVM.ps1

@@ -4,7 +4,7 @@
 
 param 
 (
-    [string]$VMversion="v7.0.38"
+    [string]$VMversion="v7.0.39"
 )
 
 Try 

PreBoot.st

@@ -87,3 +87,16 @@ Behavior addClassConstant: '_NullMethodDictionary'
 ExternalCallback class removeSelector: #initialize!
 #(always caseInsensitive equality identity never uninitialize) do: [:each | SearchPolicy class removeSelector: each]!
 #(current uninitialize) do: [:each | SymbolStringSearchPolicy class removeSelector: each. AssociationSearchPolicy class removeSelector: each]!
+
+ExternalArray subclass: #BYTEArray
+	instanceVariableNames: ''
+	classVariableNames: ''
+	poolDictionaries: ''
+	classInstanceVariableNames: ''!
+
+!BYTEArray class methodsFor!
+
+fileOutStem
+	^super fileOutStem, '_struct'! !
+!BYTEArray class categoriesFor: #fileOutStem!development!private!source filing! !
+

RegressionTestsLoad.st

@@ -6,6 +6,7 @@ Package manager
 	install: 'Core\Object Arts\Dolphin\MVP\Gdiplus\Tests\Gdiplus Tests.pax';
 	install: 'Core\Contributions\Camp Smalltalk\SUnit\SUnitTests.pax';
 	install: 'Core\Object Arts\Dolphin\System\Win32\Dolphin MMF Tests.pax';
+	install: 'Core\Object Arts\Dolphin\System\Win32\Windows Data Protection API Tests.pax';
 	install: 'Core\Object Arts\Dolphin\IDE\Base\Development System Tests.pax';
 	install: 'Core\Object Arts\Dolphin\MVP\Dolphin MVP Tests.pax';
 	install: 'Core\Object Arts\Dolphin\IDE\Dolphin IDE Tests.pax';