Annotation of OpenXM/src/kan96xx/Doc/httpd.sm1, Revision 1.8
1.8 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.7 2002/10/21 01:59:15 takayama Exp $
1.1 takayama 2: %% common modules for httpd on sm1.
1.2 takayama 3: /Oxserver_history_variable (Oxserver_history_variable_) def
1.4 takayama 4: /httpd.image.type
5: [(getenv) (OpenXM_PSTOIMG_TYPE)] extension
6: def
7:
1.2 takayama 8:
1.1 takayama 9: /httpd_startserver {
10: [(sm1.socket) (open) [httpd.port (localhost)]] extension
11: /httpd.server.fdAndPort set
12: (sm1.socket.open returns ) messagen httpd.server.fdAndPort message
13: [(sm1.socket) (accept) [httpd.server.fdAndPort 0 get]] extension
14: /httpd.server.fd set
15: (connected.) message
16: (sm1.socket.accept returns ) messagen httpd.server.fd message
17: } def
18:
19: /httpd_stopserver {
20: [(sm1.socket) (close) httpd.server.fd ] extension message
21: } def
22:
23: /send_packet {
24: /arg1 set
25: [(sm1.socket) (write) [httpd.server.fd 0 get arg1]] extension message
26: } def
27:
28: /sendln {
29: /arg1 set
30: [/in-sendln /mmm] pushVariables
31: [ arg1 /mmm set
32: mmm tag 5 eq {
33: [mmm 10 (string) dc] cat /mmm set
34: }{
35: 10 (string) dc /mmm set
36: } ifelse
37: [(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension {
38: (Warning (sendln): your peer closed the connection. Do not send the data.) message
39: } {
40: [(sm1.socket) (write) [httpd.server.fd 0 get mmm]] extension message
41: } ifelse
42: ] pop
43: popVariables
44: } def
45:
46: /sendBinaryFile {
47: /arg1 set
48: [/in-sendln /fname /fd /c /cdata] pushVariables
49: [ arg1 /fname set
50: [(sendBinaryFile: sending data) ] cat message
51: [(fp2openForRead) fname] extension /fd set fd message
52: fd 0 lt {
53: [(Error: sendBinaryFile: file ) fname ( is not found.)] cat message
54: /aaaa goto
55: } { } ifelse
56: [(fp2pushfile) fname] extension /cdata set
57: [(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension {
58: (Warning (sendBinaryFile): your peer closed the connection. Do not send the data.)
59: message
60: exit
61: } {
62: [(sm1.socket) (writeByte) [httpd.server.fd 0 get cdata]] extension pop
63: } ifelse
64: /aaaa
65: ] pop
66: popVariables
67: } def
68:
69: /httpd {
70: /httpd.serial 0 def
71: /httpd.history [ ] def
72: /httpd.result.history [ 0 ] def
73: {
74: httpd_startserver ;
75: httpd_action ;
76: httpd_stopserver ;
1.6 takayama 77: % (sleep 2) system
1.1 takayama 78: httpd.serial 1 add /httpd.serial set
79: } loop
80: } def
81:
82: /send-page-bye {
83: (HTTP/0.9 200 OK) sendln
84: %% (Date: Sun, 18 Mar 2001 02:54:50 GMT) sendln
85: %% (Server: sm1/0.1 (Unix)) sendln
86: %% (Last-Modified: Wed, 23 Aug 2000 11:19:27 GMT) sendln
87: %% (ETag: "1f8f-5df-39a3b33f") sendln
88: %% (Accept-Ranges: bytes) sendln
89: %% (Content-Length: 10) sendln
90: (Connection: close) sendln
91: % (Content-Type: text/plain) sendln
92: (Content-Type: text/html) sendln
93: 0 sendln
94: (<html>) sendln
95: (Shutdown the engine. <br>) sendln
1.6 takayama 96: (See you! <a href="http://www.openxm.org"> Web/asir, Web/sm1 </a>) sendln
1.1 takayama 97: (</html>) sendln
98: 0 sendln
99: [(flush)] extension
100: } def
101:
102: /send-page-2 {
103: (HTTP/0.9 200 OK) sendln
104: %% (Content-Length: 10) sendln
105: (Connection: close) sendln
106: (Content-Type: text/html) sendln
107: 0 sendln
108: (<FORM NAME="myFORM">) sendln
109: (<INPUT TYPE="TEXT" NAME="Num">) sendln
110: (</FORM>) sendln
111: 0 sendln
112: [(flush)] extension
113: } def
114:
115: /send-page-3 {
116: /arg1 set
117: [/in-send-page-3 /result] pushVariables
118: [
119: /result arg1 def
120: (HTTP/0.9 200 OK) sendln
121: (Connection: close) sendln
122: (Content-Type: text/html) sendln
123: 0 sendln
124: %% (<FORM NAME="myFORM" METHOD="POST">) sendln
125: result sendln
126:
127: %%(<img src="hoge.jpeg"> <img>) sendln %%test. It does not work always?!
128: %%(<a href="hoge.jpeg"> Pretty format </a>) sendln %%test. It works.
129:
1.7 takayama 130: [(getenv) (OXWEB_POST)] extension tag 0 eq {
131: (<FORM NAME="myFORM">) sendln % use get
132: }{
133: (<FORM NAME="myFORM" METHOD="POST">) sendln
134: } ifelse
1.1 takayama 135: (<INPUT TYPE=submit VALUE="submit">) sendln
136: [(<textarea name=) httpd.textarea.name
137: ( rows=10 cols="80" wrap="soft"></textarea>)] cat sendln
138: (</FORM>) sendln
139: send-menu-1
140: 0 sendln
141: [(flush)] extension
142: ] pop
143: popVariables
144: } def
145:
146: /send-image {
147: /arg2 set
148: /arg1 set
149: [/in-send-jpeg /fname /imagetype /ff /fsize] pushVariables
150: [
151: /fname arg1 def % set the jpeg file name.
152: /imagetype arg2 def % jpeg or gif
153: [(stat) fname] extension 0 get tag 0 eq {
154: (Warning (send-image): the file ) messagen fname messagen ( is not found.) message
155: /notFound goto
156: }{ }ifelse
157: [(stat) fname] extension 1 get 0 get toString /fsize set
158: (HTTP/1.1 200 OK) dup message sendln
159: (Server: httpd_sm1) dup message sendln
160: %% (ETag: "2197-bf6c-3b2d6541") sendln ???
161: (Accept-Ranges: bytes) dup message sendln
162: [(Content-Length: ) fsize] cat dup message sendln
163: (Connection: close) dup message sendln
164: [(Content-Type: image/) imagetype] cat dup message sendln
165: [(flush)] extension
166: 0 sendln
167: fname sendBinaryFile
168: 0 sendln
169: [(flush)] extension
170: /notFound
171: ] pop
172: popVariables
173: } def
174:
175: /send-page-warning {
176: (HTTP/0.9 200 OK) sendln
177: (Connection: close) sendln
178: (Content-Type: text/html) sendln
179: 0 sendln
180: (You cannot execute ox servers without a session key! <br>) sendln
1.5 takayama 181: 0 sendln
182: [(flush)] extension
183: } def
184:
185: /send-page-warning-image {
186: (HTTP/0.9 200 OK) sendln
187: (Connection: close) sendln
188: (Content-Type: text/html) sendln
189: 0 sendln
190: (Error: Image translation is not supported on this server<br>) sendln
191: ( Check the value of the environmental variable OpenXM_PSTOIMG_TYPE <br>) sendln
1.1 takayama 192: 0 sendln
193: [(flush)] extension
194: } def
195:
196: /stopclient {
197: [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
198: } def
199:
200:
201: /cleanErrors {
202: /arg1 set
203: [/in-cleanErrors /clientt /spp] pushVariables
204: [
205: /clientt arg1 def
206: clientt oxgetsp (integer) dc /spp set
207: clientt spp oxpops
208: ] pop
209: popVariables
210: } def
211:
212:
213: /fromHex {
214: /arg1 set
215: [/in-fromHex /s1 /s2 /c /c2] pushVariables
216: [
217: arg1 0 get /s1 set
218: arg1 1 get /s2 set
219:
220: 48 s1 le s1 57 le and { % 0, ..., 9
221: s1 48 sub /c set
222: }{ } ifelse
223: 65 s1 le s1 70 le and { % A, ..., F
224: s1 65 sub 10 add /c set
225: }{ } ifelse
226: 97 s1 le s1 102 le and { % a, ..., f
227: s1 97 sub 10 add /c set
228: }{ } ifelse
229: c 16 mul /c set
230:
231: 48 s2 le s2 57 le and { % 0, ..., 9
232: s2 48 sub /c2 set
233: }{ } ifelse
234: 65 s2 le s2 70 le and { % A, ..., F
235: s2 65 sub 10 add /c2 set
236: }{ } ifelse
237: 97 s2 le s2 102 le and { % a, ..., f
238: s2 97 sub 10 add /c2 set
239: }{ } ifelse
240: c c2 add /arg1 set
241: ] pop
242: popVariables
243: arg1
244: } def
245:
246: /randomName {
247: [/in-randomName /sss /rrr ] pushVariables
248: [
249: %% Seed name
250: /sss [ 97 97 97 97 97 97 97 97 97 97 ] def %% 97 == 'a'
251: %% This procedure to generate port number might fail.
252: sss {
253: [
254: [(oxGenPass)] extension .. /rrr set
255: [(tdiv_qr) rrr (26)..] mpzext 1 get /rrr set
256: ] pop
257: rrr (integer) dc add
258: } map
259: /sss set
260: sss {(string) dc} map cat /arg1 set
261: ] pop
262: popVariables
263: arg1
264: } def
265:
266: (httpd.textarea.name) boundp { }
267: {
268: /httpd.textarea.name randomName def
269: /httpd.textarea.name.aaa
270: [(GET /?) httpd.textarea.name] cat
271: (array) dc
272: def
273: } ifelse
274:
275:
276: %% Decompose into tokens separated by a space.
277: %% (GET /hoge.jpeg ???) ---> [(GET) (/hoge.jpeg) (???)]
278: /toTokensBySpace {
279: /arg1 set
280: [/in-toTokesBySpace /ss /ss2 /i] pushVariables
281: [
282: /ss arg1 def
283: ss 1 copy /ss set
284: ss (array) dc /ss2 set
285: 0 1 ss2 length 1 sub {
286: /i set
287: ss2 i get 32 eq { %% equal to space
288: ss i (,) put
289: } { } ifelse
290: } for
291: ss message
292: [ ss to_records pop] /arg1 set
293: ] pop
294: popVariables
295: arg1
296: } def
297:
298: /askToSendFile {
299: /arg1 set
300: [/in-askToSendFile /ss /fname] pushVariables
301: [
302: /ss arg1 def
303: /fname null def
304: ss toTokensBySpace /ss set
305: ss 0 get (GET) eq {
306: ss 1 get length 1 gt {
307: ss 1 get (array) dc 1 get 63 eq { %% See if /?
308: /fname null def
309: }{
310: /fname ss 1 get def % set the file name.
311: fname (array) dc rest /fname set % remove /
312: fname { (string) dc } map cat /fname set
313: } ifelse
314: }{ /fname null def } ifelse
315: }{
316: /fname null def
317: } ifelse
318: (::::) messagen ss message fname message
319: /arg1 fname def
320: ] pop
321: popVariables
322: arg1
323: } def
324:
1.8 ! takayama 325: %% remove GET /?msg= or msg=
1.1 takayama 326: /removeGET {
327: /arg1 set
328: [/in-removeGET /s /s2 /i /j /i0
1.7 takayama 329: /tname /nnn
1.1 takayama 330: ] pushVariables
331: [
332: /s arg1 def
333: /httpd.textarea.valid 1 def
334: s 1 copy /s2 set
335: s (array) dc /s set
1.7 takayama 336: /nnn httpd.textarea.name.aaa length 6 sub def
1.1 takayama 337:
338: /tname [ ] def
339: 0 1 s length 1 sub {
340: /i0 set
341: s i0 get 61 eq { %% 61 is =
342: i0 1 add /i0 set
1.7 takayama 343:
344: [
345: << tname length 1 sub >> -1
346: << tname length nnn sub >> {
347: /i set
348: tname i get
349: } for
350: ] reverse /tname set
351: (GET /?) (array) dc tname join /tname set
352:
1.1 takayama 353: tname message
354: httpd.textarea.name.aaa message
355: tname httpd.textarea.name.aaa eq {
356: /httpd.textarea.valid 1 def
357: } {
358: /httpd.textarea.valid 0 def
1.7 takayama 359: httpd.textarea.name.aaa { (string) dc } map cat message
1.1 takayama 360: (Warning: got an invalid name for the text field.) message
361: } ifelse
362: exit
363: } { } ifelse
364: tname s i0 get append /tname set
365: } for
366:
367: /j 0 def
368: i0 1 s length 1 sub {
369: /i set
370: s2 j << s i get (string) dc >> put
1.8 ! takayama 371: j s2 length 1 sub lt { s2 j 1 add ( ) put } { } ifelse
! 372: %% might cause a BUG. It should be improved.
1.1 takayama 373: j 1 add /j set
374: } for
375: /arg1 s2 def
376: ] pop
377: arg1
378: } def
379:
380: /webstringToAscii {
381: /arg1 set
382: [/in-webstringToAscii /s /i /j /c /n] pushVariables
383: [
384: /s arg1 def
385: s (array) dc /s set
386: /j 0 def /n s length def
387: /i 0 def
388: {
389: s i get /c set
390: c 32 eq { exit } { } ifelse
391: c 37 eq { % c == %
392: [s i 1 add get s i 2 add get] fromHex /c set
393: s j c put
394: j 1 add /j set
395: i 3 add /i set
396: } {
397: c 43 eq { % c == +
398: s j 32 put
399: j 1 add /j set
400: i 1 add /i set
401: } {
402: c 13 eq { % c == 0xd
403: i 1 add /i set
404: } {
405: s j c put
406: j 1 add /j set
407: i 1 add /i set
408: } ifelse
409: } ifelse
410: } ifelse
411: i n ge { exit } { } ifelse
412: } loop
413: s j carN /s set
414: s { (string) dc } map cat /arg1 set
415: ] pop
416: popVariables
417: arg1
418: } def
419:
420: /preformatHTML {
421: /arg1 set
422: [/in-preformatHTML /sss /c] pushVariables
423: [
424: /sss arg1 def
425: sss (array) dc /sss set
426: sss {
427: /c set
428: [
429: c 60 eq {
430: /c (<) def
431: } { } ifelse
432: c 62 eq {
433: /c (>) def
434: } { } ifelse
435: c 38 eq {
436: /c (&) def
437: } { } ifelse
438: ] pop
439: c (string) dc
440: } map cat /sss set
441: [(<pre> ) sss ( </pre> )] cat /arg1 set
442: ] pop
443: popVariables
444: arg1
445: } def
1.2 takayama 446:
1.3 takayama 447: /executeStringAndSelectInputFromBrowserAndOxserver {
448: /arg3 set
1.2 takayama 449: /arg2 set
450: /arg1 set
1.3 takayama 451: [/in-executeStringAndSelectInputFromBrowserAndOxserver
1.2 takayama 452: /oxserver.ccc
453: /command.to.oxserver
454: /sss.engine
455: /sss.web
456: /sss
457: /err
458: /httpd.result
1.3 takayama 459: /stringOrCmo
1.2 takayama 460: ] pushVariables
461: % Global var: httpd.server.fd
462: [
463: /oxserver.ccc arg1 def
464: /command.to.oxserver arg2 def
1.3 takayama 465: /stringOrCmo arg3 def
1.2 takayama 466: oxserver.ccc
467: command.to.oxserver
468: oxexecutestring ;
469:
470: [(oxReq) oxserver.ccc SM_dupErrors ] extension pop
471:
472: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
1.3 takayama 473: stringOrCmo (string) eq {
474: [(oxReq) oxserver.ccc SM_popString ] extension pop
475: }{
476: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
477: } ifelse
1.2 takayama 478: [(flush)] extension pop
479: %% Select inputs for interruption.
480: %% Wait by the spin lock.
481: {
482: [(oxMultiSelect) [oxserver.ccc] 1] extension 1 get 0 get
483: /sss.engine set
484: [(sm1.socket) (mselect)
485: [[httpd.server.fd 0 get] 1]
486: ] extension 0 get /sss.web set
487: /sss [sss.engine sss.web] def
488: sss.engine { exit } { } ifelse
489: sss.web { exit } { } ifelse
490: } loop
491: sss message
492:
493: sss 0 get {
494: [(oxGet) oxserver.ccc] extension /err set
495: [(oxGet) oxserver.ccc] extension /httpd.result set
496: } {
497: oxserver.ccc oxreset
498: oxserver.ccc ("computation is interrupted.";) oxexecutestring ;
499: oxserver.ccc oxpopstring
500: /httpd.result set
501: exit
502: } ifelse
503: (------------- result -------------) message
504: httpd.result message
505: (----------------------------------) message
506: ( ) message
507:
508: err message
509: err [ ] eq {
510: } {
511: oxserver.ccc cleanErrors
512: [httpd.result 10 (string) dc err toString] cat
513: /httpd.result set
514: } ifelse
515: /arg1 [err httpd.result] def
516: ] pop
517: popVariables
518: arg1
519: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>