Annotation of OpenXM/src/kan96xx/Doc/httpd.sm1, Revision 1.4
1.4 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.3 2001/08/23 02:08:41 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
177: 0 sendln
178: [(flush)] extension
179: } def
180:
181: /stopclient {
182: [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
183: } def
184:
185:
186: /cleanErrors {
187: /arg1 set
188: [/in-cleanErrors /clientt /spp] pushVariables
189: [
190: /clientt arg1 def
191: clientt oxgetsp (integer) dc /spp set
192: clientt spp oxpops
193: ] pop
194: popVariables
195: } def
196:
197:
198: /fromHex {
199: /arg1 set
200: [/in-fromHex /s1 /s2 /c /c2] pushVariables
201: [
202: arg1 0 get /s1 set
203: arg1 1 get /s2 set
204:
205: 48 s1 le s1 57 le and { % 0, ..., 9
206: s1 48 sub /c set
207: }{ } ifelse
208: 65 s1 le s1 70 le and { % A, ..., F
209: s1 65 sub 10 add /c set
210: }{ } ifelse
211: 97 s1 le s1 102 le and { % a, ..., f
212: s1 97 sub 10 add /c set
213: }{ } ifelse
214: c 16 mul /c set
215:
216: 48 s2 le s2 57 le and { % 0, ..., 9
217: s2 48 sub /c2 set
218: }{ } ifelse
219: 65 s2 le s2 70 le and { % A, ..., F
220: s2 65 sub 10 add /c2 set
221: }{ } ifelse
222: 97 s2 le s2 102 le and { % a, ..., f
223: s2 97 sub 10 add /c2 set
224: }{ } ifelse
225: c c2 add /arg1 set
226: ] pop
227: popVariables
228: arg1
229: } def
230:
231: /randomName {
232: [/in-randomName /sss /rrr ] pushVariables
233: [
234: %% Seed name
235: /sss [ 97 97 97 97 97 97 97 97 97 97 ] def %% 97 == 'a'
236: %% This procedure to generate port number might fail.
237: sss {
238: [
239: [(oxGenPass)] extension .. /rrr set
240: [(tdiv_qr) rrr (26)..] mpzext 1 get /rrr set
241: ] pop
242: rrr (integer) dc add
243: } map
244: /sss set
245: sss {(string) dc} map cat /arg1 set
246: ] pop
247: popVariables
248: arg1
249: } def
250:
251: (httpd.textarea.name) boundp { }
252: {
253: /httpd.textarea.name randomName def
254: /httpd.textarea.name.aaa
255: [(GET /?) httpd.textarea.name] cat
256: (array) dc
257: def
258: } ifelse
259:
260:
261: %% Decompose into tokens separated by a space.
262: %% (GET /hoge.jpeg ???) ---> [(GET) (/hoge.jpeg) (???)]
263: /toTokensBySpace {
264: /arg1 set
265: [/in-toTokesBySpace /ss /ss2 /i] pushVariables
266: [
267: /ss arg1 def
268: ss 1 copy /ss set
269: ss (array) dc /ss2 set
270: 0 1 ss2 length 1 sub {
271: /i set
272: ss2 i get 32 eq { %% equal to space
273: ss i (,) put
274: } { } ifelse
275: } for
276: ss message
277: [ ss to_records pop] /arg1 set
278: ] pop
279: popVariables
280: arg1
281: } def
282:
283: /askToSendFile {
284: /arg1 set
285: [/in-askToSendFile /ss /fname] pushVariables
286: [
287: /ss arg1 def
288: /fname null def
289: ss toTokensBySpace /ss set
290: ss 0 get (GET) eq {
291: ss 1 get length 1 gt {
292: ss 1 get (array) dc 1 get 63 eq { %% See if /?
293: /fname null def
294: }{
295: /fname ss 1 get def % set the file name.
296: fname (array) dc rest /fname set % remove /
297: fname { (string) dc } map cat /fname set
298: } ifelse
299: }{ /fname null def } ifelse
300: }{
301: /fname null def
302: } ifelse
303: (::::) messagen ss message fname message
304: /arg1 fname def
305: ] pop
306: popVariables
307: arg1
308: } def
309:
310: %% remove GET /?msg=
311: /removeGET {
312: /arg1 set
313: [/in-removeGET /s /s2 /i /j /i0
314: /tname
315: ] pushVariables
316: [
317: /s arg1 def
318: /httpd.textarea.valid 1 def
319: s 1 copy /s2 set
320: s (array) dc /s set
321:
322: /tname [ ] def
323: 0 1 s length 1 sub {
324: /i0 set
325: s i0 get 61 eq { %% 61 is =
326: i0 1 add /i0 set
327: tname message
328: httpd.textarea.name.aaa message
329: tname httpd.textarea.name.aaa eq {
330: /httpd.textarea.valid 1 def
331: } {
332: /httpd.textarea.valid 0 def
333: (Warning: got an invalid name for the text field.) message
334: } ifelse
335: exit
336: } { } ifelse
337: tname s i0 get append /tname set
338: } for
339:
340: /j 0 def
341: i0 1 s length 1 sub {
342: /i set
343: s2 j << s i get (string) dc >> put
344: j 1 add /j set
345: } for
346: /arg1 s2 def
347: ] pop
348: arg1
349: } def
350:
351: /webstringToAscii {
352: /arg1 set
353: [/in-webstringToAscii /s /i /j /c /n] pushVariables
354: [
355: /s arg1 def
356: s (array) dc /s set
357: /j 0 def /n s length def
358: /i 0 def
359: {
360: s i get /c set
361: c 32 eq { exit } { } ifelse
362: c 37 eq { % c == %
363: [s i 1 add get s i 2 add get] fromHex /c set
364: s j c put
365: j 1 add /j set
366: i 3 add /i set
367: } {
368: c 43 eq { % c == +
369: s j 32 put
370: j 1 add /j set
371: i 1 add /i set
372: } {
373: c 13 eq { % c == 0xd
374: i 1 add /i set
375: } {
376: s j c put
377: j 1 add /j set
378: i 1 add /i set
379: } ifelse
380: } ifelse
381: } ifelse
382: i n ge { exit } { } ifelse
383: } loop
384: s j carN /s set
385: s { (string) dc } map cat /arg1 set
386: ] pop
387: popVariables
388: arg1
389: } def
390:
391: /preformatHTML {
392: /arg1 set
393: [/in-preformatHTML /sss /c] pushVariables
394: [
395: /sss arg1 def
396: sss (array) dc /sss set
397: sss {
398: /c set
399: [
400: c 60 eq {
401: /c (<) def
402: } { } ifelse
403: c 62 eq {
404: /c (>) def
405: } { } ifelse
406: c 38 eq {
407: /c (&) def
408: } { } ifelse
409: ] pop
410: c (string) dc
411: } map cat /sss set
412: [(<pre> ) sss ( </pre> )] cat /arg1 set
413: ] pop
414: popVariables
415: arg1
416: } def
1.2 takayama 417:
1.3 takayama 418: /executeStringAndSelectInputFromBrowserAndOxserver {
419: /arg3 set
1.2 takayama 420: /arg2 set
421: /arg1 set
1.3 takayama 422: [/in-executeStringAndSelectInputFromBrowserAndOxserver
1.2 takayama 423: /oxserver.ccc
424: /command.to.oxserver
425: /sss.engine
426: /sss.web
427: /sss
428: /err
429: /httpd.result
1.3 takayama 430: /stringOrCmo
1.2 takayama 431: ] pushVariables
432: % Global var: httpd.server.fd
433: [
434: /oxserver.ccc arg1 def
435: /command.to.oxserver arg2 def
1.3 takayama 436: /stringOrCmo arg3 def
1.2 takayama 437: oxserver.ccc
438: command.to.oxserver
439: oxexecutestring ;
440:
441: [(oxReq) oxserver.ccc SM_dupErrors ] extension pop
442:
443: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
1.3 takayama 444: stringOrCmo (string) eq {
445: [(oxReq) oxserver.ccc SM_popString ] extension pop
446: }{
447: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
448: } ifelse
1.2 takayama 449: [(flush)] extension pop
450: %% Select inputs for interruption.
451: %% Wait by the spin lock.
452: {
453: [(oxMultiSelect) [oxserver.ccc] 1] extension 1 get 0 get
454: /sss.engine set
455: [(sm1.socket) (mselect)
456: [[httpd.server.fd 0 get] 1]
457: ] extension 0 get /sss.web set
458: /sss [sss.engine sss.web] def
459: sss.engine { exit } { } ifelse
460: sss.web { exit } { } ifelse
461: } loop
462: sss message
463:
464: sss 0 get {
465: [(oxGet) oxserver.ccc] extension /err set
466: [(oxGet) oxserver.ccc] extension /httpd.result set
467: } {
468: oxserver.ccc oxreset
469: oxserver.ccc ("computation is interrupted.";) oxexecutestring ;
470: oxserver.ccc oxpopstring
471: /httpd.result set
472: exit
473: } ifelse
474: (------------- result -------------) message
475: httpd.result message
476: (----------------------------------) message
477: ( ) message
478:
479: err message
480: err [ ] eq {
481: } {
482: oxserver.ccc cleanErrors
483: [httpd.result 10 (string) dc err toString] cat
484: /httpd.result set
485: } ifelse
486: /arg1 [err httpd.result] def
487: ] pop
488: popVariables
489: arg1
490: } 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