Annotation of OpenXM/src/kan96xx/Doc/httpd-sm1.sm1, Revision 1.4
1.4 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-sm1.sm1,v 1.3 2001/08/12 03:13:35 takayama Exp $
1.1 takayama 2: %% http server by sm1
1.3 takayama 3: %% Note to run on the Windows (TM).
1.2 takayama 4: %% (A) You need to set IE (internet explorer) as follows:
5: %% (1) Visit the menu
6: %% tool / internet option / connection / LAN configuration
1.3 takayama 7: %% (2) Add localhost to the list of hosts which are not accessed via
8: %% the proxy server.
1.2 takayama 9: %% (B) You need to have the "start.exe" at c:\windows\command\start.exe
1.3 takayama 10: %% (C) cygwin1.dll should be by sm1.exe, ox_sm1.exe and ox.exe
1.1 takayama 11:
12:
1.3 takayama 13: /httpd.image.name (kobeuniv2.jpg) def
14: /httpd.image.type (jpeg) def
1.1 takayama 15: /httpd.port 1200 def
16:
17: /httpd.initialization
18: %% Put initialization codes here.
19: [
20: ([$parse$ $cohom.sm1$ pushfile] extension
21: [$Web/sm1 version 0.80. $
22: $Kan/sm1 ox_sm1 version $ [$Version$] system_variable] cat)
23: ] cat
24: def
25:
1.3 takayama 26: [(getenv) (OSTYPE)] extension
27: tag 0 eq {
28: [(parse) (ox-win.sm1) pushfile] extension
29: }{
30: [(getenv) (OSTYPE)] extension
31: (cygwin) eq {
32: [(parse) (ox-win.sm1) pushfile] extension
33: }{
34: [(parse) (ox.sm1) pushfile] extension
35: } ifelse
36: } ifelse
37:
1.1 takayama 38: (ox_sm1.started) boundp {
39: } {
1.3 takayama 40: %% Initialize ox_sm1
41: [(getenv) (OSTYPE)] extension
42: tag 0 eq {
43: sm1connectr_win %% Assume that it is native Windows.
44: }{
45: sm1connectr %% cygwin or unix.
46: } ifelse
1.1 takayama 47: ox.ccc oxmathcap
48: ox.ccc oxsetmathcap
49: } ifelse
50:
51: /websm1 {
52: [/rrr ] pushVariables
53: [
54: %% This procedure to generate port number might fail.
55: [(oxGenPass)] extension . (integer) dc /rrr set
56: rrr << rrr 20000 idiv 20000 mul >> sub /rrr set
57: /httpd.port 1200 rrr add def
58: httpd.port message
59:
1.2 takayama 60: % [(sleep 3; start iexplore http://localhost:)
61: % httpd.port toString
62: % ( &)] cat system
63: [(forkExec)
64: [
65: (c:/windows/command/start)
66: (iexplore) %% Starting internet explorer (TM).
67: [(http://localhost:) httpd.port toString] cat
68: ]
69: [ ]
70: 3] extension
1.1 takayama 71: httpd ;
72: ] pop
73: popVariables
74: } def
75:
76: /httpd_startserver {
77: [(sm1.socket) (open) [httpd.port (localhost)]] extension
78: /httpd.server.fdAndPort set
79: (sm1.socket.open returns ) messagen httpd.server.fdAndPort message
80: [(sm1.socket) (accept) [httpd.server.fdAndPort 0 get]] extension
81: /httpd.server.fd set
82: (connected.) message
83: (sm1.socket.accept returns ) messagen httpd.server.fd message
84: } def
85:
86: /httpd_stopserver {
87: [(sm1.socket) (close) httpd.server.fd ] extension message
88: } def
89:
90: /send_packet {
91: /arg1 set
92: [(sm1.socket) (write) [httpd.server.fd 0 get arg1]] extension message
93: } def
94:
95: /sendln {
96: /arg1 set
97: [/in-sendln /mmm] pushVariables
98: [ arg1 /mmm set
99: mmm tag 5 eq {
100: [mmm 10 (string) dc] cat /mmm set
101: }{
102: 10 (string) dc /mmm set
103: } ifelse
104: [(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension {
1.3 takayama 105: (Warning (sendln): your peer closed the connection. Do not send the data.) message
1.1 takayama 106: } {
107: [(sm1.socket) (write) [httpd.server.fd 0 get mmm]] extension message
108: } ifelse
109: ] pop
110: popVariables
111: } def
112:
1.3 takayama 113: /sendBinaryFile {
114: /arg1 set
115: [/in-sendln /fname /fd /c /cdata] pushVariables
116: [ arg1 /fname set
117: [(sendBinaryFile: sending data) ] cat message
118: [(fp2openForRead) fname] extension /fd set fd message
119: fd 0 lt {
120: [(Error: sendBinaryFile: file ) fname ( is not found.)] cat message
121: /aaaa goto
122: } { } ifelse
123: [(fp2pushfile) fname] extension /cdata set
124: [(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension {
125: (Warning (sendBinaryFile): your peer closed the connection. Do not send the data.)
126: message
127: exit
128: } {
129: [(sm1.socket) (writeByte) [httpd.server.fd 0 get cdata]] extension pop
130: } ifelse
131: /aaaa
132: ] pop
133: popVariables
134: } def
135:
1.1 takayama 136: /httpd {
137: /httpd.serial 0 def
138: /httpd.history [ ] def
1.4 ! takayama 139: /httpd.result.history [ 0 ] def
1.1 takayama 140: {
141: httpd_startserver ;
142: httpd_action ;
143: httpd_stopserver ;
144: (5 sleep) system
145: httpd.serial 1 add /httpd.serial set
146: } loop
147: } def
148:
149: /httpd_action {
150: [/in-httpd /ff /httpd.com /httpd.result /sss
1.3 takayama 151: /sss.engine /sss.web /err /httpd.sendFile
1.1 takayama 152: ] pushVariables
153: [
154: {
155: [(sm1.socket) (select) [httpd.server.fd 0 get -1]] extension
156: %% wait for ever
157: [(sm1.socket) (read) [httpd.server.fd 0 get ]] extension /ff set
158: ff length 0 eq {
159: (connection is closed.) message
160: }
161: {
162: (------------ start ----------------------) message
163: ff message
164: (-----------------------------------------) message
1.3 takayama 165: ff 1 copy askToSendFile /httpd.sendFile set
166: httpd.sendFile tag 0 eq {
167: ff removeGET webstringToAscii /httpd.com set
168: } {
169: /httpd.com (NONE) def
170: } ifelse
171: [(httpd.com=) httpd.com] cat message
172: (httpd.sendFile=) messagen httpd.sendFile message
1.1 takayama 173: (------------ end ----------------------) message
174: ( ) message
175: httpd.serial 0 eq {
176: /httpd.com httpd.initialization def
177: } { } ifelse
1.3 takayama 178: httpd.sendFile tag 0 eq { }
179: {
180: httpd.sendFile httpd.image.type send-image
181: exit %% exit the loop LOOP-A
182: } ifelse
1.1 takayama 183: httpd.com metaCommand {
184: httpd.textarea.valid {
185: ox.ccc
186: [ httpd.com ] cat
187: oxexecutestring ;
188: }{
189: send-page-warning exit
190: } ifelse
191: [(oxReq) ox.ccc SM_dupErrors ] extension pop
192:
193: [(oxReq) ox.ccc SM_popCMO ] extension pop
194: [(oxReq) ox.ccc SM_popString ] extension pop
195: [(flush)] extension pop
196: %% Select inputs for interruption.
197: %% Wait by the spin lock.
198: {
199: [(oxMultiSelect) [ox.ccc] 1] extension 1 get 0 get
200: /sss.engine set
201: [(sm1.socket) (mselect)
202: [[httpd.server.fd 0 get] 1]
203: ] extension 0 get /sss.web set
204: /sss [sss.engine sss.web] def
205: sss.engine { exit } { } ifelse
206: sss.web { exit } { } ifelse
207: } loop
208: sss message
209:
210: sss 0 get {
211: [(oxGet) ox.ccc] extension /err set
212: [(oxGet) ox.ccc] extension /httpd.result set
213: %% ox.ccc oxpopstring /httpd.result set
214: } {
215: ox.ccc oxreset
216: ox.ccc ("computation is interrupted.";) oxexecutestring ;
217: ox.ccc oxpopstring
218: /httpd.result set
219: exit
220: } ifelse
221: (------------- result -------------) message
222: httpd.result message
223: (----------------------------------) message
224: ( ) message
225:
226: err message
227: err [ ] eq {
228: /httpd.history
229: httpd.history
230: [10 (string) dc
231: 37 (string) dc httpd.serial toString
232: 10 (string) dc
233: httpd.com
234: ( ) %% add extra ;
235: ] cat
236: append
237: def
238: } {
239: ox.ccc cleanErrors
240: [httpd.result 10 (string) dc err toString] cat
241: /httpd.result set
242: } ifelse
243:
244: [httpd.serial 0 eq { } {
245: (<title> Web/sm1 </title> )
246: (<font color="blue"> Input-) httpd.serial toString
247: (: </font> )
248: httpd.com preformatHTML (<br>)
249: } ifelse
250: (<font color="green"> Output-) httpd.serial toString
251: (: </font> )
1.3 takayama 252: (<a href=") httpd.image.name ("> (in pretty format) </a>) %%test
1.1 takayama 253: httpd.result preformatHTML
1.4 ! takayama 254: httpd.result.history httpd.result append /httpd.result.history set
1.1 takayama 255: ] cat
1.3 takayama 256: send-page-3 exit %% exit the loop LOOP-A
1.1 takayama 257: } { exit } ifelse %% metaCommand
258: } ifelse
1.3 takayama 259: } loop %% LOOP-A
1.1 takayama 260: ] pop
261: popVariables
262: } def
263:
264:
265: /send-page-bye {
266: (HTTP/0.9 200 OK) sendln
267: %% (Date: Sun, 18 Mar 2001 02:54:50 GMT) sendln
268: %% (Server: sm1/0.1 (Unix)) sendln
269: %% (Last-Modified: Wed, 23 Aug 2000 11:19:27 GMT) sendln
270: %% (ETag: "1f8f-5df-39a3b33f") sendln
271: %% (Accept-Ranges: bytes) sendln
272: %% (Content-Length: 10) sendln
273: (Connection: close) sendln
274: % (Content-Type: text/plain) sendln
275: (Content-Type: text/html) sendln
276: 0 sendln
277: (<html>) sendln
278: (Shutdown the engine. <br>) sendln
279: (See you! <a href="http://www.openxm.org"> Web/sm1 </a>) sendln
280: (</html>) sendln
281: 0 sendln
282: [(flush)] extension
283: } def
284:
285: /send-page-2 {
286: (HTTP/0.9 200 OK) sendln
287: %% (Content-Length: 10) sendln
288: (Connection: close) sendln
289: (Content-Type: text/html) sendln
290: 0 sendln
291: (<FORM NAME="myFORM">) sendln
292: (<INPUT TYPE="TEXT" NAME="Num">) sendln
293: (</FORM>) sendln
294: 0 sendln
295: [(flush)] extension
296: } def
297:
298: /send-page-3 {
299: /arg1 set
300: [/in-send-page-3 /result] pushVariables
301: [
302: /result arg1 def
303: (HTTP/0.9 200 OK) sendln
304: (Connection: close) sendln
305: (Content-Type: text/html) sendln
306: 0 sendln
307: %% (<FORM NAME="myFORM" METHOD="POST">) sendln
308: result sendln
1.3 takayama 309:
310: %%(<img src="hoge.jpeg"> <img>) sendln %%test. It does not work always?!
311: %%(<a href="hoge.jpeg"> Pretty format </a>) sendln %%test. It works.
312:
1.1 takayama 313: (<FORM NAME="myFORM">) sendln
314: (<INPUT TYPE=submit VALUE="submit">) sendln
315: [(<textarea name=) httpd.textarea.name
316: ( rows=10 cols="80" wrap="soft"></textarea>)] cat sendln
317: (</FORM>) sendln
318: send-menu-1
319: 0 sendln
320: [(flush)] extension
321: ] pop
322: popVariables
323: } def
324:
1.3 takayama 325: /send-image {
326: /arg2 set
327: /arg1 set
328: [/in-send-jpeg /fname /imagetype /ff /fsize] pushVariables
329: [
330: /fname arg1 def % set the jpeg file name.
331: /imagetype arg2 def % jpeg or gif
332: [(stat) fname] extension 0 get tag 0 eq {
333: (Warning (send-image): the file ) messagen fname messagen ( is not found.) message
334: /notFound goto
335: }{ }ifelse
336: [(stat) fname] extension 1 get 0 get toString /fsize set
337: (HTTP/1.1 200 OK) dup message sendln
338: (Server: httpd_sm1) dup message sendln
339: %% (ETag: "2197-bf6c-3b2d6541") sendln ???
340: (Accept-Ranges: bytes) dup message sendln
341: [(Content-Length: ) fsize] cat dup message sendln
342: (Connection: close) dup message sendln
343: [(Content-Type: image/) imagetype] cat dup message sendln
344: [(flush)] extension
345: 0 sendln
346: fname sendBinaryFile
347: 0 sendln
348: [(flush)] extension
349: /notFound
350: ] pop
351: popVariables
352: } def
353:
1.1 takayama 354: /httpd.sm1man
355: ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_toc.html")
356: def
357: /httpd.sm1man.index
358: ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_262.html#SEC262")
359: def
360: /httpd.asir.intro
361: ("http://www.math.sci.kobe-u.ac.jp/~taka/asir-book-html/main")
362: def
363: /send-menu-1 {
364:
365: (FILE:) sendln
366: [$<a href="http://localhost:$ httpd.port toString
367: $/?msg=httpdAsirMeta+quit"> Shutdown the sm1 server. </a>, $
368: ] cat sendln
369: %% [$<a href="http://localhost:$ httpd.port toString
370: %% $/?msg=httpdAsirMeta+interrupt"> interrupt </a>, $
371: %% ] cat sendln
372: [$<a href="http://localhost:$ httpd.port toString
373: $/?msg=httpdAsirMeta+save"> save. </a>, $
374: ] cat sendln
375: ( <spacer type=horizontal size=80> ) sendln
376:
377: (HELP:) sendln
378: [(<font color="red">
379: <a href=) httpd.sm1man ( > Sm1manual (Ja) </a> </font>, )] cat sendln
380: [(<font color="purple">
381: <a href=) httpd.sm1man.index ( > Index (Ja) </a> </font>, )] cat sendln
382: [(<font color="blue">
383: <a href=) httpd.asir.intro ( > Intro (Ja) </a> </font>, )] cat sendln
384: } def
385:
386: /send-page-save {
387: [/in-send-page-save /i] pushVariables
388: [
389: (HTTP/0.9 200 OK) sendln
390: (Connection: close) sendln
391: (Content-Type: text/plain) sendln
392: 0 sendln
393: [37 (string) dc ( Saved the following to sm1out.txt )] cat sendln
394: [37 (string) dc ( Save the following by your browser as a text file. )]
395: cat sendln
396:
397: 0 1 httpd.history length 1 sub {
398: /i set
399: httpd.history i get sendln
400: } for
401: ( ) sendln
402: 0 sendln
403: [(flush)] extension
404: [(PrintDollar) 1] system_variable
405: httpd.history output
406: [(PrintDollar) 0] system_variable
407: ] pop
408: popVariables
409: } def
410:
411: /send-page-warning {
412: (HTTP/0.9 200 OK) sendln
413: (Connection: close) sendln
414: (Content-Type: text/html) sendln
415: 0 sendln
416: (You cannot execute ox_sm1 without a session key! <br>) sendln
417: 0 sendln
418: [(flush)] extension
419: } def
420:
421: /stopclient {
422: [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
423: } def
424:
425:
426: /cleanErrors {
427: /arg1 set
428: [/in-cleanErrors /clientt /spp] pushVariables
429: [
430: /clientt arg1 def
431: clientt oxgetsp (integer) dc /spp set
432: clientt spp oxpops
433: ] pop
434: popVariables
435: } def
436:
437:
438: /fromHex {
439: /arg1 set
440: [/in-fromHex /s1 /s2 /c /c2] pushVariables
441: [
442: arg1 0 get /s1 set
443: arg1 1 get /s2 set
444:
445: 48 s1 le s1 57 le and { % 0, ..., 9
446: s1 48 sub /c set
447: }{ } ifelse
448: 65 s1 le s1 70 le and { % A, ..., F
449: s1 65 sub 10 add /c set
450: }{ } ifelse
451: 97 s1 le s1 102 le and { % a, ..., f
452: s1 97 sub 10 add /c set
453: }{ } ifelse
454: c 16 mul /c set
455:
456: 48 s2 le s2 57 le and { % 0, ..., 9
457: s2 48 sub /c2 set
458: }{ } ifelse
459: 65 s2 le s2 70 le and { % A, ..., F
460: s2 65 sub 10 add /c2 set
461: }{ } ifelse
462: 97 s2 le s2 102 le and { % a, ..., f
463: s2 97 sub 10 add /c2 set
464: }{ } ifelse
465: c c2 add /arg1 set
466: ] pop
467: popVariables
468: arg1
469: } def
470:
471: /randomName {
472: [/in-randomName /sss /rrr ] pushVariables
473: [
474: %% Seed name
475: /sss [ 97 97 97 97 97 97 97 97 97 97 ] def %% 97 == 'a'
476: %% This procedure to generate port number might fail.
477: sss {
478: [
479: [(oxGenPass)] extension .. /rrr set
480: [(tdiv_qr) rrr (26)..] mpzext 1 get /rrr set
481: ] pop
482: rrr (integer) dc add
483: } map
484: /sss set
485: sss {(string) dc} map cat /arg1 set
486: ] pop
487: popVariables
488: arg1
489: } def
490:
491: (httpd.textarea.name) boundp { }
492: {
493: /httpd.textarea.name randomName def
494: /httpd.textarea.name.aaa
495: [(GET /?) httpd.textarea.name] cat
496: (array) dc
497: def
498: } ifelse
1.3 takayama 499:
500:
501: %% Decompose into tokens separated by a space.
502: %% (GET /hoge.jpeg ???) ---> [(GET) (/hoge.jpeg) (???)]
503: /toTokensBySpace {
504: /arg1 set
505: [/in-toTokesBySpace /ss /ss2 /i] pushVariables
506: [
507: /ss arg1 def
508: ss 1 copy /ss set
509: ss (array) dc /ss2 set
510: 0 1 ss2 length 1 sub {
511: /i set
512: ss2 i get 32 eq { %% equal to space
513: ss i (,) put
514: } { } ifelse
515: } for
516: ss message
517: [ ss to_records pop] /arg1 set
518: ] pop
519: popVariables
520: arg1
521: } def
522:
523: /askToSendFile {
524: /arg1 set
525: [/in-askToSendFile /ss /fname] pushVariables
526: [
527: /ss arg1 def
528: /fname null def
529: ss toTokensBySpace /ss set
530: ss 0 get (GET) eq {
531: ss 1 get length 1 gt {
532: ss 1 get (array) dc 1 get 63 eq { %% See if /?
533: /fname null def
534: }{
535: /fname ss 1 get def % set the file name.
536: fname (array) dc rest /fname set % remove /
537: fname { (string) dc } map cat /fname set
538: } ifelse
539: }{ /fname null def } ifelse
540: }{
541: /fname null def
542: } ifelse
543: (::::) messagen ss message fname message
544: /arg1 fname def
545: ] pop
546: popVariables
547: arg1
548: } def
1.1 takayama 549:
550: %% remove GET /?msg=
551: /removeGET {
552: /arg1 set
553: [/in-removeGET /s /s2 /i /j /i0
554: /tname
555: ] pushVariables
556: [
557: /s arg1 def
558: /httpd.textarea.valid 1 def
559: s 1 copy /s2 set
560: s (array) dc /s set
561:
562: /tname [ ] def
563: 0 1 s length 1 sub {
564: /i0 set
565: s i0 get 61 eq { %% 61 is =
566: i0 1 add /i0 set
567: tname message
568: httpd.textarea.name.aaa message
569: tname httpd.textarea.name.aaa eq {
570: /httpd.textarea.valid 1 def
571: } {
572: /httpd.textarea.valid 0 def
573: (Warning: got an invalid name for the text field.) message
574: } ifelse
575: exit
576: } { } ifelse
577: tname s i0 get append /tname set
578: } for
579:
580: /j 0 def
581: i0 1 s length 1 sub {
582: /i set
583: s2 j << s i get (string) dc >> put
584: j 1 add /j set
585: } for
586: /arg1 s2 def
587: ] pop
588: arg1
589: } def
590:
591: /webstringToAscii {
592: /arg1 set
593: [/in-webstringToAscii /s /i /j /c /n] pushVariables
594: [
595: /s arg1 def
596: s (array) dc /s set
597: /j 0 def /n s length def
598: /i 0 def
599: {
600: s i get /c set
601: c 32 eq { exit } { } ifelse
602: c 37 eq { % c == %
603: [s i 1 add get s i 2 add get] fromHex /c set
604: s j c put
605: j 1 add /j set
606: i 3 add /i set
607: } {
608: c 43 eq { % c == +
609: s j 32 put
610: j 1 add /j set
611: i 1 add /i set
612: } {
613: c 13 eq { % c == 0xd
614: i 1 add /i set
615: } {
616: s j c put
617: j 1 add /j set
618: i 1 add /i set
619: } ifelse
620: } ifelse
621: } ifelse
622: i n ge { exit } { } ifelse
623: } loop
624: s j carN /s set
625: s { (string) dc } map cat /arg1 set
626: ] pop
627: popVariables
628: arg1
629: } def
630:
631: /preformatHTML {
632: /arg1 set
633: [/in-preformatHTML /sss /c] pushVariables
634: [
635: /sss arg1 def
636: sss (array) dc /sss set
637: sss {
638: /c set
639: [
640: c 60 eq {
641: /c (<) def
642: } { } ifelse
643: c 62 eq {
644: /c (>) def
645: } { } ifelse
646: c 38 eq {
647: /c (&) def
648: } { } ifelse
649: ] pop
650: c (string) dc
651: } map cat /sss set
652: [(<pre> ) sss ( </pre> )] cat /arg1 set
653: ] pop
654: popVariables
655: arg1
656: } def
657:
658: /metaCommand {
659: /arg1 set
660: [/in-metaCommand /msg /result] pushVariables
661: [
662: /msg arg1 def
663: /result 1 def
664: msg (httpdAsirMeta quit) eq {
665: ox.ccc ( quit ) oxsubmit
666: ox.ccc oxshutdown
667: send-page-bye
668: quit
669: /result 0 def
670: } { } ifelse
671: msg (httpdAsirMeta save) eq {
672: send-page-save
673: /result 0 def
674: } { } ifelse
675: msg (httpdAsirMeta interrupt) eq {
676: ox.ccc oxreset
677: (Interrupted! <br>) send-page-3
678: /result 0 def
679: } { } ifelse
680: /arg1 result def
681: ] pop
682: popVariables
683: arg1
684: } 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