REBOL [
Title: "EASY SOCCER"
Date: 23-Dec-2005
Author: ["Marco"]
Version: 2.1.1
Email: [mvri@bluewin.ch]
File: %easy-soccer.r
Category: [web cgi]
Library: [
level: 'beginner
platform: 'all
type: [function tool module]
domain: [cgi web compression encryption extension http protocol other-net ]
tested-under: [win]
support: marco@ladyreb.org
license: PD
see-also: none
]
Comment: {At the origin was Rugby, next Soccer and now Easy-Soccer}
Purpose: {
Easy-Soccer is a broker based on CGI which offer an easy way
to write and the deploy distributed Rebol application.
Easy-Soccer makes very easy to expose function written in Rebol like services.
Thus, you can use these functions as if they were defined locally.
In a distributed environment Easy-Soccer uses a simple WEB server
and CGI to execute Rebol code on the server. HTTP is used for the
transport of the messages like SOAP or X-RPC and so goes easily thru firewalls.
Easy-Soccer allows not only to publish remote function, but can also provide
the client part of the application. So you can have in the same Rebol script
the client and the server part of your program.
Even more, Easy-Soccer allows you to run your script as a monolithic application
without any change and without anything else than your script. In the same spirit,
if your script use VID, it can be run within REBOL/View or within the REBOL/Plugin
without any change.
}
Modified: [
[1.0.0 10-Apr-2004 marco@ladyreb.org {Création du programme sur la base de soccer}]
[1.0.1 11-Apr-2004 marco@ladyreb.org {Petites corrections}]
[1.0.2 17-Apr-2004 marco@ladyreb.org {Petites corrections}]
[1.0.3 01-May-2004 marco@ladyreb.org {Permet de tourner en standalone dans view}]
[1.0.4 02-May-2004 marco@ladyreb.org {Petites corrections}]
[1.0.5 02-May-2004 marco@ladyreb.org {permet de tourner en standalone dans tous les cas}]
[1.0.6 10-May-2004 marco@ladyreb.org {Ajout des rafinement /encloak et /compress à la fonction serve}]
[1.0.7 11-May-2004 marco@ladyreb.org {Permet de mettre les clients dans des contexts}]
[1.0.8 18-May-2004 marco@ladyreb.org {Suppression de la fonction default-soccer}]
[1.0.9 09-Jul-2004 marco@ladyreb.org {Modification du code permettant d'avoir le client dans un context}]
[1.1.0 14-Jul-2004 marco@ladyreb.org {Dernière correction (j'espère) pour le code dans le context}]
[1.1.1 23-Jul-2004 marco@ladyreb.org {A small correction on the content-length header}]
[1.1.2 24-Jul-2004 marco@ladyreb.org {English translation}]
[1.1.3 01-Oct-2004 marco@ladyreb.org {serve/build refinement and micro bug correction}]
[1.1.4 02-Oct-2004 marco@ladyreb.org {Suppress the /build refinement and apply always a compose to the do-script}]
[1.1.5 02-Oct-2004 marco@ladyreb.org {Bug correction on stub building when type is block (compose/only)}]
[1.1.6 11-Oct-2005 marco@ladyreb.org {Bug correction on stub building when type is lit-word}]
[1.1.7 05-Dec-2005 marco@ladyreb.org {Major changes on stubs building and function execution}]
[1.1.8 08-Dec-2005 marco@ladyreb.org {do-remote, try-remote and reduce-remote added}]
[2.0.0 14-Dec-2005 marco@ladyreb.org {New release published on www.rebol.org}]
[2.1.0 22-Dec-2005 marco@ladyreb.org {Enhanced request parsing for better control & security}]
[2.1.1 23-Dec-2005 marco@ladyreb.org {Some bug correction}]
]
Defaults: {
compress: true
encloak: false
}
Usage: {
In your script:
- Write the functions you want to plublish and to be able to use remotly
- If you want, write in a block also the client part of your application
- initialize easy-soccer (do %easy-soccer.r)
- invoke the serve function with the liste of the functions you authorize to access remotly
for example: serve [now]
- If you publish also the client part of your application, use the refinement /do-script
for example serve/do-script [now] [print now]
- You can also encrypt and/or compress the message between the client and the server by using the refinement /encloak and /compress
for example serve/do-script/compress/encloak [now] [print now] yes no
- If you want to invoke many function in one remote call, use the do-remote, try-remote or reduce-remote function
To run your script in a distributed mode:
- within a script or within the console: do http://my.super.server/cgi-bin/my-super-script.cgi
- to include the stubs in a un context ctx: context load do next load http://my.super.script/cgi-bin/my-super-script.cgi
- whitin the plugin
To run your script in a monolithic mode:
- within a script or within the console: do %my-super-script.cgi
- to include the stubs in a un context ctx: context load %my-super-script.cgi
- whitin the plugin (no change from distributed env. if you use relative URL)
}
]
; ***************
; Public function
; ***************
serve: none
do-remote: :do
reduce-remote: :reduce
try-remote: :try
; ******************************
; Context containing easy-soccer
; ******************************
make object! [
; **************
; Default values
; **************
default: context [
compress: true
encloak: false
]
; ************************************
; The serve function (public function)
; ************************************
set 'serve func [
{Exposes a set of function as a remote service and execute the request}
'services [word! block!]
{The functions to expose}
/do-script script [string! block! file! url!]
{The script to run at the client}
/compress compress-flag [logic!]
/encloak encloak-flag [logic!]
/local request response length err
][
either system/options/cgi/request-method [
either equal? "GET" uppercase system/options/cgi/request-method [
if error? err: try [
response: build-client
to block! services
script
either compress [compress-flag][default/compress]
either encloak [encloak-flag][default/encloak]
rejoin [http:// system/options/cgi/server-name ":" system/options/cgi/server-port system/options/cgi/script-name]
][
response: mold/only compose/deep [
rebol [(either system/script/header [third system/script/header][[]])]
to error! [(reduce bind copy/part at first err: disarm err 3 7 err)]
]
]
][
if error? err: try [
length: to integer! system/options/cgi/content-length
local: make string! (2 + length)
while [0 < length] [
length: length - read-io system/ports/input local length
]
response: execute-request local build-exec services
][
response: mold/all/only compose [
(false)
(disarm err)
(false)
]
]
]
print [
"Content-Type: text/text" newline
"Content-Length:" length? response newline
newline
response
]
][
if script [
do compose load script
]
]
]
; ****************************************
; Return the stubs and the client (if any)
; ****************************************
build-client: func [
exposed-services [block!]
script [none! string! block! file! url!]
compress-flag [logic!]
encloak-flag [logic!]
server [url!]
/local response item base key
][
either script [
if error? script: try [compose load script][
return mold/only compose/deep [
rebol [(either system/script/header [third system/script/header][[]])]
to error! [(reduce bind copy/part at first script: disarm script 3 7 script)]
]
]
][
script: copy []
]
local: copy []
response: copy [do-remote: reduce-remote: try-remote:]
foreach item exposed-services [
if not value? item [
return mold/only compose/deep [
rebol [(either system/script/header [third system/script/header][[]])]
to error! (reform ["Serve error:" item "has no value"])
]
]
append response to set-word! item
local: compose [
(local)
(build-stub item)
]
]
local: compose/deep [
(local)
(common)
exec-remote: func [
request [block!]
/local binary-base response compress-flag encloak-flag
][
compress-flag: (compress-flag)
encloak-flag: (encloak-flag)
if compress-flag or encloak-flag [
request: mold/all/only request
if compress-flag [request: compress request]
if encloak-flag [request: encloak to binary! request to string! length? request]
]
binary-base: system/options/binary-base
system/options/binary-base: 64
set/any [
compress-flag
response
encloak-flag
] load send-request mold/all/only reduce [
compress-flag
request
encloak-flag
]
system/options/binary-base: binary-base
if compress-flag or encloak-flag [
if encloak-flag [response: decloak response to string! length? response]
if compress-flag [response: decompress response]
set/any 'response load to string! response
]
if all [
value? 'response object? response
equal? [self code type id arg1 arg2 arg3 near where] first response
][
error? response: to error! reduce bind copy/part at first response 3 7 response
]
return get/any 'response
]
send-request: func [
request [string!]
][
read/custom (server) reduce ['post request]
]
]
either compress-flag or encloak-flag [
local: insert mold/only local
if not empty? script [script: mold/only script]
item: copy []
if compress-flag [
local: compress local
insert item 'decompress
if not empty? script [script: compress script]
]
key: []
if encloak-flag [
key: checksum/secure to string! length? local
local: encloak to binary! local key
if not empty? script [script: encloak script key]
insert tail item [decloak]
key: reduce [key]
]
local: compose [
bind load to string! (item) (local) (key) 'do-remote
]
if not empty? script [
script: compose [
do bind load to string! (item) (script) (key) 'do-remote
]
]
][
local: compose/only [(local)]
]
binary-base: system/options/binary-base
system/options/binary-base: 64
response: mold/only compose/deep [
rebol [(either system/script/header [third system/script/header][[]])]
(response) none
context (local)
(script)
]
system/options/binary-base: binary-base
response
]
build-stub: func [
f [word!]
/local spec body item
][
either any-function? get f [
compose/deep [
set (to lit-word! f) func [
(parse third get f [copy item [to /local | to end]] if none? item [item: []] item)
/local item sub-item
/no-exec
][
(compose/only [
local: copy (to block! f)
parse (first get f) [
any [set item [word! | lit-word! | get-word!] (
item: get item
if word? :item [item: to lit-word! :item] ;;;???;;;
insert/only tail local :item
)]
any [
/local break
|
set item refinement! (
item: bind item 'local
if get item [insert tail local item]
item: get item
)
any [
set sub-item word! (if item [insert tail local get sub-item])
]
]
]
if no-exec [return local]
exec-remote compose [try (local)]
])
]
]
][
compose/deep [
set (to lit-word! f) func [
/no-exec
][
if no-exec [return (f)]
exec-remote compose [try (f)]
]
]
]
]
common: [
set 'reduce-remote func [
request [block!]
/local block
][
request: copy request
local: copy [reduce]
while [not empty? request][
change/only request join to path! request/1 'no-exec
set [block request] do/next request
insert tail local block
]
exec-remote local
]
set 'do-remote func [
request [block!]
][
try-remote request
]
set 'try-remote func [
request [block!]
/local
][
local: copy [try]
while [not empty? request][
set [block request] do/next compose [(append to path! first request 'no-exec) (next request)]
insert tail local block
]
return exec-remote local
]
]
; *******************
; Execute the request
; *******************
execute-request: func [
request [string!]
rule [block!]
/local response item name compress-flag encloak-flag
][
set/any [
compress-flag
request
encloak-flag
] load request
if compress-flag or encloak-flag [
if encloak-flag [request: decloak request to string! length? request]
if compress-flag [request: decompress request]
request: load to string! request
]
bind rule 'local
local: copy []
if error? try [
if not parse request [
'try rule end (set/any 'response try local)
|
'reduce rule end (response: try [reduce local])
][
response: to error! reform ["Request error: Invalid request" mold request mold rule]
]
][
response: disarm response
]
if compress-flag or encloak-flag [
response: mold/all/only reduce [get/any 'response]
if compress-flag [response: compress response]
if encloak-flag [response: encloak to binary! response to string! length? response]
]
binary-base: system/options/binary-base
system/options/binary-base: 64
response: mold/all/only reduce [
compress-flag
get/any 'response
encloak-flag
]
system/options/binary-base: binary-base
response
]
build-exec: func [
services [block!]
/local
][
local: copy []
foreach item services [
either empty? local [
local: build-rule item
][
local: compose [
(local)
|
(build-rule item)
]
]
]
if not empty? local [
local: compose/deep [
any [(local)]
]
]
local
]
build-rule: func [
f [word!]
/local item rule sub-rule word-rule arg-rule
][
either any-function? get f [
arg-rule: [
set item [word! | lit-word! | get-word!] (
word-rule: either lit-word? item [
[(insert/only tail local :item)]
][
[(if word? :item [item: to lit-word! item]
insert/only tail local :item)]
]
)
set item opt block! (
item: either item [copy item][copy [any-type!]]
forall item [
if not head? item [
item: insert item '|
]
]
item: head item
insert tail sub-rule compose/deep [
set item [(item)]
(word-rule)
]
)
opt string!
]
rule: compose [
set item (to lit-word! f) (to paren! [
insert tail local reduce [f: to path! item]
])
]
sub-rule: copy []
parse third get f [
opt string!
opt block!
any arg-rule (
insert tail rule sub-rule
)
any [
/local to end
|
set item refinement! (sub-rule: compose [
set item (item)
(to paren! [insert tail f to word! item])
])
opt string!
any arg-rule
(insert tail rule compose/only [opt (sub-rule)])
]
]
][
rule: compose [
set item (to lit-word! f) (to paren! [
insert tail local item
])
]
]
rule
]
]