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