%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-rpc.sm1,v 1.5 2002/10/24 07:45:03 takayama Exp $
%% http server by sm1. Used for RPC. Generic example.
[(parse) (httpd.sm1) pushfile] extension pop
/httpd.textarea.name (rpc) def
/httpd.textarea.name.aaa
[(GET /?) httpd.textarea.name] cat (array) dc
def
/httpd.port 8090 def
/httpd.serial 0 def
%%******* Put initialization codes for ox_asir here.
/httpd.initialization
[
(XM_debug=0; ctrl("debug_window",0); Xm_noX=1;)
("Asirweb version 0.80. "+
" Risa/Asir oxasir version "+rtostr(version());)
] cat
def
[(parse) (oxasir.sm1) pushfile] extension
oxNoX
(oxasir.started) boundp {
} {
%% Initialize oxasir.
[(x^2-1) (x)] fctr pop
oxasir.ccc oxmathcap
oxasir.ccc oxsetmathcap
oxasir.ccc httpd.initialization oxexecutestring ;
(Initialization returns ...: ) messagen
oxasir.ccc oxpopcmo message ;
} ifelse
/webrpc {
[/rrr ] pushVariables
[
[(oxGenPass)] extension . (integer) dc /rrr set
[(ostype)] extension 0 get
(windows) eq {
%% On windows.
[(forkExec)
[
ox.win.start.0 aload pop
(iexplore) %% Starting internet explorer (TM).
[(http://) [(sm1.socket) (gethostname) []] extension
(:) httpd.port toString] cat
]
[ ]
3] extension
}{
%% On unix.
[(sleep 3 ; netscape http://)
[(sm1.socket) (gethostname) []] extension
(:) httpd.port toString ( & ) ] cat
system
} ifelse
httpd ;
] pop
popVariables
} def
/httpd_action {
[/in-httpd /ff /httpd.com /httpd.result /sss
/sss.engine /sss.web /err
/oxserver.vname /scheck
] pushVariables
[
{
[(sm1.socket) (select) [httpd.server.fd 0 get -1]] extension
%% wait for ever
[(sm1.socket) (readHTTP) [httpd.server.fd 0 get ]] extension /ff set
ff tag 0 eq {
(connection is closed.) message exit
}
{
(------------ start ----------------------) message
ff message
(-----------------------------------------) message
ff removeGET webstringToAscii /httpd.com set
[(httpd.com=) httpd.com] cat message
(------------ end ----------------------) message
( ) message
httpd.com metaCommand {
httpd.textarea.valid {
%%% Security check
[(regionMatches) httpd.com
httpd.refusedCommands] extension /scheck set
scheck 0 get -1 eq {
}{
httpd.refusedCommands scheck 2 get get message
(Command is refused.) message
[
httpd.refusedCommands scheck 2 get get
httpd.com
]
send-page-refused exit
} ifelse
%%% Executing command, here.
oxasir.ccc
httpd.com cookedCommand
oxexecutestring ;
}{
send-page-usage exit
} ifelse
[(oxReq) oxasir.ccc SM_dupErrors ] extension pop
[(oxReq) oxasir.ccc SM_popCMO ] extension pop
[(oxReq) oxasir.ccc SM_popString ] extension pop
[(flush)] extension pop
%% Select inputs for interruption.
%% Wait by the spin lock.
{
[(oxMultiSelect) [oxasir.ccc] 1] extension 1 get 0 get
/sss.engine set
[(sm1.socket) (mselect)
[[httpd.server.fd 0 get] 1]
] extension 0 get /sss.web set
/sss [sss.engine sss.web] def
sss.engine { exit } { } ifelse
sss.web { exit } { } ifelse
} loop
sss message
sss 0 get {
[(oxGet) oxasir.ccc] extension /err set
[(oxGet) oxasir.ccc] extension /httpd.result set
} {
oxasir.ccc oxreset
oxasir.ccc ("computation is interrupted.";) oxexecutestring ;
oxasir.ccc oxpopstring
/httpd.result set
exit
} ifelse
(------------- result -------------) message
httpd.result message
(----------------------------------) message
( ) message
(----------- error -------------) message
err message
(-------------------------------) message
err [ ] eq {
} {
oxasir.ccc cleanErrors
[httpd.result 10 (string) dc err toString] cat
/httpd.result set
} ifelse
httpd.result send-page-result exit %% exit the loop LOOP-A
} { exit } ifelse %% metaCommand
} ifelse
} loop %% LOOP-A
] pop
popVariables
} def
/metaCommand {
/arg1 set
[/in-metaCommand /msg /result /msg2 /nn
/err /fn
] pushVariables
[
/msg arg1 def
/result 1 def
msg (httpdAsirMeta quit) eq {
oxasir.ccc oxshutdown
send-page-bye
quit
/result 0 def
} { } ifelse
msg (httpdAsirMeta interrupt) eq {
oxasir.ccc oxreset
(Interrupted!
) send-page-3
/result 0 def
} { } ifelse
/arg1 result def
] pop
popVariables
arg1
} def
/send-page-usage {
[/in-send-page-usage ] pushVariables
[
(HTTP/0.9 200 OK) sendln
(Connection: close) sendln
(Content-Type: text/html) sendln
0 sendln
(
) sendln reason 1 get sendln () sendln 0 sendln [(flush)] extension ] pop popVariables } def %% **** Overwrites the definition in httpd.sm1 /httpd_startserver { (httpd server accessible outside localhost.) message %% get the hostname of this machine. [(sm1.socket) (open) [httpd.port [(sm1.socket) (gethostname) [ ] ]extension ] ] extension /httpd.server.fdAndPort set (sm1.socket.open returns ) messagen httpd.server.fdAndPort message [(sm1.socket) (accept) [httpd.server.fdAndPort 0 get]] extension /httpd.server.fd set (connected.) message (sm1.socket.accept returns