Skip to content

Commit 395b786

Browse files
dalehenrichdalehenrich
committed
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
1 parent 96b844a commit 395b786

File tree

358 files changed

+3566
-0
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

358 files changed

+3566
-0
lines changed

‎shared/gemstone/bin/contexttest

+35
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
#!/usr/bin/env superdoit_solo
2+
instvars
3+
%
4+
usage
5+
-----
6+
USAGE $basename [--help | -h] [stoneName]
7+
8+
DESCRIPTION
9+
Script to test working with environments and stone contexts (groups of environment variables)
10+
11+
OPTIONS
12+
-h, --help display usage message
13+
--debug display debugging messages
14+
15+
EXAMPLES
16+
$basename --help
17+
$basename --debug myStone
18+
-----
19+
%
20+
method
21+
testContext
22+
self stderr nextPutAll: 'PWD: ', (System gemEnvironmentVariable: 'PWD') asString; cr.
23+
%
24+
method
25+
stoneContext
26+
27+
%
28+
method
29+
findLocalStone
30+
"Search from PWD up through the directory tree to find info.stone"
31+
%
32+
doit
33+
self testContext.
34+
self noResult
35+
%

‎shared/gemstone/bin/newextent

+109
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,109 @@
1+
#!/usr/bin/env superdoit_solo
2+
instvars
3+
gsListResult
4+
%
5+
usage
6+
-----
7+
USAGE $basename stone-name [snapshot-file] [mime-type]
8+
9+
DESCRIPTION
10+
Copy a new extent to the stones extent directory
11+
12+
OPTIONS
13+
-h, --help display usage message
14+
15+
EXAMPLES
16+
$basename --help
17+
$basename myStone
18+
$basename myStone /opt/snapshots/mySnapshop.dbf
19+
$basename myStone /opt/snapshots/mySnapshot.dbf.gz x-gzip
20+
-----
21+
%
22+
method
23+
newExtent
24+
| stream stoneDirectory extentFile |
25+
stream := self stderr.
26+
self positionalArgs size == 0 ifTrue: [
27+
^ Error signal: 'Wrong number of arguments (' , self positionalArgs size printString , ')' ].
28+
stoneDirectory := self gs_stoneDirectory.
29+
extentFile := stoneDirectory / 'extents' / 'extent0.dbf'.
30+
extentFile exists
31+
ifTrue: [ extentFile delete ].
32+
self mediaType = 'x-gzip'
33+
ifTrue: [ self gunzipSnapshotExtent: stoneDirectory ]
34+
ifFalse: [ self copySnapshotExtent: stoneDirectory ].
35+
36+
^ self noResult
37+
%
38+
method
39+
mediaType
40+
self positionalArgs size < 3 ifTrue: [ ^ 'octet-stream' ].
41+
^ self positionalArgs at: 3
42+
%
43+
method
44+
copySnapshotExtent: stoneDirectory
45+
"use copydbf, so that any corruption in the extent file can be found at the outset"
46+
47+
self copySnapshotExtent: self snapshotFile to: stoneDirectory for: self gsVers
48+
%
49+
method
50+
copySnapshotExtent: snapshotExtentFile to: stoneDirectory for: aGsVersionString
51+
"use copydbf, so that any corruption in the extent file can be found at the outset"
52+
53+
| extentFile argsArray cmdPath |
54+
self stderr nextPutAll: ('Copying extent file: ' , snapshotExtentFile pathString printString); cr.
55+
extentFile := stoneDirectory / 'extents' / 'extent0.dbf'.
56+
cmdPath := (aGsVersionString beginsWith: '2.4')
57+
ifTrue: [
58+
"cannot use copydbf to copy extent from product tree, so unconditionally use `cp`"
59+
'/bin/cp' ]
60+
ifFalse: [ (self gemstoneBin / 'copydbf') pathString ].
61+
argsArray := {(snapshotExtentFile pathString). (extentFile pathString)}.
62+
self stderr nextPutAll: (self runShellCommand: cmdPath args: argsArray); cr.
63+
OSProcess command: 'chmod +w "' , extentFile pathString, '"'
64+
%
65+
method
66+
gs_stonesDirectory
67+
^ ((System gemEnvironmentVariable: 'GS_HOME'), '/server/stones') asFileReference
68+
%
69+
method
70+
gs_stoneDirectory
71+
^ self gs_stonesDirectory / self stoneName
72+
%
73+
method
74+
stoneName
75+
^ self positionalArgs at: 1
76+
%
77+
method
78+
stoneInfoFilename
79+
^ 'info.ston'
80+
%
81+
method
82+
gs_binDirectory
83+
^ (System gemEnvironmentVariable: 'GEMSTONE'), '/bin/'
84+
%
85+
method
86+
gsListResult
87+
^ gsListResult ifNil: [ gsListResult := GsHostProcess execute: self gs_binDirectory, 'gslist -lc' ]
88+
%
89+
method
90+
doit
91+
"override doit method, because ChildError does not exist in 3.6.0"
92+
[
93+
self getAndVerifyOptions == self noResult
94+
ifTrue: [ ^ self noResult ].
95+
^ self theDoit
96+
]
97+
on: Error
98+
do: [ :ex |
99+
((self respondsTo: #'debug') and: [ self debug ])
100+
ifTrue: [ ex pass ].
101+
self
102+
exit: ((ex respondsTo: #stderr)
103+
ifTrue: [ ex stderr asString trimBoth ]
104+
ifFalse: [ ex messageText ])
105+
withStatus: 1 "does not return" ].
106+
%
107+
doit
108+
self newExtent
109+
%

‎shared/gemstone/bin/products

+69
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,69 @@
1+
#!/usr/bin/env superdoit_solo
2+
instvars
3+
installedProducts
4+
%
5+
usage
6+
-----
7+
USAGE $basename [--help | -h]
8+
9+
DESCRIPTION
10+
Provide information on the downloaded GemStone versions.
11+
12+
OPTIONS
13+
-h, --help display usage message
14+
15+
EXAMPLES
16+
$basename --help
17+
$basename
18+
-----
19+
%
20+
method
21+
produceProductsReport
22+
| stream |
23+
stream := self stderr.
24+
self installedProductsReportOn: stream
25+
%
26+
method
27+
installedProductsReportOn: stream
28+
stream
29+
nextPutAll: 'Installed Products:';
30+
cr.
31+
self installedProducts keys asSortedCollection
32+
do: [ :gsVers |
33+
stream
34+
tab;
35+
nextPutAll: gsVers;
36+
cr ]
37+
%
38+
method
39+
installedProducts
40+
installedProducts
41+
ifNil: [
42+
installedProducts := Dictionary new.
43+
self gs_productsDirectory directories
44+
do: [ :productDir |
45+
| dirName |
46+
dirName := productDir basename.
47+
(dirName indexOfSubCollection: 'GemStone64Bit') == 1
48+
ifTrue: [
49+
| productVersion dashIndex |
50+
dashIndex := dirName indexOf: $-.
51+
productVersion := dirName copyFrom: 'GemStone64Bit' size + 1 to: dashIndex - 1.
52+
installedProducts at: productVersion put: productDir ]
53+
ifFalse: [
54+
(dirName indexOfSubCollection: 'GemBuilderC') == 1
55+
ifTrue: [
56+
| productVersion dashIndex |
57+
dashIndex := dirName indexOf: $-.
58+
productVersion := dirName copyFrom: 'GemBuilderC' size + 1 to: dashIndex - 1.
59+
installedProducts at: productVersion put: productDir ] ] ] ].
60+
^ installedProducts
61+
%
62+
method
63+
gs_productsDirectory
64+
^ ((System gemEnvironmentVariable: 'GS_HOME'), '/shared/downloads/products') asFileReference
65+
%
66+
doit
67+
self produceProductsReport.
68+
^ self noResult
69+
%

‎shared/gemstone/bin/restartnetldi

+173
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,173 @@
1+
#!/usr/bin/env superdoit_solo
2+
instvars
3+
%
4+
usage
5+
-----
6+
USAGE: restartnetldi [-h] <stone-name>
7+
8+
DESCRIPTION
9+
Restart a running netldi process.
10+
11+
OPTIONS
12+
-h, --help display usage message
13+
14+
EXAMPLES
15+
$basename -h
16+
$basename myStoneName
17+
-----
18+
%
19+
projectshome
20+
$GS_HOME/shared/gemstone/repos
21+
%
22+
specs
23+
[
24+
RwLoadSpecificationV2 {
25+
#specName : 'GsDevKit_SuperDoit',
26+
#projectName : 'GsDevKit_SuperDoit',
27+
#diskUrl : 'file:$GS_HOME/shared/gemstone/repos/GsDevKit_SuperDoit',
28+
#projectSpecFile : 'rowan/project.ston',
29+
#componentNames : [
30+
'GsDevKit'
31+
],
32+
#comment : 'loads GsDevKit support code in support of GsDevKit_home superDoit scripts'
33+
}
34+
]
35+
%
36+
method
37+
globalNamed: aString
38+
^ self
39+
globalNamed: aString
40+
ifAbsent: [ self error: 'The global named ', aString printString, ' cannot be found.'].
41+
%
42+
method
43+
restartNetldi
44+
"If GemStone version if >= 3.3 netldi supports restarting with -r.
45+
Older version need to be stopped and then started using the same arguments used to start it the first time"
46+
47+
| result netldiArgs |
48+
self stderr nextPutAll: 'SESS_HOME: ', (System gemEnvironmentVariable: 'GS_SYS_SESSIONS').
49+
self stoneInfo gsVers >= '3.3.0' ifTrue: [
50+
result := GsHostProcess execute: (self gs_binDirectory / 'startnetldi ') fullPath asString, ' -r ', self sessionDescription netLDI.
51+
self stderr nextPutAll: result.
52+
] ifFalse: [
53+
result := GsHostProcess execute: (self gs_devKitBinDirectory / 'stopNetldi ') fullPath asString, ' ', self stoneName.
54+
self stderr nextPutAll: result.
55+
netldiArgs := self netldiArgsStringFromArray: self netldiArgs.
56+
result := GsHostProcess execute: (self gs_devKitBinDirectory / 'startNetldi ') fullPath asString, ' ', netldiArgs.
57+
self stderr nextPutAll: result.
58+
].
59+
%
60+
method
61+
netldiArgs
62+
| sess netldiArgs |
63+
sess := self sessionDescription.
64+
netldiArgs := OrderedCollection new.
65+
self netldiArgsOn: netldiArgs.
66+
(self scriptArgs size = 1 or: [ self scriptArgs size = 2 and: [ self privateRestart ] ])
67+
ifTrue: [
68+
self privateRestart ifTrue: [ netldiArgs add: '-r' ].
69+
sess netldiArgsOn: netldiArgs.
70+
]
71+
ifFalse: [
72+
netldiArgs
73+
addAll: (self scriptArgs copyFrom: 3 to: self scriptArgs size);
74+
add: sess netLDI
75+
].
76+
^ netldiArgs
77+
%
78+
method
79+
netldiArgsOn: netldiArgs
80+
| logDir |
81+
logDir := self gs_logDirectory.
82+
netldiArgs
83+
add: '-l';
84+
add: (logDir / 'netldi.log') fullPath asString
85+
%
86+
method
87+
netldiArgsStringFromArray: netldiArgsArray
88+
^ String streamContents: [ :stream |
89+
netldiArgsArray
90+
do: [ :item | stream nextPutAll: item asString ]
91+
separatedBy: [ stream space ]
92+
]
93+
%
94+
method
95+
sessionDescription
96+
^ self
97+
sessionDescriptionIfAbsent: [ :sessionDescriptionReference |
98+
Error signal:
99+
'Session description file ' , sessionDescriptionReference pathString printString , ' for ' , self stoneName printString
100+
, ' not found.' ]
101+
%
102+
method
103+
sessionDescriptionIfAbsent: absentBlock
104+
^self sessionDescriptionFor: self stoneName ifAbsent: absentBlock
105+
%
106+
method
107+
sessionDescriptionFor: aStoneName ifAbsent: absentBlock
108+
| sessionDescriptionReference |
109+
sessionDescriptionReference := self sessionDescriptionHome / aStoneName.
110+
sessionDescriptionReference exists
111+
ifFalse: [ ^ absentBlock value: sessionDescriptionReference ].
112+
^ (self globalNamed: 'TDSessionDescription') importFrom: sessionDescriptionReference pathString
113+
%
114+
method
115+
sessionDescriptionHome
116+
^ (System gemEnvironmentVariable: 'GS_SYS_SESSIONS') asFileReference
117+
%
118+
method
119+
gs_binDirectory
120+
^ ((System gemEnvironmentVariable: 'GEMSTONE'), '/bin') asFileReference
121+
%
122+
method
123+
gs_logDirectory
124+
^ (System gemEnvironmentVariable: 'GEMSTONE_LOGDIR') asFileReference
125+
%
126+
method
127+
gs_stonesDirectory
128+
^ ((System gemEnvironmentVariable: 'GS_HOME'), '/server/stones') asFileReference
129+
%
130+
method
131+
gs_devKitBinDirectory
132+
^ ((System gemEnvironmentVariable: 'GS_HOME'), '/bin') asFileReference
133+
%
134+
method
135+
gs_stoneDirectory
136+
^ self gs_stonesDirectory / self stoneName
137+
%
138+
method
139+
stoneInfoClass
140+
^ (self globalNamed: 'GsDevKitStoneInfo')
141+
%
142+
method
143+
stoneInfoFilename
144+
^ 'info.ston'
145+
%
146+
method
147+
stoneInfo
148+
^ self stoneInfoClass importFrom: self gs_stoneDirectory / self stoneInfoFilename
149+
%
150+
method
151+
stoneName
152+
^ self positionalArgs at: 1
153+
%
154+
method
155+
doit
156+
"override doit method, because ChildError does not exist in 3.6.0"
157+
[
158+
self getAndVerifyOptions == self noResult
159+
ifTrue: [ ^ self noResult ].
160+
^ self theDoit
161+
] on: Error do: [:ex |
162+
self debug ifTrue: [ ex pass ].
163+
self
164+
exit: ((ex respondsTo: #stderr)
165+
ifTrue: [ ex stderr asString trimBoth ]
166+
ifFalse: [ ex messageText ])
167+
withStatus: 1 "does not return" ].
168+
%
169+
doit
170+
self preDoitSpecLoad. "load the GsDevKit_SuperDoit project from spec"
171+
self restartNetldi.
172+
^ self noResult
173+
%

0 commit comments

Comments
 (0)