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