[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] [PATCH] Add startup and shutdown scripts to packages
|
From: |
Paolo Bonzini |
|
Subject: |
[Help-smalltalk] [PATCH] Add startup and shutdown scripts to packages |
|
Date: |
Mon, 25 Feb 2008 18:45:54 +0100 |
|
User-agent: |
Thunderbird 2.0.0.9 (Macintosh/20071031) |
With this patch, packages can specify start/stop scripts. Start scripts
can be activated with gst-load, while both start and stop scripts are
supported by gst-remote.
I contemplated adding the startup/shutdown to namespaces (e.g. with a
specially named class), but then I reasoned that users know about
packages, not namespaces. It is a little ugly to have %1 in the
startup/shutdown file, but that's what we have for now. It can be
changed anytime before 3.1 (which will take a while even though
development releases will start soon).
I added documentation for gst-load; gst-remote is completely
undocumented so far. Any volunteer to do it in the next week? :-)
Startup/shutdown scripts are provided for Swazoo (which is also
undocumented; part of this message will be added to the documentation
when time comes). One more user of startup/shutdown scripts will be
added soon...
Startup/shutdown arguments for Swazoo look like the following:
- if no argument is given, all sites are started/stopped
- if a number, all sites on the given port are started/stopped
- if a file (startup only), configuration is loaded from the given file
- any other argument is interpreted as a site name (which is
started/stopped)
The special site 'swazoodemo' starts an Hello World application on port
8888. So, after
$ gst-load --start=swazoodemo Swazoo
you can point your browser to http://localhost:8888/ and get a friendly
message.
Paolo
2008-02-25 Paolo Bonzini <address@hidden>
* kernel/PkgLoader.st: Add start/stop script support.
* scripts/Load.st: Add start/stop script support.
* scripts/Remote.st: Add start/stop script support.
* gst-load.c: Keep options synchronized.
diff --git a/NEWS b/NEWS
index 2221fce..5dcc7ea 100644
--- a/NEWS
+++ b/NEWS
@@ -16,6 +16,10 @@ o The semantics of #on:do: were changed: executing off the
end of an
o New tool gst-remote allows remote control of a GNU Smalltalk VM
via a TCP socket.
+o Packages can specify start/stop scripts. Start scripts can be activated
+ with gst-load, while both start and stop scripts are supported by
+ gst-remote.
+
o Unbuffered sockets available from class TCP.StreamSocket.
diff --git a/doc/gst.texi b/doc/gst.texi
index c776a80..bcb9e6b 100644
--- a/doc/gst.texi
+++ b/doc/gst.texi
@@ -1932,6 +1932,12 @@ together with the package, but this may change in future
versions.
@item -n
@item --dry-run
Do not save the image after loading.
+
address@hidden --start[=ARG]
+Start the services identified by the package. If an argument is
+given, only one package can be specified on the command-line. If
+at least one package specifies a startup script, @code{gst-load}
+won't exit.
@end table
To provide support for this system, you have to give away with your @gst{}
@@ -1996,6 +2002,18 @@ Specifies a testing script that @file{gst-sunit}
(@pxref{SUnit}) will
run in order to test the package. If this is specified, the package
should list @code{SUnit} among the prerequisites.
address@hidden start
+Specifies a Smalltalk script that @file{gst-load} and @file{gst-remote}
+will execute in order to start the execution of the service implemented
+in the package. Before executing the script, @code{%1} is replaced
+with either @code{nil} or a String literal.
+
address@hidden stop
+Specifies a Smalltalk script that @file{gst-remote}
+will execute in order to shut down the service implemented
+in the package. Before executing the script, @code{%1} is replaced
+with either @code{nil} or a String literal.
+
@item test
Specifies a subpackage that is only loaded by @file{gst-sunit} in order
to test the package. The subpackage may include arbitrary tags (including
diff --git a/gst-tool.c b/gst-tool.c
index 0084cb5..519ae4d 100644
--- a/gst-tool.c
+++ b/gst-tool.c
@@ -92,13 +92,13 @@ struct tool tools[] = {
{
"gst-load", "scripts/Load.st",
"-h|--help --version -q|--quiet -v|-V|--verbose -n|--dry-run -f|--force \
- -t|--test -I|--image-file: --kernel-directory:",
+ --start:: -t|--test -I|--image-file: --kernel-directory:",
NULL
},
{
"gst-reload", "scripts/Load.st",
"-h|--help --version -q|--quiet -v|-V|--verbose -n|--dry-run -f|--force \
- -t|--test -I|--image-file: --kernel-directory:",
+ --start:: -t|--test -I|--image-file: --kernel-directory:",
"--force"
},
{
@@ -129,7 +129,8 @@ struct tool tools[] = {
{
"gst-remote", "scripts/Remote.st",
"-h|--help --version --daemon --server -p|--port -f|--file: -e|--eval: \
- --pid --kill --snapshot:: -I|--image-file: --kernel-directory:",
+ -package: --start: --stop: --pid --kill --snapshot:: -I|--image-file: \
+ --kernel-directory:",
NULL
},
{ NULL, NULL, NULL, NULL }
diff --git a/kernel/PkgLoader.st b/kernel/PkgLoader.st
index 82c3b8c..6ed4b84 100644
--- a/kernel/PkgLoader.st
+++ b/kernel/PkgLoader.st
@@ -591,6 +591,22 @@ XML.'>
collection: self builtFiles
tag: 'built-file'
indent: indent.
+ self startScript isNil
+ ifFalse:
+ [aStream
+ nextPutAll: ' <start>';
+ nextPutAll: self startScript;
+ nextPutAll: '</start>';
+ nl;
+ space: indent].
+ self stopScript isNil
+ ifFalse:
+ [aStream
+ nextPutAll: ' <stop>';
+ nextPutAll: self stopScript;
+ nextPutAll: '</stop>';
+ nl;
+ space: indent].
aStream
nextPutAll: '</';
nextPutAll: tag;
@@ -716,6 +732,20 @@ XML.'>
self subclassResponsibility
]
+ startScript [
+ "Answer the start script for the package."
+
+ <category: 'accessing'>
+ self subclassResponsibility
+ ]
+
+ stopScript [
+ "Answer the stop script for the package."
+
+ <category: 'accessing'>
+ self subclassResponsibility
+ ]
+
callouts [
"Answer a (modifiable) Set of call-outs that are required to load
the package. Their presence is checked after the libraries and
@@ -745,6 +775,46 @@ XML.'>
^self name notNil and: [Smalltalk hasFeatures: self name]
]
+ start [
+ "File in the receiver and evaluate its start script, passing nil
+ as the argument."
+
+ <category: 'accessing'>
+ self fileIn.
+ self startScript isNil ifTrue: [ ^self ].
+ (self startScript % { 'nil' }) readStream fileIn.
+ ]
+
+ start: anObject [
+ "File in the receiver and evaluate its start script, passing anObject's
+ displayString as the argument."
+
+ <category: 'accessing'>
+ self fileIn.
+ self startScript isNil ifTrue: [ ^self ].
+ (self startScript % { anObject displayString storeString }) readStream
fileIn.
+ ]
+
+ stop [
+ "Evaluate the stop script of the receiver, passing nil as the
+ argument."
+
+ <category: 'accessing'>
+ self loaded ifFalse: [ ^self ].
+ self stopScript isNil ifTrue: [ ^self ].
+ (self stopScript % { 'nil' }) readStream fileIn.
+ ]
+
+ stop: anObject [
+ "Evaluate the stop script of the receiver, passing anObject's
+ displayString as the argument."
+
+ <category: 'accessing'>
+ self loaded ifFalse: [ ^self ].
+ self stopScript isNil ifTrue: [ ^self ].
+ (self stopScript % { anObject displayString storeString }) readStream
fileIn.
+ ]
+
allFiles: prefix [
<category: 'private - subpackages'>
prefix isNil ifTrue: [^self allFiles].
@@ -857,6 +927,20 @@ PackageInfo subclass: StarPackage [
^self loadedPackage modules
]
+ startScript [
+ "Answer the start script for the package."
+
+ <category: 'accessing'>
+ ^self loadedPackage startScript
+ ]
+
+ stopScript [
+ "Answer the stop script for the package."
+
+ <category: 'accessing'>
+ ^self loadedPackage stopScript
+ ]
+
sunitScripts [
"Answer a (modifiable) OrderedCollection of SUnit scripts that
compose the package's test suite."
@@ -925,7 +1009,9 @@ PackageInfo subclass: StarPackage [
Kernel.PackageInfo subclass: Package [
- | features prerequisites builtFiles files fileIns relativeDirectory
baseDirectories libraries modules callouts namespace sunitScripts test |
+ | features prerequisites builtFiles files fileIns relativeDirectory
+ baseDirectories libraries modules callouts namespace sunitScripts
+ startScript stopScript test |
<category: 'Language-Packaging'>
<comment: 'I am not part of a standard Smalltalk system. I store
internally the
@@ -979,6 +1065,34 @@ XML.'>
test := aPackage
]
+ startScript [
+ "Answer the start script for the package."
+
+ <category: 'accessing'>
+ ^startScript
+ ]
+
+ startScript: aString [
+ "Set the start script for the package to aString."
+
+ <category: 'accessing'>
+ startScript := aString
+ ]
+
+ stopScript [
+ "Answer the start script for the package."
+
+ <category: 'accessing'>
+ ^stopScript
+ ]
+
+ stopScript: aString [
+ "Set the stop script for the package to aString."
+
+ <category: 'accessing'>
+ stopScript := aString
+ ]
+
namespace [
"Answer the namespace in which the package is loaded."
@@ -1204,45 +1318,22 @@ XML.'>
ifFalse: [^self error: 'error in packages file:
unmatched end tag ' , tag].
"I tried to put these from the most common to the
least common"
- tag = 'file'
- ifTrue: [self files add: cdata]
- ifFalse:
- [tag = 'filein'
- ifTrue: [self fileIns add: cdata]
- ifFalse:
- [tag = 'prereq'
- ifTrue: [self prerequisites
add: cdata]
- ifFalse:
- [tag = 'provides'
- ifTrue: [self features
add: cdata]
- ifFalse:
- [tag = 'module'
- ifTrue: [self
modules add: cdata]
- ifFalse:
- [tag =
'directory'
- ifTrue:
[self relativeDirectory: cdata]
-
ifFalse:
-
[tag = 'name'
-
ifTrue: [self name: cdata]
-
ifFalse:
-
[tag = 'namespace'
-
ifTrue: [self namespace: cdata]
-
ifFalse:
-
[tag = 'library'
-
ifTrue: [self libraries add: cdata]
-
ifFalse:
-
[tag = 'built-file'
-
ifTrue: [self builtFiles add: cdata]
-
ifFalse:
-
[tag = 'sunit'
-
ifTrue: [self sunitScripts add: cdata]
-
ifFalse:
-
[tag = 'callout'
-
ifTrue: [self callouts add: cdata]
-
ifFalse:
-
[tag = openingTag
-
ifTrue: [^self]
-
ifFalse: [self error: 'invalid
tag ' , tag]]]]]]]]]]]]].
+ tag = 'file' ifTrue: [self files add: cdata]
ifFalse: [
+ tag = 'filein' ifTrue: [self fileIns add: cdata]
ifFalse: [
+ tag = 'prereq' ifTrue: [self prerequisites add:
cdata] ifFalse: [
+ tag = 'provides' ifTrue: [self features add: cdata]
ifFalse: [
+ tag = 'module' ifTrue: [self modules add: cdata]
ifFalse: [
+ tag = 'directory' ifTrue: [self relativeDirectory:
cdata] ifFalse: [
+ tag = 'name' ifTrue: [self name: cdata] ifFalse: [
+ tag = 'namespace' ifTrue: [self namespace: cdata]
ifFalse: [
+ tag = 'library' ifTrue: [self libraries add: cdata]
ifFalse: [
+ tag = 'built-file' ifTrue: [self builtFiles add:
cdata] ifFalse: [
+ tag = 'sunit' ifTrue: [self sunitScripts add:
cdata] ifFalse: [
+ tag = 'start' ifTrue: [self startScript: cdata]
ifFalse: [
+ tag = 'stop' ifTrue: [self stopScript: cdata]
ifFalse: [
+ tag = 'callout' ifTrue: [self callouts add: cdata]
ifFalse: [
+ tag = openingTag ifTrue: [^self] ifFalse: [
+ self error: 'invalid tag ' , tag]]]]]]]]]]]]]]].
cdata := nil].
ch isAlphaNumeric
ifTrue:
diff --git a/packages/swazoo-httpd/package.xml
b/packages/swazoo-httpd/package.xml
index 31c8996..93601b3 100644
--- a/packages/swazoo-httpd/package.xml
+++ b/packages/swazoo-httpd/package.xml
@@ -3,6 +3,20 @@
<prereq>Sport</prereq>
<namespace>Swazoo</namespace>
+ <start>
+ %1 isNil ifTrue: [ ^Swazoo.SwazooServer start ].
+ %1 ~ '^[0-9]+$' ifTrue: [ ^Swazoo.SwazooServer startOn: %1 asNumber ].
+ (File name: %1) exists ifTrue: [ ^Swazoo.SwazooServer configureFrom: %1 ].
+ %1 = 'swazoodemo' ifTrue: [ ^Swazoo.SwazooServer demoStart ].
+ Swazoo.SwazooServer startSite: %1
+ </start>
+
+ <stop>
+ %1 isNil ifTrue: [ ^Swazoo.SwazooServer stop ].
+ %1 ~ '^[0-9]+$' ifTrue: [ ^Swazoo.SwazooServer stopOn: %1 asNumber ].
+ Swazoo.SwazooServer stopSite: %1
+ </stop>
+
<test>
<sunit>
Swazoo.CompositeResourceTest
diff --git a/scripts/Load.st b/scripts/Load.st
index 2e0df95..9e4fa5c 100644
--- a/scripts/Load.st
+++ b/scripts/Load.st
@@ -30,12 +30,14 @@
Smalltalk arguments isEmpty ifTrue: [ ObjectMemory quit ]!
-| helpString quiet verbose wasVerbose snapshot force test sunit packages |
+| helpString quiet verbose wasVerbose snapshot force test sunit packages
+ startMessage |
snapshot := true.
quiet := false.
verbose := false.
force := false.
test := false.
+startMessage := Message selector: #fileIn arguments: #().
wasVerbose := FileStream verbose: false.
packages := OrderedCollection new.
sunit := ''.
@@ -50,6 +52,7 @@ Options:
-f --force reload package if already loaded
-n --dry-run don''t save the image after loading
-t --test run SUnit tests if available
+ --start[=ARG] start the package and keep running the image
-I --image-file=FILE load into the specified image
--kernel-dir=PATH use the specified kernel directory
-h --help show this message
@@ -59,7 +62,8 @@ Options:
"Parse the command-line arguments."
Smalltalk
arguments: '-h|--help --version -q|--quiet -v|-V|--verbose -n|--dry-run
- -f|--force -t|--test -I|--image-file: --kernel-directory:'
+ -f|--force -t|--test -I|--image-file: --kernel-directory:
+ --start::'
do: [ :opt :arg |
opt = 'help' ifTrue: [
@@ -88,6 +92,11 @@ Smalltalk
opt = 'test' ifTrue: [
test := true ].
+ opt = 'start' ifTrue: [
+ startMessage := Message
+ selector: (arg isNil ifTrue: [ #start ] ifFalse: [ #start: ])
+ arguments: (arg isNil ifTrue: [ #() ] ifFalse: [ { arg } ]) ].
+
opt = 'dry-run' ifTrue: [
snapshot := false ].
@@ -99,10 +108,16 @@ Smalltalk
force ifTrue: [
packages do: [ :each | Smalltalk removeFeature: each asSymbol ] ].
+
[
+ (packages size > 1 and: [ startMessage selector == #start: ]) ifTrue: [
+ stderr nextPutAll: 'gst-load: Cannot pass start argument to multiple
packages
+'.
+ ^self ].
+
packages := packages collect: [ :each | PackageLoader packageAt: each ].
packages do: [ :each |
- each fileIn.
+ each perform: startMessage.
sunit := sunit, ' ', each sunitScript ] ]
ifCurtailed: [ ObjectMemory quit: 1 ].
@@ -134,5 +149,9 @@ test
(File name: tmpFileName) remove ] ]
ifFalse: [
- snapshot ifTrue: [ ObjectMemory snapshot ] ]!
+ snapshot ifTrue: [ ObjectMemory snapshot ] ].
+
+(startMessage selector ~= #fileIn and: [
+ packages anySatisfy: [ :pkg | pkg startScript notNil ]])
+ ifTrue: [ Processor activeProcess suspend ]!
diff --git a/scripts/Remote.st b/scripts/Remote.st
index 96fbaba..4e05efb 100644
--- a/scripts/Remote.st
+++ b/scripts/Remote.st
@@ -75,26 +75,29 @@ host := nil.
helpString :=
'Usage:
- gst-load [ flag ... ] package ...
+ gst-remote [ flag ... ] host
Options:
- --daemon start background server
- --server start daemon
- -p --port=PORT connect/listen on given port (default 5432)
- -f --file=FILE file in FILE
- -e --eval=CODE evaluate CODE
- --kill kill daemon
- --snapshot[=FILE] save image
- --pid print daemon pid
- -h --help show this message
- --version print version information and exit
+ --daemon start background server
+ --server start daemon
+ -p --port=PORT connect/listen on given port (default 5432)
+ -f --file=FILE file in FILE
+ -e --eval=CODE evaluate CODE
+ --kill kill daemon
+ --snapshot[=FILE] save image
+ --package=PACKAGE load package
+ --start=PACKAGE[:DATA] load package and start it (defined in
package.xml)
+ --stop=PACKAGE[:DATA] load package and start it (defined in
package.xml)
+ --pid print daemon pid
+ -h --help show this message
+ --version print version information and exit
'.
"Parse the command-line arguments."
Smalltalk
arguments: '-h|--help --version --daemon --server -p|--port -f|--file:
- -e|--eval: --pid --kill --snapshot::
- -I|--image: --kernel-directory:'
+ -e|--eval: --pid --kill --snapshot:: --start: --stop:
+ --package: -I|--image: --kernel-directory:'
do: [ :opt :arg |
opt = 'help' ifTrue: [
@@ -114,9 +117,34 @@ Smalltalk
opt = 'port' ifTrue: [
port := arg asInteger ].
+ opt = 'start' ifTrue: [
+ | package data |
+ package := arg copyUpTo: $:.
+ package = arg
+ ifTrue: [
+ commands add: '(PackageLoader packageAt: %1) start'
+ % {package storeString} ]
+ ifFalse: [
+ commands add: '(PackageLoader packageAt: %1) start: %2'
+ % {package storeString. (arg copyAfter: $:)
storeString } ] ].
+
+ opt = 'stop' ifTrue: [
+ | package data |
+ package := arg copyUpTo: $:.
+ package = arg
+ ifTrue: [
+ commands add: '(PackageLoader packageAt: %1) stop'
+ % {package storeString} ]
+ ifFalse: [
+ commands add: '(PackageLoader packageAt: %1) stop: %2'
+ % {package storeString. (arg copyAfter: $:)
storeString } ] ].
+
opt = 'file' ifTrue: [
commands add: (File name: arg) ].
+ opt = 'package' ifTrue: [
+ commands add: 'PackageLoader fileInPackage: %1' % {arg storeString} ].
+
opt = 'eval' ifTrue: [
commands add: arg ].
@@ -144,7 +172,6 @@ Smalltalk
server ifTrue: [
PackageLoader fileInPackage: 'Compiler'.
- "PackageLoader fileInPackage: 'Swazoo'."
Transcript := MultiplexingTextCollector message: Transcript message.
[
| queue |
@@ -190,7 +217,7 @@ server ifTrue: [
ifFalse: [ TCP.Socket remote: host port: port ].
commands do: [ :each |
- "Using #readStream" makes it work both for Strings and Files."
+ "Using #readStream makes it work both for Strings and Files."
s nextPutAll: each readStream; nextPut: $<0>; flush.
[ s peekFor: $<0> ] whileFalse: [
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Help-smalltalk] [PATCH] Add startup and shutdown scripts to packages,
Paolo Bonzini <=