Annotation of OpenXM/src/kan96xx/Doc/httpd-sm1.sm1, Revision 1.3
1.3 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-sm1.sm1,v 1.2 2001/08/10 08:33:03 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
139: {
140: httpd_startserver ;
141: httpd_action ;
142: httpd_stopserver ;
143: (5 sleep) system
144: httpd.serial 1 add /httpd.serial set
145: } loop
146: } def
147:
148: /httpd_action {
149: [/in-httpd /ff /httpd.com /httpd.result /sss
1.3 ! takayama 150: /sss.engine /sss.web /err /httpd.sendFile
1.1 takayama 151: ] pushVariables
152: [
153: {
154: [(sm1.socket) (select) [httpd.server.fd 0 get -1]] extension
155: %% wait for ever
156: [(sm1.socket) (read) [httpd.server.fd 0 get ]] extension /ff set
157: ff length 0 eq {
158: (connection is closed.) message
159: }
160: {
161: (------------ start ----------------------) message
162: ff message
163: (-----------------------------------------) message
1.3 ! takayama 164: ff 1 copy askToSendFile /httpd.sendFile set
! 165: httpd.sendFile tag 0 eq {
! 166: ff removeGET webstringToAscii /httpd.com set
! 167: } {
! 168: /httpd.com (NONE) def
! 169: } ifelse
! 170: [(httpd.com=) httpd.com] cat message
! 171: (httpd.sendFile=) messagen httpd.sendFile message
1.1 takayama 172: (------------ end ----------------------) message
173: ( ) message
174: httpd.serial 0 eq {
175: /httpd.com httpd.initialization def
176: } { } ifelse
1.3 ! takayama 177: httpd.sendFile tag 0 eq { }
! 178: {
! 179: httpd.sendFile httpd.image.type send-image
! 180: exit %% exit the loop LOOP-A
! 181: } ifelse
1.1 takayama 182: httpd.com metaCommand {
183: httpd.textarea.valid {
184: ox.ccc
185: [ httpd.com ] cat
186: oxexecutestring ;
187: }{
188: send-page-warning exit
189: } ifelse
190: [(oxReq) ox.ccc SM_dupErrors ] extension pop
191:
192: [(oxReq) ox.ccc SM_popCMO ] extension pop
193: [(oxReq) ox.ccc SM_popString ] extension pop
194: [(flush)] extension pop
195: %% Select inputs for interruption.
196: %% Wait by the spin lock.
197: {
198: [(oxMultiSelect) [ox.ccc] 1] extension 1 get 0 get
199: /sss.engine set
200: [(sm1.socket) (mselect)
201: [[httpd.server.fd 0 get] 1]
202: ] extension 0 get /sss.web set
203: /sss [sss.engine sss.web] def
204: sss.engine { exit } { } ifelse
205: sss.web { exit } { } ifelse
206: } loop
207: sss message
208:
209: sss 0 get {
210: [(oxGet) ox.ccc] extension /err set
211: [(oxGet) ox.ccc] extension /httpd.result set
212: %% ox.ccc oxpopstring /httpd.result set
213: } {
214: ox.ccc oxreset
215: ox.ccc ("computation is interrupted.";) oxexecutestring ;
216: ox.ccc oxpopstring
217: /httpd.result set
218: exit
219: } ifelse
220: (------------- result -------------) message
221: httpd.result message
222: (----------------------------------) message
223: ( ) message
224:
225: err message
226: err [ ] eq {
227: /httpd.history
228: httpd.history
229: [10 (string) dc
230: 37 (string) dc httpd.serial toString
231: 10 (string) dc
232: httpd.com
233: ( ) %% add extra ;
234: ] cat
235: append
236: def
237: } {
238: ox.ccc cleanErrors
239: [httpd.result 10 (string) dc err toString] cat
240: /httpd.result set
241: } ifelse
242:
243: [httpd.serial 0 eq { } {
244: (<title> Web/sm1 </title> )
245: (<font color="blue"> Input-) httpd.serial toString
246: (: </font> )
247: httpd.com preformatHTML (<br>)
248: } ifelse
249: (<font color="green"> Output-) httpd.serial toString
250: (: </font> )
1.3 ! takayama 251: (<a href=") httpd.image.name ("> (in pretty format) </a>) %%test
1.1 takayama 252: httpd.result preformatHTML
253: ] cat
1.3 ! takayama 254: send-page-3 exit %% exit the loop LOOP-A
1.1 takayama 255: } { exit } ifelse %% metaCommand
256: } ifelse
1.3 ! takayama 257: } loop %% LOOP-A
1.1 takayama 258: ] pop
259: popVariables
260: } def
261:
262:
263: /send-page-bye {
264: (HTTP/0.9 200 OK) sendln
265: %% (Date: Sun, 18 Mar 2001 02:54:50 GMT) sendln
266: %% (Server: sm1/0.1 (Unix)) sendln
267: %% (Last-Modified: Wed, 23 Aug 2000 11:19:27 GMT) sendln
268: %% (ETag: "1f8f-5df-39a3b33f") sendln
269: %% (Accept-Ranges: bytes) sendln
270: %% (Content-Length: 10) sendln
271: (Connection: close) sendln
272: % (Content-Type: text/plain) sendln
273: (Content-Type: text/html) sendln
274: 0 sendln
275: (<html>) sendln
276: (Shutdown the engine. <br>) sendln
277: (See you! <a href="http://www.openxm.org"> Web/sm1 </a>) sendln
278: (</html>) sendln
279: 0 sendln
280: [(flush)] extension
281: } def
282:
283: /send-page-2 {
284: (HTTP/0.9 200 OK) sendln
285: %% (Content-Length: 10) sendln
286: (Connection: close) sendln
287: (Content-Type: text/html) sendln
288: 0 sendln
289: (<FORM NAME="myFORM">) sendln
290: (<INPUT TYPE="TEXT" NAME="Num">) sendln
291: (</FORM>) sendln
292: 0 sendln
293: [(flush)] extension
294: } def
295:
296: /send-page-3 {
297: /arg1 set
298: [/in-send-page-3 /result] pushVariables
299: [
300: /result arg1 def
301: (HTTP/0.9 200 OK) sendln
302: (Connection: close) sendln
303: (Content-Type: text/html) sendln
304: 0 sendln
305: %% (<FORM NAME="myFORM" METHOD="POST">) sendln
306: result sendln
1.3 ! takayama 307:
! 308: %%(<img src="hoge.jpeg"> <img>) sendln %%test. It does not work always?!
! 309: %%(<a href="hoge.jpeg"> Pretty format </a>) sendln %%test. It works.
! 310:
1.1 takayama 311: (<FORM NAME="myFORM">) sendln
312: (<INPUT TYPE=submit VALUE="submit">) sendln
313: [(<textarea name=) httpd.textarea.name
314: ( rows=10 cols="80" wrap="soft"></textarea>)] cat sendln
315: (</FORM>) sendln
316: send-menu-1
317: 0 sendln
318: [(flush)] extension
319: ] pop
320: popVariables
321: } def
322:
1.3 ! takayama 323: /send-image {
! 324: /arg2 set
! 325: /arg1 set
! 326: [/in-send-jpeg /fname /imagetype /ff /fsize] pushVariables
! 327: [
! 328: /fname arg1 def % set the jpeg file name.
! 329: /imagetype arg2 def % jpeg or gif
! 330: [(stat) fname] extension 0 get tag 0 eq {
! 331: (Warning (send-image): the file ) messagen fname messagen ( is not found.) message
! 332: /notFound goto
! 333: }{ }ifelse
! 334: [(stat) fname] extension 1 get 0 get toString /fsize set
! 335: (HTTP/1.1 200 OK) dup message sendln
! 336: (Server: httpd_sm1) dup message sendln
! 337: %% (ETag: "2197-bf6c-3b2d6541") sendln ???
! 338: (Accept-Ranges: bytes) dup message sendln
! 339: [(Content-Length: ) fsize] cat dup message sendln
! 340: (Connection: close) dup message sendln
! 341: [(Content-Type: image/) imagetype] cat dup message sendln
! 342: [(flush)] extension
! 343: 0 sendln
! 344: fname sendBinaryFile
! 345: 0 sendln
! 346: [(flush)] extension
! 347: /notFound
! 348: ] pop
! 349: popVariables
! 350: } def
! 351:
1.1 takayama 352: /httpd.sm1man
353: ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_toc.html")
354: def
355: /httpd.sm1man.index
356: ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_262.html#SEC262")
357: def
358: /httpd.asir.intro
359: ("http://www.math.sci.kobe-u.ac.jp/~taka/asir-book-html/main")
360: def
361: /send-menu-1 {
362:
363: (FILE:) sendln
364: [$<a href="http://localhost:$ httpd.port toString
365: $/?msg=httpdAsirMeta+quit"> Shutdown the sm1 server. </a>, $
366: ] cat sendln
367: %% [$<a href="http://localhost:$ httpd.port toString
368: %% $/?msg=httpdAsirMeta+interrupt"> interrupt </a>, $
369: %% ] cat sendln
370: [$<a href="http://localhost:$ httpd.port toString
371: $/?msg=httpdAsirMeta+save"> save. </a>, $
372: ] cat sendln
373: ( <spacer type=horizontal size=80> ) sendln
374:
375: (HELP:) sendln
376: [(<font color="red">
377: <a href=) httpd.sm1man ( > Sm1manual (Ja) </a> </font>, )] cat sendln
378: [(<font color="purple">
379: <a href=) httpd.sm1man.index ( > Index (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