[PATCH] Add startup and shutdown scripts to packages

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  <[hidden email]>

        * 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.
+
+@item --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.
 
+@item 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.
+
+@item 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: [

_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk