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