diff --git a/bin/gslist.solo b/bin/gslist.solo new file mode 100755 index 00000000..d8e901e4 --- /dev/null +++ b/bin/gslist.solo @@ -0,0 +1,123 @@ +#!/usr/bin/env superdoit_solo +customoptions +{ +SuperDoitOptionalOptionWithNoArg long: 'help'. +SuperDoitOptionalOptionWithNoArg long: 'debug'. +SuperDoitOptionalOptionWithNoArg long: 'debugGem'. +SuperDoitOptionalOptionWithRequiredArg long: 'registry'. +SuperDoitOptionalOptionWithNoArg long: 'verbose'. +SuperDoitOptionalOptionWithNoArg long: 'long' short: 'l'. +SuperDoitOptionalOptionWithNoArg long: 'json' short: 'j'. +SuperDoitOptionalOptionWithNoArg long: 'removeLocks' short: 'c'. +} +% +Usage +----- +USAGE $basename [--help] [--debug] [--debugGem] [--verbose] \ + --registry= + +DESCRIPTION + Run gslist command using the GEMSTONE associated with the named stone. + +OPTIONS + Note that the standard shortcuts options are not supported, since we weant + to be faithful to the startnetldi options and they comprise a big chunk + of the alphabet. + + --help display usage message + --debug bring up topaz debugger in the event of a script error + --debugGem If terminal is connected to stdout, bring up debugger. If not, + dump stack to stdout and wait for topaz to attach using topaz + DEBUGGEM command. + --verbose Verbose logging enabled. + # + # standard startnetldi options (currently supported) + # + -l, --long cause netldi to print extra information to its log file. + -j, --json Print extra long listing in JSON format to stdout. Implies -q and -x + -c, --removeLocks Remove locks of killed servers. + +EXAMPLES + $basename --help + $basename --debug + $basename --debugGem + $basename --registry=bosch 3.7.0 + $basename --registry=bosch 3.7.0 --long --removeLocks + # if launched from stone directory where .GDKStoneSpec.ston is present + $basename + $basename -l + $basename -lc +----- +% +instvars +gemstoneVersionString +% +specs +[ +RwLoadSpecificationV2 { + #projectName : 'GsDevKit_stones', + #projectSpecFile : 'rowan/project.ston', + #componentNames : [ + 'Core', + 'Solo' + ], + #platformProperties : { + 'gemstone' : { + 'allusers' : { + #defaultSymbolDictName : 'Globals' + } + } + }, + #comment : '' +}, +RwLoadSpecificationV2 { + #projectName : 'GsCommands', + #projectSpecFile : 'rowan/project.ston', + #diskUrl : '$GEMSTONE/examples/GsCommands/projectsHome/GsCommands', + #componentNames : [ + 'Commands' + ], + #platformProperties : { + 'gemstone' : { + 'allusers' : { + #defaultSymbolDictName : 'UserGlobals' + } + } + }, + #comment : '' +} +] +% +method +gemstoneVersionString + ^ gemstoneVersionString ifNil: [ System gemVersionReport at: 'gsVersion' ] +% +doit + | registryClass stoneName stoneSpec registry output | + self preDoitSpecLoad: [:spec | + spec projectName = 'GsCommands' + ifTrue: [ spec projectsHome: '$GEMSTONE/examples/GsCommands/projectsHome' ] + ifFalse: [ spec projectsHome: self dirname asFileReference parent parent ] ]. + registryClass := (self globalNamed: 'GDKRegistry'). + self verbose + ifTrue: [ (self globalNamed: 'GDKGsDevKit_stonesBase') verbose: true ]. + self positionalArgs size = 0 + ifTrue: [ + | specFile | + specFile := FileLocator workingDirectory asFileReference / '.GDKStoneSpec.ston'. + stoneSpec := (self globalNamed: 'GDKAbstractRegistryStore') fromPath: specFile ifAbsent: []. + gemstoneVersionString := stoneSpec gemstoneVersionString ] + ifFalse: [ + | stonesRegistry | + self positionalArgs size > 1 + ifTrue: [ self error: 'Expected a single positional argument: , not ', self positionalArgs size printString, ' positional arguments' ]. + stoneName := self positionalArgs at: 1. + self registry + ifNil: [ self error: '--registry option must be specified when is specified' ]. + stonesRegistry := registryClass stonesRegistryNamed: self registry. + stoneSpec := stonesRegistry stoneNamed: stoneName ]. + registry := stoneSpec registry. + output := registry gslist: self withSuperDoitOptions: true. + self stdout lf; nextPutAll: output; lf. + ^ self noResult +% diff --git a/src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/registry.st b/src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/registry.st new file mode 100644 index 00000000..7d7c57d8 --- /dev/null +++ b/src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/registry.st @@ -0,0 +1,5 @@ +accessing +registry + ^ GDKAbstractRegistryStore + fromPath: self parentRegistryPath + ifAbsent: [ self error: 'Registry not found at ' , self parentRegistryPath printString ] \ No newline at end of file diff --git a/src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/startNetldi.withSuperDoitOptions..st b/src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/startNetldi.withSuperDoitOptions..st index 90c99590..fa41cef1 100644 --- a/src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/startNetldi.withSuperDoitOptions..st +++ b/src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/startNetldi.withSuperDoitOptions..st @@ -4,7 +4,7 @@ startNetldi: superDoitScriptOrNil withSuperDoitOptions: superDoitOptionsBoolean debugLogging restart" - | scriptPath stdout exitStatus commandLine arrayOfOutputs debugLogging restart | + | scriptPath stdout exitStatus commandLine output debugLogging restart | scriptPath := ''. restart := debugLogging := false. stdout := superDoitScriptOrNil @@ -42,7 +42,7 @@ startNetldi: superDoitScriptOrNil withSuperDoitOptions: superDoitOptionsBoolean lf; nextPutAll: commandLine; yourself ]. - [ arrayOfOutputs := GsHostProcess execute: commandLine ] + [ output := GsHostProcess execute: commandLine ] on: ChildError do: [ :ex | "exit status: @@ -52,7 +52,7 @@ startNetldi: superDoitScriptOrNil withSuperDoitOptions: superDoitOptionsBoolean 3 or above, an error occurred and the specified netldi was not started" exitStatus := ex status ]. exitStatus = 0 - ifTrue: [ stdout nextPutAll: (arrayOfOutputs at: 1) "stdout" ] + ifTrue: [ stdout nextPutAll: output "stdout" ] ifFalse: [ (exitStatus = 1 or: [ exitStatus = 2 ]) ifTrue: [ stdout nextPutAll: 'netldi is already running (' , exitStatus printString , ')' ] diff --git a/src/GsDevKit_stones-Core.package/GDKStonesRegistry.class/instance/gslist.st b/src/GsDevKit_stones-Core.package/GDKStonesRegistry.class/instance/gslist.st new file mode 100644 index 00000000..7d843413 --- /dev/null +++ b/src/GsDevKit_stones-Core.package/GDKStonesRegistry.class/instance/gslist.st @@ -0,0 +1,3 @@ +runtime +gslist + ^ self gslist: nil withSuperDoitOptions: false \ No newline at end of file diff --git a/src/GsDevKit_stones-Core.package/GDKStonesRegistry.class/instance/gslist.withSuperDoitOptions..st b/src/GsDevKit_stones-Core.package/GDKStonesRegistry.class/instance/gslist.withSuperDoitOptions..st new file mode 100644 index 00000000..474465ce --- /dev/null +++ b/src/GsDevKit_stones-Core.package/GDKStonesRegistry.class/instance/gslist.withSuperDoitOptions..st @@ -0,0 +1,92 @@ +runtime +gslist: superDoitScriptOrNil withSuperDoitOptions: superDoitOptionsBoolean + "runs gslist and returns the output of gslist or error, if not able to run gslist" + + "if superDoitOptionsBoolean is true, then superDoitScriptOrNil is expected to respond to the following messages: + long + json + gemstoneVersionString + removeLocks" + + | stdout scriptPath exitStatus commandLine gslistOutput verbose long json oldGemstone removeLocks | + verbose := GDKGsDevKit_stonesBase verbose. + scriptPath := ' '. + removeLocks := json := long := false. + stdout := superDoitScriptOrNil + ifNotNil: [ + scriptPath := ' (from ' , superDoitScriptOrNil scriptPath , ') '. + superDoitOptionsBoolean + ifTrue: [ + long := superDoitScriptOrNil long. + json := superDoitScriptOrNil json. + removeLocks := superDoitScriptOrNil removeLocks ]. + superDoitScriptOrNil stdout ] + ifNil: [ GsFile stdout ]. + verbose + ifTrue: [ + stdout + lf; + nextPutAll: + '====== starting gslist at' , scriptPath , DateAndTime now printString; + lf ]. + exitStatus := 0. + [ + oldGemstone := System gemEnvironmentVariable: 'GEMSTONE'. + System + gemEnvironmentVariable: 'GEMSTONE' + put: + (self products + at: superDoitScriptOrNil gemstoneVersionString + ifAbsent: [ System gemEnvironmentVariable: 'GEMSTONE' ]). + commandLine := '$GEMSTONE/bin/gslist' asFileReference pathString. + long + ifTrue: [ commandLine add: ' -l' ]. + json + ifTrue: [ commandLine add: ' -j' ]. + removeLocks + ifTrue: [ commandLine add: ' -c' ]. + verbose + ifTrue: [ + stdout + lf; + nextPutAll: commandLine; + lf; + yourself ]. + [ gslistOutput := GsHostProcess execute: commandLine ] + on: ChildError + do: [ :ex | + " Exit Status: 0 (OK) + 1 (No servers found) + 2 (Stale lock(s) removed) + 3, or 4 (Fatal error)" + exitStatus := ex status ] ] + ensure: [ System gemEnvironmentVariable: 'GEMSTONE' put: oldGemstone ]. + exitStatus = 0 + ifTrue: [ + verbose + ifTrue: [ stdout nextPutAll: gslistOutput "stdout" ] + ifFalse: [ ^ gslistOutput ] ] + ifFalse: [ + exitStatus = 1 + ifTrue: [ + verbose + ifTrue: [ stdout nextPutAll: 'no servers found (' , exitStatus printString , ')' ] + ifFalse: [ ^ gslistOutput ] ] + ifFalse: [ + exitStatus = 2 + ifTrue: [ + verbose + ifTrue: [ stdout nextPutAll: 'stale locks removed (' , exitStatus printString , ')' ] + ifFalse: [ ^ gslistOutput ] ] + ifFalse: [ + exitStatus >= 3 + ifTrue: [ + verbose + ifTrue: [ stdout nextPutAll: 'gslist failed to start (' , exitStatus printString , ')' ] + ifFalse: [ self error: 'gslist failed to start(' , exitStatus printString , ')' ] ] ] ] ]. + verbose + ifTrue: [ + stdout + lf; + nextPutAll: '****************************************'; + lf ] \ No newline at end of file