I realized that work on issue_321_xxx branch contained modifications …

…to superdoit_devkit for early work on #321, so I'm starting over with the latest issue_260_2021 and restoring relevant files from issue_321_xxx branch ... keeping my promist to leave superdoit_devkit untouched
GsDevKit · Aug 18, 2021 · 395b786 · 395b786
1 parent 96b844a
commit 395b786
Show file tree

Hide file tree

Showing 358 changed files with 3,566 additions and 0 deletions.
diff --git a/shared/gemstone/bin/contexttest b/shared/gemstone/bin/contexttest
@@ -0,0 +1,35 @@
+#!/usr/bin/env superdoit_solo
+instvars
+%
+usage
+-----
+USAGE $basename [--help | -h] [stoneName]
+
+DESCRIPTION
+  Script to test working with environments and stone contexts (groups of environment variables)
+
+OPTIONS
+  -h, --help 		display usage message
+	--debug		display debugging messages
+
+EXAMPLES
+  $basename --help
+  $basename --debug myStone
+-----
+%
+method
+testContext
+	self stderr nextPutAll: 'PWD: ', (System gemEnvironmentVariable: 'PWD') asString; cr.
+%
+method
+stoneContext
+
+%
+method
+findLocalStone
+	"Search from PWD up through the directory tree to find info.stone"
+%
+doit
+	self testContext.
+	self noResult
+%
diff --git a/shared/gemstone/bin/newextent b/shared/gemstone/bin/newextent
@@ -0,0 +1,109 @@
+#!/usr/bin/env superdoit_solo
+instvars
+	gsListResult
+%
+usage
+-----
+USAGE $basename stone-name [snapshot-file] [mime-type]
+
+DESCRIPTION
+	Copy a new extent to the stones extent directory
+
+OPTIONS
+  -h, --help 		display usage message
+
+EXAMPLES
+  $basename --help
+  $basename myStone
+  $basename myStone /opt/snapshots/mySnapshop.dbf
+  $basename myStone /opt/snapshots/mySnapshot.dbf.gz x-gzip
+-----
+%
+method
+newExtent
+	| stream stoneDirectory extentFile |
+	stream := self stderr.
+	self positionalArgs size == 0 ifTrue: [
+		^ Error signal: 'Wrong number of arguments (' , self positionalArgs size printString , ')' ].
+		stoneDirectory := self gs_stoneDirectory.
+		extentFile := stoneDirectory / 'extents' / 'extent0.dbf'.
+		extentFile exists
+			ifTrue: [ extentFile delete ].
+		self mediaType = 'x-gzip'
+			ifTrue: [ self gunzipSnapshotExtent: stoneDirectory ]
+			ifFalse: [ self copySnapshotExtent: stoneDirectory ].
+
+	^ self noResult
+%
+method
+mediaType
+	self positionalArgs size < 3 ifTrue: [ ^ 'octet-stream' ].
+	^ self positionalArgs at: 3
+%
+method
+copySnapshotExtent: stoneDirectory
+	"use copydbf, so that any corruption in the extent file can be found at the outset"
+
+	self copySnapshotExtent: self snapshotFile to: stoneDirectory for: self gsVers
+%
+method
+copySnapshotExtent: snapshotExtentFile to: stoneDirectory for: aGsVersionString
+	"use copydbf, so that any corruption in the extent file can be found at the outset"
+
+	| extentFile argsArray cmdPath |
+	self stderr nextPutAll: ('Copying extent file: ' , snapshotExtentFile pathString printString); cr.
+	extentFile := stoneDirectory / 'extents' / 'extent0.dbf'.
+	cmdPath := (aGsVersionString beginsWith: '2.4')
+		ifTrue: [
+			"cannot use copydbf to copy extent from product tree, so unconditionally use `cp`"
+			'/bin/cp' ]
+		ifFalse: [ (self gemstoneBin / 'copydbf') pathString ].
+	argsArray := {(snapshotExtentFile pathString). (extentFile pathString)}.
+	self stderr nextPutAll: (self runShellCommand: cmdPath args: argsArray); cr.
+	OSProcess command: 'chmod +w "' , extentFile pathString, '"'
+%
+method
+gs_stonesDirectory
+	^  ((System gemEnvironmentVariable: 'GS_HOME'), '/server/stones') asFileReference
+%
+method
+gs_stoneDirectory
+	^  self gs_stonesDirectory / self stoneName
+%
+method
+stoneName
+	^ self positionalArgs at: 1
+%
+method
+stoneInfoFilename
+	^  'info.ston'
+%
+method
+gs_binDirectory
+	^ (System gemEnvironmentVariable: 'GEMSTONE'), '/bin/'
+%
+method
+gsListResult
+	^ gsListResult ifNil: [ gsListResult := GsHostProcess execute: self gs_binDirectory, 'gslist -lc' ]
+%
+method
+doit
+	"override doit method, because ChildError does not exist in 3.6.0" 
+	[ 
+	self getAndVerifyOptions == self noResult
+		ifTrue: [ ^ self noResult ].
+	^ self theDoit
+	]
+		on: Error
+		do: [ :ex | 
+			((self respondsTo: #'debug') and: [ self debug ])
+				ifTrue: [ ex pass ].
+			self
+				exit: ((ex respondsTo: #stderr)
+					ifTrue: [ ex stderr asString trimBoth ]
+					ifFalse: [ ex messageText ])
+				withStatus: 1 "does not return" ].
+%
+doit
+	self newExtent
+%
diff --git a/shared/gemstone/bin/products b/shared/gemstone/bin/products
@@ -0,0 +1,69 @@
+#!/usr/bin/env superdoit_solo
+instvars
+	installedProducts
+%
+usage
+-----
+USAGE $basename [--help | -h]
+
+DESCRIPTION
+  Provide information on the downloaded GemStone versions.
+
+OPTIONS
+  -h, --help 		display usage message
+
+EXAMPLES
+  $basename --help
+  $basename
+-----
+%
+method
+produceProductsReport
+	| stream |
+	stream := self stderr.
+	self installedProductsReportOn: stream
+%
+method
+installedProductsReportOn: stream
+	stream
+		nextPutAll: 'Installed Products:';
+		cr.
+	self installedProducts keys asSortedCollection
+		do: [ :gsVers |
+			stream
+				tab;
+				nextPutAll: gsVers;
+				cr ]
+%
+method
+installedProducts
+	installedProducts
+		ifNil: [
+			installedProducts := Dictionary new.
+			self gs_productsDirectory directories
+				do: [ :productDir |
+					| dirName |
+					dirName := productDir basename.
+					(dirName indexOfSubCollection: 'GemStone64Bit') == 1
+						ifTrue: [
+							| productVersion dashIndex |
+							dashIndex := dirName indexOf: $-.
+							productVersion := dirName copyFrom: 'GemStone64Bit' size + 1 to: dashIndex - 1.
+							installedProducts at: productVersion put: productDir ]
+						ifFalse: [
+							(dirName indexOfSubCollection: 'GemBuilderC') == 1
+								ifTrue: [
+									| productVersion dashIndex |
+									dashIndex := dirName indexOf: $-.
+									productVersion := dirName copyFrom: 'GemBuilderC' size + 1 to: dashIndex - 1.
+									installedProducts at: productVersion put: productDir ] ] ] ].
+	^ installedProducts
+%
+method
+gs_productsDirectory
+	^  ((System gemEnvironmentVariable: 'GS_HOME'), '/shared/downloads/products') asFileReference
+%
+doit
+	self produceProductsReport.
+	^ self noResult
+%
diff --git a/shared/gemstone/bin/restartnetldi b/shared/gemstone/bin/restartnetldi
@@ -0,0 +1,173 @@
+#!/usr/bin/env superdoit_solo
+instvars
+%
+usage
+-----
+USAGE: restartnetldi [-h] <stone-name>
+
+DESCRIPTION
+Restart a running netldi process.
+
+OPTIONS
+  -h, --help 	display usage message
+
+EXAMPLES
+  $basename -h
+  $basename myStoneName
+-----
+%
+projectshome
+$GS_HOME/shared/gemstone/repos
+%
+specs
+[
+RwLoadSpecificationV2 {
+	#specName : 'GsDevKit_SuperDoit',
+	#projectName : 'GsDevKit_SuperDoit',
+	#diskUrl : 'file:$GS_HOME/shared/gemstone/repos/GsDevKit_SuperDoit',
+	#projectSpecFile : 'rowan/project.ston',
+	#componentNames : [
+		'GsDevKit'
+	],
+	#comment : 'loads GsDevKit support code in support of GsDevKit_home superDoit scripts'
+}
+]
+%
+method
+globalNamed: aString
+	^ self 
+		globalNamed: aString 
+		ifAbsent: [ self error: 'The global named ', aString printString, ' cannot be found.'].
+%
+method
+restartNetldi
+	"If GemStone version if >= 3.3 netldi supports restarting with -r.
+	 Older version need to be stopped and then started using the same arguments used to start it the first time"
+
+	| result netldiArgs |
+	self stderr nextPutAll: 'SESS_HOME: ', (System gemEnvironmentVariable: 'GS_SYS_SESSIONS').
+	self stoneInfo gsVers >= '3.3.0' ifTrue: [
+		result :=  GsHostProcess execute: (self gs_binDirectory / 'startnetldi ') fullPath asString, ' -r ', self sessionDescription netLDI.
+		self stderr nextPutAll: result.
+	] ifFalse: [
+		result := GsHostProcess execute: (self gs_devKitBinDirectory / 'stopNetldi ') fullPath asString, ' ', self stoneName.
+		self stderr nextPutAll: result.
+		netldiArgs := self netldiArgsStringFromArray: self netldiArgs.
+		result := GsHostProcess execute: (self gs_devKitBinDirectory / 'startNetldi ') fullPath asString, ' ', netldiArgs.
+		self stderr nextPutAll: result.
+	].
+%
+method
+netldiArgs
+	| sess netldiArgs |
+	sess := self sessionDescription.
+	netldiArgs := OrderedCollection new.
+	self netldiArgsOn: netldiArgs.
+	(self scriptArgs size = 1 or: [ self scriptArgs size = 2 and: [ self privateRestart ] ])
+		ifTrue: [
+			self privateRestart ifTrue: [ netldiArgs add: '-r' ].
+			sess netldiArgsOn: netldiArgs.
+		]
+		ifFalse: [
+			netldiArgs
+				addAll: (self scriptArgs copyFrom: 3 to: self scriptArgs size);
+				add: sess netLDI
+		].
+	^ netldiArgs
+%
+method
+netldiArgsOn: netldiArgs
+	| logDir |
+	logDir := self gs_logDirectory.
+	netldiArgs
+		add: '-l';
+		add: (logDir / 'netldi.log') fullPath asString
+%
+method
+netldiArgsStringFromArray: netldiArgsArray
+	^ String streamContents: [ :stream |
+			netldiArgsArray
+				do: [ :item | stream nextPutAll: item asString ]
+					separatedBy: [ stream space ]
+		]
+%
+method
+sessionDescription
+	^ self
+		sessionDescriptionIfAbsent: [ :sessionDescriptionReference |
+			Error signal:
+					'Session description file ' , sessionDescriptionReference pathString printString , ' for ' , self stoneName printString
+						, ' not found.' ]
+%
+method
+sessionDescriptionIfAbsent: absentBlock
+	^self sessionDescriptionFor: self stoneName ifAbsent: absentBlock
+%
+method
+sessionDescriptionFor: aStoneName ifAbsent: absentBlock
+	| sessionDescriptionReference |
+	sessionDescriptionReference := self sessionDescriptionHome / aStoneName.
+	sessionDescriptionReference exists
+		ifFalse: [ ^ absentBlock value: sessionDescriptionReference ].
+	^ (self globalNamed: 'TDSessionDescription') importFrom: sessionDescriptionReference pathString
+%
+method
+sessionDescriptionHome
+	^ (System gemEnvironmentVariable: 'GS_SYS_SESSIONS') asFileReference
+%
+method
+gs_binDirectory
+	^ ((System gemEnvironmentVariable: 'GEMSTONE'), '/bin') asFileReference
+%
+method
+gs_logDirectory
+	^ (System gemEnvironmentVariable: 'GEMSTONE_LOGDIR') asFileReference
+%
+method
+gs_stonesDirectory
+	^  ((System gemEnvironmentVariable: 'GS_HOME'), '/server/stones') asFileReference
+%
+method
+gs_devKitBinDirectory
+	^  ((System gemEnvironmentVariable: 'GS_HOME'), '/bin') asFileReference
+%
+method
+gs_stoneDirectory
+	^  self gs_stonesDirectory / self stoneName
+%
+method
+stoneInfoClass
+	^ (self globalNamed: 'GsDevKitStoneInfo')
+%
+method
+stoneInfoFilename
+	^  'info.ston'
+%
+method
+stoneInfo
+	^ self stoneInfoClass importFrom: self gs_stoneDirectory / self stoneInfoFilename
+%
+method
+stoneName
+	^ self positionalArgs at: 1
+%
+method
+doit
+	"override doit method, because ChildError does not exist in 3.6.0" 
+	[
+		self getAndVerifyOptions == self noResult
+			ifTrue: [ ^ self noResult ].
+		^ self theDoit
+	] on: Error do: [:ex |
+		self debug ifTrue: [ ex pass ].
+		self
+			exit: ((ex respondsTo: #stderr)
+				ifTrue: [ ex stderr asString trimBoth ]
+				ifFalse: [ ex messageText ])
+			withStatus: 1 "does not return" ].
+%
+doit
+	self preDoitSpecLoad.	"load the GsDevKit_SuperDoit project from spec"
+	self restartNetldi.
+	^ self noResult
+%