Annotation of OpenXM/src/kan96xx/Doc/httpd-sm1.sm1, Revision 1.5
1.5 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-sm1.sm1,v 1.4 2001/08/12 07:20:37 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
1.5 ! takayama 355: ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/kan96xx/onlinehelp/index.html")
1.1 takayama 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
1.5 ! takayama 361: ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/kan96xx/ttt/index.html")
1.1 takayama 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="blue">
381: <a href=) httpd.asir.intro ( > Intro (Ja) </a> </font>, )] cat sendln
382: } def
383:
384: /send-page-save {
385: [/in-send-page-save /i] pushVariables
386: [
387: (HTTP/0.9 200 OK) sendln
388: (Connection: close) sendln
389: (Content-Type: text/plain) sendln
390: 0 sendln
391: [37 (string) dc ( Saved the following to sm1out.txt )] cat sendln
392: [37 (string) dc ( Save the following by your browser as a text file. )]
393: cat sendln
394:
395: 0 1 httpd.history length 1 sub {
396: /i set
397: httpd.history i get sendln
398: } for
399: ( ) sendln
400: 0 sendln
401: [(flush)] extension
402: [(PrintDollar) 1] system_variable
403: httpd.history output
404: [(PrintDollar) 0] system_variable
405: ] pop
406: popVariables
407: } def
408:
409: /send-page-warning {
410: (HTTP/0.9 200 OK) sendln
411: (Connection: close) sendln
412: (Content-Type: text/html) sendln
413: 0 sendln
414: (You cannot execute ox_sm1 without a session key! <br>) sendln
415: 0 sendln
416: [(flush)] extension
417: } def
418:
419: /stopclient {
420: [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
421: } def
422:
423:
424: /cleanErrors {
425: /arg1 set
426: [/in-cleanErrors /clientt /spp] pushVariables
427: [
428: /clientt arg1 def
429: clientt oxgetsp (integer) dc /spp set
430: clientt spp oxpops
431: ] pop
432: popVariables
433: } def
434:
435:
436: /fromHex {
437: /arg1 set
438: [/in-fromHex /s1 /s2 /c /c2] pushVariables
439: [
440: arg1 0 get /s1 set
441: arg1 1 get /s2 set
442:
443: 48 s1 le s1 57 le and { % 0, ..., 9
444: s1 48 sub /c set
445: }{ } ifelse
446: 65 s1 le s1 70 le and { % A, ..., F
447: s1 65 sub 10 add /c set
448: }{ } ifelse
449: 97 s1 le s1 102 le and { % a, ..., f
450: s1 97 sub 10 add /c set
451: }{ } ifelse
452: c 16 mul /c set
453:
454: 48 s2 le s2 57 le and { % 0, ..., 9
455: s2 48 sub /c2 set
456: }{ } ifelse
457: 65 s2 le s2 70 le and { % A, ..., F
458: s2 65 sub 10 add /c2 set
459: }{ } ifelse
460: 97 s2 le s2 102 le and { % a, ..., f
461: s2 97 sub 10 add /c2 set
462: }{ } ifelse
463: c c2 add /arg1 set
464: ] pop
465: popVariables
466: arg1
467: } def
468:
469: /randomName {
470: [/in-randomName /sss /rrr ] pushVariables
471: [
472: %% Seed name
473: /sss [ 97 97 97 97 97 97 97 97 97 97 ] def %% 97 == 'a'
474: %% This procedure to generate port number might fail.
475: sss {
476: [
477: [(oxGenPass)] extension .. /rrr set
478: [(tdiv_qr) rrr (26)..] mpzext 1 get /rrr set
479: ] pop
480: rrr (integer) dc add
481: } map
482: /sss set
483: sss {(string) dc} map cat /arg1 set
484: ] pop
485: popVariables
486: arg1
487: } def
488:
489: (httpd.textarea.name) boundp { }
490: {
491: /httpd.textarea.name randomName def
492: /httpd.textarea.name.aaa
493: [(GET /?) httpd.textarea.name] cat
494: (array) dc
495: def
496: } ifelse
1.3 takayama 497:
498:
499: %% Decompose into tokens separated by a space.
500: %% (GET /hoge.jpeg ???) ---> [(GET) (/hoge.jpeg) (???)]
501: /toTokensBySpace {
502: /arg1 set
503: [/in-toTokesBySpace /ss /ss2 /i] pushVariables
504: [
505: /ss arg1 def
506: ss 1 copy /ss set
507: ss (array) dc /ss2 set
508: 0 1 ss2 length 1 sub {
509: /i set
510: ss2 i get 32 eq { %% equal to space
511: ss i (,) put
512: } { } ifelse
513: } for
514: ss message
515: [ ss to_records pop] /arg1 set
516: ] pop
517: popVariables
518: arg1
519: } def
520:
521: /askToSendFile {
522: /arg1 set
523: [/in-askToSendFile /ss /fname] pushVariables
524: [
525: /ss arg1 def
526: /fname null def
527: ss toTokensBySpace /ss set
528: ss 0 get (GET) eq {
529: ss 1 get length 1 gt {
530: ss 1 get (array) dc 1 get 63 eq { %% See if /?
531: /fname null def
532: }{
533: /fname ss 1 get def % set the file name.
534: fname (array) dc rest /fname set % remove /
535: fname { (string) dc } map cat /fname set
536: } ifelse
537: }{ /fname null def } ifelse
538: }{
539: /fname null def
540: } ifelse
541: (::::) messagen ss message fname message
542: /arg1 fname def
543: ] pop
544: popVariables
545: arg1
546: } def
1.1 takayama 547:
548: %% remove GET /?msg=
549: /removeGET {
550: /arg1 set
551: [/in-removeGET /s /s2 /i /j /i0
552: /tname
553: ] pushVariables
554: [
555: /s arg1 def
556: /httpd.textarea.valid 1 def
557: s 1 copy /s2 set
558: s (array) dc /s set
559:
560: /tname [ ] def
561: 0 1 s length 1 sub {
562: /i0 set
563: s i0 get 61 eq { %% 61 is =
564: i0 1 add /i0 set
565: tname message
566: httpd.textarea.name.aaa message
567: tname httpd.textarea.name.aaa eq {
568: /httpd.textarea.valid 1 def
569: } {
570: /httpd.textarea.valid 0 def
571: (Warning: got an invalid name for the text field.) message
572: } ifelse
573: exit
574: } { } ifelse
575: tname s i0 get append /tname set
576: } for
577:
578: /j 0 def
579: i0 1 s length 1 sub {
580: /i set
581: s2 j << s i get (string) dc >> put
582: j 1 add /j set
583: } for
584: /arg1 s2 def
585: ] pop
586: arg1
587: } def
588:
589: /webstringToAscii {
590: /arg1 set
591: [/in-webstringToAscii /s /i /j /c /n] pushVariables
592: [
593: /s arg1 def
594: s (array) dc /s set
595: /j 0 def /n s length def
596: /i 0 def
597: {
598: s i get /c set
599: c 32 eq { exit } { } ifelse
600: c 37 eq { % c == %
601: [s i 1 add get s i 2 add get] fromHex /c set
602: s j c put
603: j 1 add /j set
604: i 3 add /i set
605: } {
606: c 43 eq { % c == +
607: s j 32 put
608: j 1 add /j set
609: i 1 add /i set
610: } {
611: c 13 eq { % c == 0xd
612: i 1 add /i set
613: } {
614: s j c put
615: j 1 add /j set
616: i 1 add /i set
617: } ifelse
618: } ifelse
619: } ifelse
620: i n ge { exit } { } ifelse
621: } loop
622: s j carN /s set
623: s { (string) dc } map cat /arg1 set
624: ] pop
625: popVariables
626: arg1
627: } def
628:
629: /preformatHTML {
630: /arg1 set
631: [/in-preformatHTML /sss /c] pushVariables
632: [
633: /sss arg1 def
634: sss (array) dc /sss set
635: sss {
636: /c set
637: [
638: c 60 eq {
639: /c (<) def
640: } { } ifelse
641: c 62 eq {
642: /c (>) def
643: } { } ifelse
644: c 38 eq {
645: /c (&) def
646: } { } ifelse
647: ] pop
648: c (string) dc
649: } map cat /sss set
650: [(<pre> ) sss ( </pre> )] cat /arg1 set
651: ] pop
652: popVariables
653: arg1
654: } def
655:
656: /metaCommand {
657: /arg1 set
658: [/in-metaCommand /msg /result] pushVariables
659: [
660: /msg arg1 def
661: /result 1 def
662: msg (httpdAsirMeta quit) eq {
663: ox.ccc ( quit ) oxsubmit
664: ox.ccc oxshutdown
665: send-page-bye
666: quit
667: /result 0 def
668: } { } ifelse
669: msg (httpdAsirMeta save) eq {
670: send-page-save
671: /result 0 def
672: } { } ifelse
673: msg (httpdAsirMeta interrupt) eq {
674: ox.ccc oxreset
675: (Interrupted! <br>) send-page-3
676: /result 0 def
677: } { } ifelse
678: /arg1 result def
679: ] pop
680: popVariables
681: arg1
682: } 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