Annotation of OpenXM/src/kan96xx/Doc/httpd-asir.sm1, Revision 1.7
1.7 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v 1.6 2001/04/22 00:34:01 takayama Exp $
1.1 takayama 2: %% http server by sm1
1.2 takayama 3:
4: /httpd.port 1200 def
1.4 takayama 5: /httpd.initialization
6: %% Put initialization codes here.
7: [
1.5 takayama 8: ("Asirweb version 0.80. "+
1.4 takayama 9: " Risa/Asir oxasir version "+rtostr(version());)
10: ] cat
11: def
1.1 takayama 12: [(parse) (oxasir.sm1) pushfile] extension
13: (oxasir.started) boundp {
14: } {
1.6 takayama 15: %% Initialize oxasir.
1.1 takayama 16: [(x^2-1) (x)] fctr pop
1.5 takayama 17: oxasir.ccc oxmathcap
18: oxasir.ccc oxsetmathcap
1.1 takayama 19: } ifelse
20:
1.5 takayama 21: /asirweb {
1.7 ! takayama 22: [/rrr ] pushVariables
! 23: [
! 24: %% This procedure to generate port number might fail.
! 25: [(oxGenPass)] extension . (integer) dc /rrr set
! 26: rrr << rrr 20000 idiv 20000 mul >> sub /rrr set
! 27: /httpd.port 1200 rrr add def
! 28: httpd.port message
! 29:
1.6 takayama 30: [(sleep 3; netscape -geometry 800x500 http://localhost:)
31: httpd.port toString
32: ( &)] cat system
1.5 takayama 33: httpd ;
1.7 ! takayama 34: ] pop
! 35: popVariables
1.5 takayama 36: } def
37:
1.2 takayama 38: /httpd_startserver {
39: [(sm1.socket) (open) [httpd.port (localhost)]] extension
1.5 takayama 40: /httpd.server.fdAndPort set
41: (sm1.socket.open returns ) messagen httpd.server.fdAndPort message
42: [(sm1.socket) (accept) [httpd.server.fdAndPort 0 get]] extension
43: /httpd.server.fd set
1.1 takayama 44: (connected.) message
1.5 takayama 45: (sm1.socket.accept returns ) messagen httpd.server.fd message
1.1 takayama 46: } def
47:
1.2 takayama 48: /httpd_stopserver {
1.5 takayama 49: [(sm1.socket) (close) httpd.server.fd ] extension message
1.1 takayama 50: } def
51:
1.3 takayama 52: /send_packet {
1.1 takayama 53: /arg1 set
1.5 takayama 54: [(sm1.socket) (write) [httpd.server.fd 0 get arg1]] extension message
1.1 takayama 55: } def
56:
57: /sendln {
1.2 takayama 58: /arg1 set
59: [/in-sendln /mmm] pushVariables
60: [ arg1 /mmm set
1.1 takayama 61: mmm tag 5 eq {
62: [mmm 10 (string) dc] cat /mmm set
63: }{
64: 10 (string) dc /mmm set
65: } ifelse
1.5 takayama 66: [(sm1.socket) (write) [httpd.server.fd 0 get mmm]] extension message
1.2 takayama 67: ] pop
68: popVariables
1.1 takayama 69: } def
70:
71: /httpd {
1.4 takayama 72: /httpd.serial 0 def
1.3 takayama 73: /httpd.history [ ] def
1.1 takayama 74: {
1.2 takayama 75: httpd_startserver ;
76: httpd_action ;
77: httpd_stopserver ;
1.1 takayama 78: (5 sleep) system
1.3 takayama 79: httpd.serial 1 add /httpd.serial set
1.1 takayama 80: } loop
81: } def
82:
1.2 takayama 83: /httpd_action {
1.5 takayama 84: [/in-httpd /ff /httpd.com /httpd.result /sss
1.6 takayama 85: /sss.engine /sss.web /err
1.3 takayama 86: ] pushVariables
1.2 takayama 87: [
1.1 takayama 88: {
1.5 takayama 89: [(sm1.socket) (select) [httpd.server.fd 0 get -1]] extension
90: %% wait for ever
91: [(sm1.socket) (read) [httpd.server.fd 0 get ]] extension /ff set
1.1 takayama 92: ff length 0 eq {
93: (connection is closed.) message
94: }
1.4 takayama 95: {
1.1 takayama 96: (------------ start ----------------------) message
97: ff message
98: (-----------------------------------------) message
99: ff removeGET webstringToAscii /httpd.com set
100: httpd.com message
101: (------------ end ----------------------) message
102: ( ) message
1.4 takayama 103: httpd.serial 0 eq {
104: /httpd.com httpd.initialization def
105: } { } ifelse
1.3 takayama 106: httpd.com metaCommand {
107: oxasir.ccc
108: [(if (1) {) httpd.com (};)] cat
109: oxexecutestring ;
1.6 takayama 110: [(oxReq) oxasir.ccc SM_dupErrors ] extension pop
1.5 takayama 111:
1.6 takayama 112: [(oxReq) oxasir.ccc SM_popCMO ] extension pop
1.5 takayama 113: [(oxReq) oxasir.ccc SM_popString ] extension pop
114: [(flush)] extension pop
115: %% Select inputs for interruption.
116: %% Wait by the spin lock.
117: {
118: [(oxMultiSelect) [oxasir.ccc] 1] extension 1 get 0 get
119: /sss.engine set
120: [(sm1.socket) (mselect)
121: [[httpd.server.fd 0 get] 1]
122: ] extension 0 get /sss.web set
123: /sss [sss.engine sss.web] def
124: sss.engine { exit } { } ifelse
125: sss.web { exit } { } ifelse
126: } loop
127: sss message
128:
129: sss 0 get {
1.6 takayama 130: [(oxGet) oxasir.ccc] extension /err set
1.5 takayama 131: [(oxGet) oxasir.ccc] extension /httpd.result set
132: %% oxasir.ccc oxpopstring /httpd.result set
133: } {
134: oxasir.ccc oxreset
135: oxasir.ccc ("computation is interrupted.";) oxexecutestring ;
136: oxasir.ccc oxpopstring
137: /httpd.result set
138: exit
139: } ifelse
1.3 takayama 140: (------------- result -------------) message
141: httpd.result message
142: (----------------------------------) message
143: ( ) message
1.6 takayama 144:
145: err message
146: err [ ] eq {
147: /httpd.history
148: httpd.history
149: [10 (string) dc
150: (/**** ) httpd.serial toString ( ****/)
151: 10 (string) dc
152: httpd.com
153: ] cat
154: append
155: def
156: } {
157: oxasir.ccc cleanErrors
158: [httpd.result 10 (string) dc err toString] cat
159: /httpd.result set
160: } ifelse
161:
1.4 takayama 162: [httpd.serial 0 eq { } {
163: (<title> asirweb </title> )
164: (<font color="blue"> Input-) httpd.serial toString
165: (: </font> )
166: (<pre> ) httpd.com (</pre>) (<br>)
167: } ifelse
1.3 takayama 168: (<font color="green"> Output-) httpd.serial toString
169: (: </font> )
170: (<pre>) httpd.result (</pre>)
171: ] cat
172: send-page-3 exit
1.5 takayama 173: } { exit } ifelse %% metaCommand
1.1 takayama 174: } ifelse
175: } loop
1.2 takayama 176: ] pop
177: popVariables
1.1 takayama 178: } def
179:
180:
1.3 takayama 181: /send-page-bye {
1.1 takayama 182: (HTTP/0.9 200 OK) sendln
183: %% (Date: Sun, 18 Mar 2001 02:54:50 GMT) sendln
184: %% (Server: sm1/0.1 (Unix)) sendln
185: %% (Last-Modified: Wed, 23 Aug 2000 11:19:27 GMT) sendln
186: %% (ETag: "1f8f-5df-39a3b33f") sendln
187: %% (Accept-Ranges: bytes) sendln
188: %% (Content-Length: 10) sendln
189: (Connection: close) sendln
1.3 takayama 190: % (Content-Type: text/plain) sendln
191: (Content-Type: text/html) sendln
1.1 takayama 192: 0 sendln
1.3 takayama 193: (<html>) sendln
194: (Shutdown the engine. <br>) sendln
195: (See you! <a href="http://www.openxm.org"> asirweb </a>) sendln
196: (</html>) sendln
1.1 takayama 197: 0 sendln
198: [(flush)] extension
199: } def
200:
201: /send-page-2 {
202: (HTTP/0.9 200 OK) sendln
203: %% (Content-Length: 10) sendln
204: (Connection: close) sendln
205: (Content-Type: text/html) sendln
206: 0 sendln
207: (<FORM NAME="myFORM">) sendln
208: (<INPUT TYPE="TEXT" NAME="Num">) sendln
209: (</FORM>) sendln
210: 0 sendln
211: [(flush)] extension
212: } def
213:
214: /send-page-3 {
215: /arg1 set
216: [/in-send-page-3 /result] pushVariables
217: [
218: /result arg1 def
219: (HTTP/0.9 200 OK) sendln
220: (Connection: close) sendln
221: (Content-Type: text/html) sendln
222: 0 sendln
223: %% (<FORM NAME="myFORM" METHOD="POST">) sendln
224: result sendln
225: (<FORM NAME="myFORM">) sendln
226: (<INPUT TYPE=submit VALUE="submit">) sendln
1.2 takayama 227: (<textarea name=msg rows=10 cols="80" wrap="soft"></textarea>) sendln
1.1 takayama 228: (</FORM>) sendln
1.3 takayama 229: send-menu-1
1.1 takayama 230: 0 sendln
231: [(flush)] extension
232: ] pop
233: popVariables
234: } def
235:
1.3 takayama 236: /httpd.asirman
237: ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_toc.html")
238: def
239: /httpd.asirman.index
240: ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_262.html#SEC262")
241: def
1.4 takayama 242: /httpd.asir.intro
243: ("http://www.math.sci.kobe-u.ac.jp/~taka/asir-book-html/main")
244: def
1.3 takayama 245: /send-menu-1 {
246:
1.4 takayama 247: (FILE:) sendln
1.3 takayama 248: [$<a href="http://localhost:$ httpd.port toString
1.4 takayama 249: $/?msg=httpdAsirMeta+quit"> Shutdown the asir server. </a>, $
1.3 takayama 250: ] cat sendln
1.5 takayama 251: %% [$<a href="http://localhost:$ httpd.port toString
252: %% $/?msg=httpdAsirMeta+interrupt"> interrupt </a>, $
253: %% ] cat sendln
254: [$<a href="http://localhost:$ httpd.port toString
255: $/?msg=httpdAsirMeta+save"> save. </a>, $
256: ] cat sendln
1.4 takayama 257: ( <spacer type=horizontal size=80> ) sendln
1.3 takayama 258:
1.4 takayama 259: (HELP:) sendln
1.3 takayama 260: [(<font color="red">
1.4 takayama 261: <a href=) httpd.asirman ( > AsirManual (Ja) </a> </font>, )] cat sendln
1.3 takayama 262: [(<font color="purple">
1.4 takayama 263: <a href=) httpd.asirman.index ( > Index (Ja) </a> </font>, )] cat sendln
264: [(<font color="blue">
265: <a href=) httpd.asir.intro ( > Intro (Ja) </a> </font>, )] cat sendln
1.3 takayama 266: } def
1.1 takayama 267:
1.5 takayama 268: /send-page-save {
269: [/in-send-page-save /i] pushVariables
270: [
271: (HTTP/0.9 200 OK) sendln
272: (Connection: close) sendln
273: (Content-Type: text/html) sendln
274: 0 sendln
275: (<html> <body>) sendln
1.6 takayama 276: (/* Saved the following to sm1out.txt */<br>) sendln
277: (/* Save the following by your browser as a text file. */<br>) sendln
1.5 takayama 278:
279: (<pre>) sendln
280: 0 1 httpd.history length 1 sub {
281: /i set
282: httpd.history i get sendln
283: } for
284: (</pre>) sendln
285: (</body> </html>) sendln
286: 0 sendln
287: [(flush)] extension
288: [(PrintDollar) 1] system_variable
289: httpd.history output
290: [(PrintDollar) 0] system_variable
291: ] pop
292: popVariables
293: } def
294:
295:
1.1 takayama 296: /stopclient {
297: [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
1.6 takayama 298: } def
299:
300:
301: /cleanErrors {
302: /arg1 set
303: [/in-cleanErrors /clientt /spp] pushVariables
304: [
305: /clientt arg1 def
306: clientt oxgetsp (integer) dc /spp set
307: clientt spp oxpops
308: ] pop
309: popVariables
1.1 takayama 310: } def
311:
312:
313: /fromHex {
314: /arg1 set
315: [/in-fromHex /s1 /s2 /c /c2] pushVariables
316: [
317: arg1 0 get /s1 set
318: arg1 1 get /s2 set
319:
320: 48 s1 le s1 57 le and { % 0, ..., 9
321: s1 48 sub /c set
322: }{ } ifelse
323: 65 s1 le s1 70 le and { % A, ..., F
324: s1 65 sub 10 add /c set
325: }{ } ifelse
326: 97 s1 le s1 102 le and { % a, ..., f
327: s1 97 sub 10 add /c set
328: }{ } ifelse
329: c 16 mul /c set
330:
331: 48 s2 le s2 57 le and { % 0, ..., 9
332: s2 48 sub /c2 set
333: }{ } ifelse
334: 65 s2 le s2 70 le and { % A, ..., F
335: s2 65 sub 10 add /c2 set
336: }{ } ifelse
337: 97 s2 le s2 102 le and { % a, ..., f
338: s2 97 sub 10 add /c2 set
339: }{ } ifelse
340: c c2 add /arg1 set
341: ] pop
342: popVariables
343: arg1
344: } def
345:
1.7 ! takayama 346: %% remove GET /?msg=
1.1 takayama 347: /removeGET {
348: /arg1 set
1.7 ! takayama 349: [/in-removeGET /s /s2 /i /j /i0] pushVariables
1.1 takayama 350: [
351: /s arg1 def
352: s 1 copy /s2 set
353: s (array) dc /s set
1.7 ! takayama 354:
! 355: 0 1 s length 1 sub {
! 356: /i0 set
! 357: s i0 get 61 eq { %% 61 is =
! 358: i0 1 add /i0 set
! 359: exit
! 360: } { } ifelse
! 361: } for
! 362:
1.1 takayama 363: /j 0 def
1.7 ! takayama 364: i0 1 s length 1 sub {
1.1 takayama 365: /i set
366: s2 j << s i get (string) dc >> put
367: j 1 add /j set
368: } for
369: /arg1 s2 def
370: ] pop
371: arg1
372: } def
373:
374: /webstringToAscii {
375: /arg1 set
376: [/in-webstringToAscii /s /i /j /c /n] pushVariables
377: [
378: /s arg1 def
379: s (array) dc /s set
380: /j 0 def /n s length def
381: /i 0 def
382: {
383: s i get /c set
384: c 32 eq { exit } { } ifelse
385: c 37 eq { % c == %
386: [s i 1 add get s i 2 add get] fromHex /c set
387: s j c put
388: j 1 add /j set
389: i 3 add /i set
390: } {
391: c 43 eq { % c == +
392: s j 32 put
393: j 1 add /j set
394: i 1 add /i set
395: } {
396: c 13 eq { % c == 0xd
397: i 1 add /i set
398: } {
399: s j c put
400: j 1 add /j set
401: i 1 add /i set
402: } ifelse
403: } ifelse
404: } ifelse
405: i n ge { exit } { } ifelse
406: } loop
407: s j carN /s set
408: s { (string) dc } map cat /arg1 set
409: ] pop
410: popVariables
411: arg1
1.3 takayama 412: } def
413:
414: /metaCommand {
415: /arg1 set
416: [/in-metaCommand /msg /result] pushVariables
417: [
418: /msg arg1 def
419: /result 1 def
420: msg (httpdAsirMeta quit) eq {
421: send-page-bye
422: quit
1.5 takayama 423: /result 0 def
424: } { } ifelse
425: msg (httpdAsirMeta save) eq {
426: send-page-save
427: /result 0 def
428: } { } ifelse
429: msg (httpdAsirMeta interrupt) eq {
430: oxasir.ccc oxreset
431: (Interrupted! <br>) send-page-3
1.3 takayama 432: /result 0 def
433: } { } ifelse
434: /arg1 result def
435: ] pop
436: popVariables
437: arg1
438: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>