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