Annotation of OpenXM/src/kan96xx/Doc/httpd-rpc.sm1, Revision 1.4
1.4 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-rpc.sm1,v 1.3 2002/10/24 02:48:59 takayama Exp $
1.1 takayama 2: %% http server by sm1. Used for RPC. Generic example.
3:
4: [(parse) (httpd.sm1) pushfile] extension pop
5: /httpd.textarea.name (rpc) def
6: /httpd.textarea.name.aaa
7: [(GET /?) httpd.textarea.name] cat (array) dc
8: def
9: /httpd.port 8090 def
10: /httpd.serial 0 def
11:
1.2 takayama 12: %%******* Put initialization codes for ox_asir here.
13: /httpd.initialization
14: [
15: (XM_debug=0; ctrl("debug_window",0); Xm_noX=1;)
16: ("Asirweb version 0.80. "+
17: " Risa/Asir oxasir version "+rtostr(version());)
18: ] cat
19: def
1.1 takayama 20:
21:
22: [(parse) (oxasir.sm1) pushfile] extension
23: oxNoX
24: (oxasir.started) boundp {
25: } {
26: %% Initialize oxasir.
27: [(x^2-1) (x)] fctr pop
28: oxasir.ccc oxmathcap
29: oxasir.ccc oxsetmathcap
1.2 takayama 30: oxasir.ccc httpd.initialization oxexecutestring ;
31: (Initialization returns ...: ) messagen
32: oxasir.ccc oxpopcmo message ;
1.1 takayama 33: } ifelse
34:
35: /webrpc {
36: [/rrr ] pushVariables
37: [
38: [(oxGenPass)] extension . (integer) dc /rrr set
39:
40: [(ostype)] extension 0 get
41: (windows) eq {
42: %% On windows.
43: [(forkExec)
44: [
45: ox.win.start.0 aload pop
46: (iexplore) %% Starting internet explorer (TM).
1.3 takayama 47: [(http://) [(sm1.socket) (gethostname) []] extension
48: (:) httpd.port toString] cat
1.1 takayama 49: ]
50: [ ]
51: 3] extension
52: }{
53: %% On unix.
1.3 takayama 54: [(sleep 3 ; netscape http://)
55: [(sm1.socket) (gethostname) []] extension
56: (:) httpd.port toString ( & ) ] cat
1.1 takayama 57: system
58: } ifelse
59:
60: httpd ;
61: ] pop
62: popVariables
63: } def
64:
65:
66: /httpd_action {
67: [/in-httpd /ff /httpd.com /httpd.result /sss
68: /sss.engine /sss.web /err
1.4 ! takayama 69: /oxserver.vname /scheck
1.1 takayama 70: ] pushVariables
71: [
72: {
73: [(sm1.socket) (select) [httpd.server.fd 0 get -1]] extension
74: %% wait for ever
75: [(sm1.socket) (readHTTP) [httpd.server.fd 0 get ]] extension /ff set
1.2 takayama 76: ff tag 0 eq {
77: (connection is closed.) message exit
1.1 takayama 78: }
79: {
80: (------------ start ----------------------) message
81: ff message
82: (-----------------------------------------) message
83: ff removeGET webstringToAscii /httpd.com set
84: [(httpd.com=) httpd.com] cat message
85: (------------ end ----------------------) message
86: ( ) message
1.2 takayama 87:
1.1 takayama 88: httpd.com metaCommand {
89: httpd.textarea.valid {
90:
1.4 ! takayama 91: %%% Security check
! 92: [(regionMatches) httpd.com
! 93: httpd.refusedCommands] extension /scheck set
! 94: scheck 0 get -1 eq {
! 95: }{
! 96: httpd.refusedCommands scheck 2 get get message
! 97: (Command is refused.) message
! 98: [
! 99: httpd.refusedCommands scheck 2 get get
! 100: httpd.com
! 101: ]
! 102: send-page-refused exit
! 103: } ifelse
! 104:
1.1 takayama 105: %%% Executing command, here.
106: oxasir.ccc
107: httpd.com cookedCommand
108: oxexecutestring ;
109:
110: }{
111: send-page-usage exit
112: } ifelse
113:
114: [(oxReq) oxasir.ccc SM_dupErrors ] extension pop
115:
116: [(oxReq) oxasir.ccc SM_popCMO ] extension pop
117: [(oxReq) oxasir.ccc SM_popString ] extension pop
118:
119: [(flush)] extension pop
120: %% Select inputs for interruption.
121: %% Wait by the spin lock.
122: {
123: [(oxMultiSelect) [oxasir.ccc] 1] extension 1 get 0 get
124: /sss.engine set
125: [(sm1.socket) (mselect)
126: [[httpd.server.fd 0 get] 1]
127: ] extension 0 get /sss.web set
128: /sss [sss.engine sss.web] def
129: sss.engine { exit } { } ifelse
130: sss.web { exit } { } ifelse
131: } loop
132: sss message
133:
134: sss 0 get {
135: [(oxGet) oxasir.ccc] extension /err set
136: [(oxGet) oxasir.ccc] extension /httpd.result set
137: } {
138: oxasir.ccc oxreset
139: oxasir.ccc ("computation is interrupted.";) oxexecutestring ;
140: oxasir.ccc oxpopstring
141: /httpd.result set
142: exit
143: } ifelse
144: (------------- result -------------) message
145: httpd.result message
146: (----------------------------------) message
147: ( ) message
1.2 takayama 148:
149: (----------- error -------------) message
1.1 takayama 150: err message
1.2 takayama 151: (-------------------------------) message
1.1 takayama 152: err [ ] eq {
153: } {
154: oxasir.ccc cleanErrors
155: [httpd.result 10 (string) dc err toString] cat
156: /httpd.result set
157: } ifelse
158:
159: httpd.result send-page-result exit %% exit the loop LOOP-A
160: } { exit } ifelse %% metaCommand
161: } ifelse
162: } loop %% LOOP-A
163: ] pop
164: popVariables
165: } def
166:
167:
168:
169:
170: /metaCommand {
171: /arg1 set
172: [/in-metaCommand /msg /result /msg2 /nn
173: /err /fn
174: ] pushVariables
175: [
176: /msg arg1 def
177: /result 1 def
178: msg (httpdAsirMeta quit) eq {
179: oxasir.ccc oxshutdown
180: send-page-bye
181: quit
182: /result 0 def
183: } { } ifelse
184: msg (httpdAsirMeta interrupt) eq {
185: oxasir.ccc oxreset
186: (Interrupted! <br>) send-page-3
187: /result 0 def
188: } { } ifelse
189: /arg1 result def
190: ] pop
191: popVariables
192: arg1
193: } def
194:
195: /send-page-usage {
196: [/in-send-page-usage ] pushVariables
197: [
198: (HTTP/0.9 200 OK) sendln
199: (Connection: close) sendln
200: (Content-Type: text/html) sendln
201: 0 sendln
202:
203: (<H1> Usage </H2> <br> ) sendln
204: [(Ask by GET /?) httpd.textarea.name (=) ( encoded_codes HTTP/1.0)] cat
205: sendln
206: (<br>) sendln
207: [(getenv) (OXWEB_POST)] extension tag 0 eq {
208: (<FORM NAME="myFORM">) sendln % use get
209: }{
210: (<FORM NAME="myFORM" METHOD="POST">) sendln
211: } ifelse
212: (<INPUT TYPE=submit VALUE="submit">) sendln
213: [(<textarea name=) httpd.textarea.name
214: ( rows=10 cols="80" wrap="soft"></textarea>)] cat sendln
215: (</FORM>) sendln
216: [$<a href="http://localhost:$ httpd.port toString
217: $/?msg=httpdAsirMeta+quit"> Shutdown the server. </a>, $
218: ] cat sendln
219:
220: 0 sendln
221: [(flush)] extension
222: ] pop
223: popVariables
224: } def
225:
226:
227:
228: /send-page-result {
229: /arg1 set
230: [/in-send-page-result /result] pushVariables
231: [
232: /result arg1 def
233: (HTTP/0.9 200 OK) sendln
234: (Connection: close) sendln
1.3 takayama 235: [(Content-length: ) result length toString ] cat sendln
236: (Content-Type: text/plain) sendln
1.1 takayama 237: 0 sendln
238:
239: result sendln
240: 0 sendln
241: [(flush)] extension
242: ] pop
243: popVariables
244: } def
245:
1.4 ! takayama 246: /send-page-refused {
! 247: /arg1 set
! 248: [/in-send-page-refused /reason] pushVariables
! 249: [
! 250: /reason arg1 def
! 251: (HTTP/0.9 200 OK) sendln
! 252: (Connection: close) sendln
! 253: (Content-Type: text/html) sendln
! 254: 0 sendln
! 255:
! 256: (<H2> Your request is refused. </H2> <br> ) sendln
! 257: (Because your input contains the key word <font color="red">) sendln
! 258: reason 0 get sendln
! 259: ( </font> ) sendln
! 260: (<br> <br>) sendln
! 261: (Your input is <br> ) sendln
! 262: (<pre> ) sendln
! 263: reason 1 get sendln
! 264: (</pre> ) sendln
! 265:
! 266: 0 sendln
! 267: [(flush)] extension
! 268: ] pop
! 269: popVariables
! 270: } def
! 271:
1.2 takayama 272: %% **** Overwrites the definition in httpd.sm1
273: /httpd_startserver {
274: (httpd server accessible outside localhost.) message
275: %% get the hostname of this machine.
276: [(sm1.socket) (open) [httpd.port
277: [(sm1.socket) (gethostname) [ ] ]extension ] ]
278: extension
279: /httpd.server.fdAndPort set
280: (sm1.socket.open returns ) messagen httpd.server.fdAndPort message
281: [(sm1.socket) (accept) [httpd.server.fdAndPort 0 get]] extension
282: /httpd.server.fd set
283: (connected.) message
284: (sm1.socket.accept returns <httpd.server.fd> ) messagen
285: httpd.server.fd message
286:
287: } def
1.1 takayama 288:
289: %% ******* sample of cooked command
290: /cookedCommand {
291: /arg1 set
292: [/in-cookedCommand /httpd.com] pushVariables
293: [
294: /httpd.com arg1 def
295: [(if (1) {) httpd.com (; };)] cat
296: /arg1 set
297: ] pop
298: popVariables
299: arg1
300: } def
1.4 ! takayama 301: /httpd.refusedCommands
! 302: [(shell) (eval_str) (ox_) (sm1_) (m_)
! 303: (connect) (load)
! 304: ]
! 305: def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>