Annotation of OpenXM/src/kan96xx/Doc/httpd.sm1, Revision 1.5
1.5 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.4 2001/08/29 11:18:57 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 ;
77: (5 sleep) system
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
96: (See you! <a href="http://www.openxm.org"> Web/sm1 </a>) sendln
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:
130: (<FORM NAME="myFORM">) sendln
131: (<INPUT TYPE=submit VALUE="submit">) sendln
132: [(<textarea name=) httpd.textarea.name
133: ( rows=10 cols="80" wrap="soft"></textarea>)] cat sendln
134: (</FORM>) sendln
135: send-menu-1
136: 0 sendln
137: [(flush)] extension
138: ] pop
139: popVariables
140: } def
141:
142: /send-image {
143: /arg2 set
144: /arg1 set
145: [/in-send-jpeg /fname /imagetype /ff /fsize] pushVariables
146: [
147: /fname arg1 def % set the jpeg file name.
148: /imagetype arg2 def % jpeg or gif
149: [(stat) fname] extension 0 get tag 0 eq {
150: (Warning (send-image): the file ) messagen fname messagen ( is not found.) message
151: /notFound goto
152: }{ }ifelse
153: [(stat) fname] extension 1 get 0 get toString /fsize set
154: (HTTP/1.1 200 OK) dup message sendln
155: (Server: httpd_sm1) dup message sendln
156: %% (ETag: "2197-bf6c-3b2d6541") sendln ???
157: (Accept-Ranges: bytes) dup message sendln
158: [(Content-Length: ) fsize] cat dup message sendln
159: (Connection: close) dup message sendln
160: [(Content-Type: image/) imagetype] cat dup message sendln
161: [(flush)] extension
162: 0 sendln
163: fname sendBinaryFile
164: 0 sendln
165: [(flush)] extension
166: /notFound
167: ] pop
168: popVariables
169: } def
170:
171: /send-page-warning {
172: (HTTP/0.9 200 OK) sendln
173: (Connection: close) sendln
174: (Content-Type: text/html) sendln
175: 0 sendln
176: (You cannot execute ox servers without a session key! <br>) sendln
1.5 ! takayama 177: 0 sendln
! 178: [(flush)] extension
! 179: } def
! 180:
! 181: /send-page-warning-image {
! 182: (HTTP/0.9 200 OK) sendln
! 183: (Connection: close) sendln
! 184: (Content-Type: text/html) sendln
! 185: 0 sendln
! 186: (Error: Image translation is not supported on this server<br>) sendln
! 187: ( Check the value of the environmental variable OpenXM_PSTOIMG_TYPE <br>) sendln
1.1 takayama 188: 0 sendln
189: [(flush)] extension
190: } def
191:
192: /stopclient {
193: [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
194: } def
195:
196:
197: /cleanErrors {
198: /arg1 set
199: [/in-cleanErrors /clientt /spp] pushVariables
200: [
201: /clientt arg1 def
202: clientt oxgetsp (integer) dc /spp set
203: clientt spp oxpops
204: ] pop
205: popVariables
206: } def
207:
208:
209: /fromHex {
210: /arg1 set
211: [/in-fromHex /s1 /s2 /c /c2] pushVariables
212: [
213: arg1 0 get /s1 set
214: arg1 1 get /s2 set
215:
216: 48 s1 le s1 57 le and { % 0, ..., 9
217: s1 48 sub /c set
218: }{ } ifelse
219: 65 s1 le s1 70 le and { % A, ..., F
220: s1 65 sub 10 add /c set
221: }{ } ifelse
222: 97 s1 le s1 102 le and { % a, ..., f
223: s1 97 sub 10 add /c set
224: }{ } ifelse
225: c 16 mul /c set
226:
227: 48 s2 le s2 57 le and { % 0, ..., 9
228: s2 48 sub /c2 set
229: }{ } ifelse
230: 65 s2 le s2 70 le and { % A, ..., F
231: s2 65 sub 10 add /c2 set
232: }{ } ifelse
233: 97 s2 le s2 102 le and { % a, ..., f
234: s2 97 sub 10 add /c2 set
235: }{ } ifelse
236: c c2 add /arg1 set
237: ] pop
238: popVariables
239: arg1
240: } def
241:
242: /randomName {
243: [/in-randomName /sss /rrr ] pushVariables
244: [
245: %% Seed name
246: /sss [ 97 97 97 97 97 97 97 97 97 97 ] def %% 97 == 'a'
247: %% This procedure to generate port number might fail.
248: sss {
249: [
250: [(oxGenPass)] extension .. /rrr set
251: [(tdiv_qr) rrr (26)..] mpzext 1 get /rrr set
252: ] pop
253: rrr (integer) dc add
254: } map
255: /sss set
256: sss {(string) dc} map cat /arg1 set
257: ] pop
258: popVariables
259: arg1
260: } def
261:
262: (httpd.textarea.name) boundp { }
263: {
264: /httpd.textarea.name randomName def
265: /httpd.textarea.name.aaa
266: [(GET /?) httpd.textarea.name] cat
267: (array) dc
268: def
269: } ifelse
270:
271:
272: %% Decompose into tokens separated by a space.
273: %% (GET /hoge.jpeg ???) ---> [(GET) (/hoge.jpeg) (???)]
274: /toTokensBySpace {
275: /arg1 set
276: [/in-toTokesBySpace /ss /ss2 /i] pushVariables
277: [
278: /ss arg1 def
279: ss 1 copy /ss set
280: ss (array) dc /ss2 set
281: 0 1 ss2 length 1 sub {
282: /i set
283: ss2 i get 32 eq { %% equal to space
284: ss i (,) put
285: } { } ifelse
286: } for
287: ss message
288: [ ss to_records pop] /arg1 set
289: ] pop
290: popVariables
291: arg1
292: } def
293:
294: /askToSendFile {
295: /arg1 set
296: [/in-askToSendFile /ss /fname] pushVariables
297: [
298: /ss arg1 def
299: /fname null def
300: ss toTokensBySpace /ss set
301: ss 0 get (GET) eq {
302: ss 1 get length 1 gt {
303: ss 1 get (array) dc 1 get 63 eq { %% See if /?
304: /fname null def
305: }{
306: /fname ss 1 get def % set the file name.
307: fname (array) dc rest /fname set % remove /
308: fname { (string) dc } map cat /fname set
309: } ifelse
310: }{ /fname null def } ifelse
311: }{
312: /fname null def
313: } ifelse
314: (::::) messagen ss message fname message
315: /arg1 fname def
316: ] pop
317: popVariables
318: arg1
319: } def
320:
321: %% remove GET /?msg=
322: /removeGET {
323: /arg1 set
324: [/in-removeGET /s /s2 /i /j /i0
325: /tname
326: ] pushVariables
327: [
328: /s arg1 def
329: /httpd.textarea.valid 1 def
330: s 1 copy /s2 set
331: s (array) dc /s set
332:
333: /tname [ ] def
334: 0 1 s length 1 sub {
335: /i0 set
336: s i0 get 61 eq { %% 61 is =
337: i0 1 add /i0 set
338: tname message
339: httpd.textarea.name.aaa message
340: tname httpd.textarea.name.aaa eq {
341: /httpd.textarea.valid 1 def
342: } {
343: /httpd.textarea.valid 0 def
344: (Warning: got an invalid name for the text field.) message
345: } ifelse
346: exit
347: } { } ifelse
348: tname s i0 get append /tname set
349: } for
350:
351: /j 0 def
352: i0 1 s length 1 sub {
353: /i set
354: s2 j << s i get (string) dc >> put
355: j 1 add /j set
356: } for
357: /arg1 s2 def
358: ] pop
359: arg1
360: } def
361:
362: /webstringToAscii {
363: /arg1 set
364: [/in-webstringToAscii /s /i /j /c /n] pushVariables
365: [
366: /s arg1 def
367: s (array) dc /s set
368: /j 0 def /n s length def
369: /i 0 def
370: {
371: s i get /c set
372: c 32 eq { exit } { } ifelse
373: c 37 eq { % c == %
374: [s i 1 add get s i 2 add get] fromHex /c set
375: s j c put
376: j 1 add /j set
377: i 3 add /i set
378: } {
379: c 43 eq { % c == +
380: s j 32 put
381: j 1 add /j set
382: i 1 add /i set
383: } {
384: c 13 eq { % c == 0xd
385: i 1 add /i set
386: } {
387: s j c put
388: j 1 add /j set
389: i 1 add /i set
390: } ifelse
391: } ifelse
392: } ifelse
393: i n ge { exit } { } ifelse
394: } loop
395: s j carN /s set
396: s { (string) dc } map cat /arg1 set
397: ] pop
398: popVariables
399: arg1
400: } def
401:
402: /preformatHTML {
403: /arg1 set
404: [/in-preformatHTML /sss /c] pushVariables
405: [
406: /sss arg1 def
407: sss (array) dc /sss set
408: sss {
409: /c set
410: [
411: c 60 eq {
412: /c (<) def
413: } { } ifelse
414: c 62 eq {
415: /c (>) def
416: } { } ifelse
417: c 38 eq {
418: /c (&) def
419: } { } ifelse
420: ] pop
421: c (string) dc
422: } map cat /sss set
423: [(<pre> ) sss ( </pre> )] cat /arg1 set
424: ] pop
425: popVariables
426: arg1
427: } def
1.2 takayama 428:
1.3 takayama 429: /executeStringAndSelectInputFromBrowserAndOxserver {
430: /arg3 set
1.2 takayama 431: /arg2 set
432: /arg1 set
1.3 takayama 433: [/in-executeStringAndSelectInputFromBrowserAndOxserver
1.2 takayama 434: /oxserver.ccc
435: /command.to.oxserver
436: /sss.engine
437: /sss.web
438: /sss
439: /err
440: /httpd.result
1.3 takayama 441: /stringOrCmo
1.2 takayama 442: ] pushVariables
443: % Global var: httpd.server.fd
444: [
445: /oxserver.ccc arg1 def
446: /command.to.oxserver arg2 def
1.3 takayama 447: /stringOrCmo arg3 def
1.2 takayama 448: oxserver.ccc
449: command.to.oxserver
450: oxexecutestring ;
451:
452: [(oxReq) oxserver.ccc SM_dupErrors ] extension pop
453:
454: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
1.3 takayama 455: stringOrCmo (string) eq {
456: [(oxReq) oxserver.ccc SM_popString ] extension pop
457: }{
458: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
459: } ifelse
1.2 takayama 460: [(flush)] extension pop
461: %% Select inputs for interruption.
462: %% Wait by the spin lock.
463: {
464: [(oxMultiSelect) [oxserver.ccc] 1] extension 1 get 0 get
465: /sss.engine set
466: [(sm1.socket) (mselect)
467: [[httpd.server.fd 0 get] 1]
468: ] extension 0 get /sss.web set
469: /sss [sss.engine sss.web] def
470: sss.engine { exit } { } ifelse
471: sss.web { exit } { } ifelse
472: } loop
473: sss message
474:
475: sss 0 get {
476: [(oxGet) oxserver.ccc] extension /err set
477: [(oxGet) oxserver.ccc] extension /httpd.result set
478: } {
479: oxserver.ccc oxreset
480: oxserver.ccc ("computation is interrupted.";) oxexecutestring ;
481: oxserver.ccc oxpopstring
482: /httpd.result set
483: exit
484: } ifelse
485: (------------- result -------------) message
486: httpd.result message
487: (----------------------------------) message
488: ( ) message
489:
490: err message
491: err [ ] eq {
492: } {
493: oxserver.ccc cleanErrors
494: [httpd.result 10 (string) dc err toString] cat
495: /httpd.result set
496: } ifelse
497: /arg1 [err httpd.result] def
498: ] pop
499: popVariables
500: arg1
501: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to httpd.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc