Annotation of OpenXM/src/kan96xx/Doc/httpd.sm1, Revision 1.7
1.7 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.6 2002/10/17 13:40:28 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:
325: %% remove GET /?msg=
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
371: j 1 add /j set
372: } for
373: /arg1 s2 def
374: ] pop
375: arg1
376: } def
377:
378: /webstringToAscii {
379: /arg1 set
380: [/in-webstringToAscii /s /i /j /c /n] pushVariables
381: [
382: /s arg1 def
383: s (array) dc /s set
384: /j 0 def /n s length def
385: /i 0 def
386: {
387: s i get /c set
388: c 32 eq { exit } { } ifelse
389: c 37 eq { % c == %
390: [s i 1 add get s i 2 add get] fromHex /c set
391: s j c put
392: j 1 add /j set
393: i 3 add /i set
394: } {
395: c 43 eq { % c == +
396: s j 32 put
397: j 1 add /j set
398: i 1 add /i set
399: } {
400: c 13 eq { % c == 0xd
401: i 1 add /i set
402: } {
403: s j c put
404: j 1 add /j set
405: i 1 add /i set
406: } ifelse
407: } ifelse
408: } ifelse
409: i n ge { exit } { } ifelse
410: } loop
411: s j carN /s set
412: s { (string) dc } map cat /arg1 set
413: ] pop
414: popVariables
415: arg1
416: } def
417:
418: /preformatHTML {
419: /arg1 set
420: [/in-preformatHTML /sss /c] pushVariables
421: [
422: /sss arg1 def
423: sss (array) dc /sss set
424: sss {
425: /c set
426: [
427: c 60 eq {
428: /c (<) def
429: } { } ifelse
430: c 62 eq {
431: /c (>) def
432: } { } ifelse
433: c 38 eq {
434: /c (&) def
435: } { } ifelse
436: ] pop
437: c (string) dc
438: } map cat /sss set
439: [(<pre> ) sss ( </pre> )] cat /arg1 set
440: ] pop
441: popVariables
442: arg1
443: } def
1.2 takayama 444:
1.3 takayama 445: /executeStringAndSelectInputFromBrowserAndOxserver {
446: /arg3 set
1.2 takayama 447: /arg2 set
448: /arg1 set
1.3 takayama 449: [/in-executeStringAndSelectInputFromBrowserAndOxserver
1.2 takayama 450: /oxserver.ccc
451: /command.to.oxserver
452: /sss.engine
453: /sss.web
454: /sss
455: /err
456: /httpd.result
1.3 takayama 457: /stringOrCmo
1.2 takayama 458: ] pushVariables
459: % Global var: httpd.server.fd
460: [
461: /oxserver.ccc arg1 def
462: /command.to.oxserver arg2 def
1.3 takayama 463: /stringOrCmo arg3 def
1.2 takayama 464: oxserver.ccc
465: command.to.oxserver
466: oxexecutestring ;
467:
468: [(oxReq) oxserver.ccc SM_dupErrors ] extension pop
469:
470: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
1.3 takayama 471: stringOrCmo (string) eq {
472: [(oxReq) oxserver.ccc SM_popString ] extension pop
473: }{
474: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
475: } ifelse
1.2 takayama 476: [(flush)] extension pop
477: %% Select inputs for interruption.
478: %% Wait by the spin lock.
479: {
480: [(oxMultiSelect) [oxserver.ccc] 1] extension 1 get 0 get
481: /sss.engine set
482: [(sm1.socket) (mselect)
483: [[httpd.server.fd 0 get] 1]
484: ] extension 0 get /sss.web set
485: /sss [sss.engine sss.web] def
486: sss.engine { exit } { } ifelse
487: sss.web { exit } { } ifelse
488: } loop
489: sss message
490:
491: sss 0 get {
492: [(oxGet) oxserver.ccc] extension /err set
493: [(oxGet) oxserver.ccc] extension /httpd.result set
494: } {
495: oxserver.ccc oxreset
496: oxserver.ccc ("computation is interrupted.";) oxexecutestring ;
497: oxserver.ccc oxpopstring
498: /httpd.result set
499: exit
500: } ifelse
501: (------------- result -------------) message
502: httpd.result message
503: (----------------------------------) message
504: ( ) message
505:
506: err message
507: err [ ] eq {
508: } {
509: oxserver.ccc cleanErrors
510: [httpd.result 10 (string) dc err toString] cat
511: /httpd.result set
512: } ifelse
513: /arg1 [err httpd.result] def
514: ] pop
515: popVariables
516: arg1
517: } 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