Annotation of OpenXM/src/kan96xx/Doc/httpd-asir.sm1, Revision 1.9
1.9 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v 1.8 2001/04/22 04:35:46 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> )
1.9 ! takayama 173: httpd.com preformatHTML (<br>)
1.4 takayama 174: } ifelse
1.3 takayama 175: (<font color="green"> Output-) httpd.serial toString
176: (: </font> )
1.9 ! takayama 177: httpd.result preformatHTML
1.3 takayama 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
1.9 ! takayama 465: ] pop
! 466: popVariables
! 467: arg1
! 468: } def
! 469:
! 470: /preformatHTML {
! 471: /arg1 set
! 472: [/in-preformatHTML /sss /c] pushVariables
! 473: [
! 474: /sss arg1 def
! 475: sss (array) dc /sss set
! 476: sss {
! 477: /c set
! 478: [
! 479: c 60 eq {
! 480: /c (<) def
! 481: } { } ifelse
! 482: c 62 eq {
! 483: /c (>) def
! 484: } { } ifelse
! 485: c 38 eq {
! 486: /c (&) def
! 487: } { } ifelse
! 488: ] pop
! 489: c (string) dc
! 490: } map cat /sss set
! 491: [(<pre> ) sss ( </pre> )] cat /arg1 set
1.1 takayama 492: ] pop
493: popVariables
494: arg1
1.3 takayama 495: } def
496:
497: /metaCommand {
498: /arg1 set
499: [/in-metaCommand /msg /result] pushVariables
500: [
501: /msg arg1 def
502: /result 1 def
503: msg (httpdAsirMeta quit) eq {
1.8 takayama 504: oxasir.ccc oxshutdown
1.3 takayama 505: send-page-bye
506: quit
1.5 takayama 507: /result 0 def
508: } { } ifelse
509: msg (httpdAsirMeta save) eq {
510: send-page-save
511: /result 0 def
512: } { } ifelse
513: msg (httpdAsirMeta interrupt) eq {
514: oxasir.ccc oxreset
515: (Interrupted! <br>) send-page-3
1.3 takayama 516: /result 0 def
517: } { } ifelse
518: /arg1 result def
519: ] pop
520: popVariables
521: arg1
522: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>