Issue #4: createStone.solo and deleteStone.solo pretty solid

bin/deleteStone.solo

@@ -66,7 +66,7 @@ RwLoadSpecificationV2 {
 ]
 %
 doit
-	| registryClass stonesRegistry toneName stoneSpec |
+	| registryClass stonesRegistry stoneName stoneSpec |
 	self preDoitSpecLoad: [:spec | 
 		spec projectName = 'GsCommands'
 			ifTrue: [ spec projectsHome: '$GEMSTONE/examples/GsCommands/projectsHome' ]
@@ -78,6 +78,8 @@ doit
 	self positionalArgs size ~= 1
 		ifTrue: [ self error: 'Expected a positional argument: <stone-name>' ].
 	stoneName := self positionalArgs at: 1.
-	stonesRegistry destroyStoneNamed: stoneName.
+	stoneSpec := stonesRegistry stoneNamed: stoneName.
+	System gemEnvironmentVariable: 'GEMSTONE' put: stoneSpec gemstonePath.
+	stonesRegistry destroyStoneStructureFor: stoneName.
 	^ stonesRegistry
 %

bin/registryReport.solo

@@ -78,19 +78,6 @@ projectSetReport: projectSetName in: registry
 			ifAbsent: [ self error: 'No file named', projectSetPath , ' found.' ] 
 %
 method
-stoneReport: stoneName in: registry
-	| stonePath |
-	stonePath := registry 
-		stoneNamed: stoneName 
-		ifAbsent: [ 
-			self error: ' No stone named: ', 
-					stoneName, ' found in the registry ', 
-					registry name].
-	^ (self globalNamed: 'GDKAbstractRegistryStore') 
-			fromPath: stonePath
-			ifAbsent: [ self error: 'No file named', stonePath , ' found.' ] 
-%
-method
 templateReport: templateName in: registry
 	| templatePath |
 	templatePath := registry 
@@ -125,7 +112,7 @@ doit
 						ifNil: [ 
 							self stone
 								ifNil: [ ^ stonesRegistry ]
-								ifNotNil: [:stoneName | ^ self stoneReport: stoneName in: stonesRegistry ] ]
+								ifNotNil: [:stoneName | ^ stonesRegistry stoneNamed: stoneName ] ]
 						ifNotNil: [:templateName | ^ self templateReport: templateName in: stonesRegistry ] ]
 				ifNotNil: [:projectSetName | ^ self projectSetReport: projectSetName in: stonesRegistry ] ].
 	self stone ifNotNil: [ self error: 'a --registry is required to list the stone' ].

src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/createStoneStructureUsing..st

@@ -2,10 +2,11 @@ creation/destruction
 createStoneStructureUsing: stonesRegistry
 	"create stone"
 
+	| stoneDirSpec |
 	self rootDir ensureCreateDirectory.
 	stonesRegistry productNamed: self gemstoneVersionString.
-	self
-		stoneDirectorySpec:
-			((GDKAbstractRegistryStore
-				fromPath: (stonesRegistry templateNamed: self stoneDirectorySpecName)
-				ifAbsent: [  ]) createStoneStructure: self)	"populate directory structure"
+	stoneDirSpec := GDKAbstractRegistryStore
+		fromPath: (stonesRegistry templateNamed: self stoneDirectorySpecName)
+		ifAbsent: [  ].
+	stoneDirSpec createStoneStructure: self.	"populate directory structure"
+	self stoneDirectorySpec: stoneDirSpec

src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/destroyStoneStructure.st

@@ -2,8 +2,15 @@ creation/destruction
 destroyStoneStructure
 	"destroy stone structure"
 
-	"need to make sure that stone and netldi are shut down, for now delete stone directory and registry file"
+	"shut down stone BEFORE calling"
 
+	(self waitStone: 1) ~= 3
+		ifTrue: [ 
+			self
+				error:
+					'The stone ' , self stoneName
+						,
+							' is still running. It must be stopped BEFORE destroying the stone structure' ].
 	self rootDir exists
 		ifTrue: [ self rootDir ensureDeleteAll ].
 	self registryFile exists

src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/startStone..st

@@ -1,11 +1,17 @@
 runtime
-startStone: superDoitScript
-	| arrayOfOutputs stoneLogFile |
-	superDoitScript stdout
+startStone: superDoitScriptOrNil
+	| arrayOfOutputs stoneLogFile stdout scriptPath |
+	stdout := superDoitScriptOrNil
+		ifNotNil: [ 
+			scriptPath := superDoitScriptOrNil scriptPath.
+			superDoitScriptOrNil stdout ]
+		ifNil: [ 
+			scriptPath := ''.
+			GsFile stdout ].
+	stdout
 		lf;
 		nextPutAll:
-				'======  ' , superDoitScript scriptPath , ' starting stone at '
-						, DateAndTime now printString;
+				'======  ' , scriptPath , ' starting stone at ' , DateAndTime now printString;
 		lf;
 		lf.
 	self defineCustomEnvVars.
@@ -22,14 +28,14 @@ startStone: superDoitScript
 			stoneLog := stoneLogFile asFileReference.
 			stoneLog exists
 				ifFalse: [ ^ ex pass ].
-			superDoitScript stdout
+			stdout
 				nextPutAll: stoneLog contents;
 				lf.
-			superDoitScript stdout
+			stdout
 				nextPutAll: '****************************************';
 				lf.
-			^ self ].
-	superDoitScript stdout nextPutAll: (arrayOfOutputs at: 1).	"stdout"
-	superDoitScript stdout
+			^ self error: 'Stone did not start' ].
+	stdout nextPutAll: (arrayOfOutputs at: 1).	"stdout"
+	stdout
 		nextPutAll: '****************************************';
 		lf

src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/stopStone..st

@@ -0,0 +1,83 @@
+runtime
+stopStone: superDoitScriptOrNil
+	| exitStatus arrayOfOutputs stdout scriptPath |
+	scriptPath := ''.
+	stdout := superDoitScriptOrNil
+		ifNotNil: [ 
+			scriptPath := superDoitScriptOrNil scriptPath.
+			superDoitScriptOrNil stdout ]
+		ifNil: [ GsFile stdout ].
+	stdout
+		lf;
+		nextPutAll:
+				'======  ' , scriptPath , ' stopping stone at ' , DateAndTime now printString;
+		lf;
+		lf.
+	exitStatus := 0.
+	[ 
+	arrayOfOutputs := (Rowan globalNamed: 'GsStopStone')
+		stopStone: self stoneName
+		userName: self userId
+		password: self password ]
+		on: ChildError
+		do: [ :ex | 
+			" stopstone exit status:
+               * 0 (success) Successful stop
+               * 1 (informational) No running stone with that stonename
+               * 2 (warning)
+               * 3 or above (error) an error occurred and the specified stone was not stopped.
+               * 10 syntax error
+               * 11 bad user or password
+               * 12 specified user does not have privilege to stop the stone.
+               * 13 stone not stopped; other users logged in. Use -i to override."
+			exitStatus := ex status ].
+	exitStatus = 0
+		ifTrue: [ stdout nextPutAll: (arrayOfOutputs at: 1)	"stdout" ]
+		ifFalse: [ 
+			exitStatus = 1
+				ifTrue: [ 
+					stdout
+						nextPutAll: 'No running stone with the name ' , self stoneName printString;
+						lf ]
+				ifFalse: [ 
+					exitStatus = 2
+						ifTrue: [ 
+							stdout
+								nextPutAll: 'warning ';
+								lf ]
+						ifFalse: [ 
+							(exitStatus >= 3 and: [ exitStatus <= 9 ])
+								ifTrue: [ 
+									stdout
+										nextPutAll: 'Stone not stopped';
+										lf ]
+								ifFalse: [ 
+									exitStatus = 10
+										ifTrue: [ 
+											stdout
+												nextPutAll: 'Syntax error. Stone not stopped';
+												lf ]
+										ifFalse: [ 
+											exitStatus = 11
+												ifTrue: [ 
+													stdout
+														nextPutAll: 'Bad user or password. Stone not stopped';
+														lf ]
+												ifFalse: [ 
+													exitStatus = 12
+														ifTrue: [ 
+															stdout
+																nextPutAll:
+																		'Specified user does not have privilege to stop the stone. Stone not stopped';
+																lf ]
+														ifFalse: [ 
+															exitStatus = 13
+																ifTrue: [ 
+																	stdout
+																		nextPutAll:
+																				'other users logged in. Use -i to override Stone not stopped';
+																		lf ] ] ] ] ] ] ].
+			self error: 'Stone not stopped' ].
+	stdout
+		nextPutAll: '****************************************';
+		lf

src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/stopStone.st

@@ -0,0 +1,3 @@
+runtime
+stopStone
+	self stopStone: nil

src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/waitStone..st

@@ -0,0 +1,19 @@
+runtime
+waitStone: timeout
+	"return exit status of waitstone command"
+
+	| exitStatus |
+	exitStatus := 0.
+	[ 
+	(Rowan globalNamed: 'GsWaitStone')
+		waitForStoneName: self stoneName
+		timeout: timeout ]
+		on: ChildError
+		do: [ :ex | 
+			" stopstone exit status:
+        		0 if the server (netldi or stone) is ready,
+        		1 if the server is already already servicing the maximum number of sessions,
+        		2 if the server is rejecting connections during startup or shutdown,
+        		3 if the server was not found."
+			exitStatus := ex status ].
+	^ exitStatus

src/GsDevKit_stones-Core.package/GDKStonesRegistry.class/instance/destroyStoneStructureFor..st

@@ -0,0 +1,20 @@
+stone management
+destroyStoneStructureFor: stoneName
+	| stoneSpec status |
+	stoneSpec := self stoneNamed: stoneName.
+	(stoneSpec waitStone: 1) = 0
+		ifTrue: [ 
+			| count |
+			"if running, stop the stone"
+			stoneSpec stopStone.
+			count := 0.
+			[ (status := stoneSpec waitStone: 1) ~= 3 ]
+				whileTrue: [ 
+					"ensure the stone has shut down, before destroying directory structure"
+					count := count + 1.
+					count > 2
+						ifTrue: [ self error: 'Cannot stop stone' ].
+					Delay waitForSeconds: 1 ] ].
+	stoneSpec destroyStoneStructure.
+	self stones removeKey: stoneName.
+	self export

src/GsDevKit_stones-Core.package/GDKStonesRegistry.class/instance/stoneNamed.ifAbsent..st

@@ -1,3 +1,5 @@
 accessing
 stoneNamed: stoneName ifAbsent: absentBlock
-	^ self stones at: stoneName ifAbsent: absentBlock
+	| stonePath |
+	stonePath := self stones at: stoneName ifAbsent: absentBlock.
+	^ GDKAbstractRegistryStore fromPath: stonePath ifAbsent: absentBlock