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