Annotation of OpenXM/src/kan96xx/Doc/httpd.sm1, Revision 1.11
1.11 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.10 2002/10/23 13:38:50 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.11 ! takayama 329: /tname /nnn /sta
1.1 takayama 330: ] pushVariables
331: [
332: /s arg1 def
1.10 takayama 333: /httpd.textarea.valid 0 def
1.1 takayama 334: s 1 copy /s2 set
335: s (array) dc /s set
1.11 ! takayama 336:
! 337: /sta 0 def
! 338:
! 339: %% In case of POST, remove the HTTP header. cf. trouble for NS 6.0
! 340: s length 4 gt {
! 341: [s 0 get s 1 get s 2 get s 3 get] (POST) (array) dc eq {
! 342: 0 1 s length 4 sub {
! 343: /i0 set
! 344: /sta i0 def
! 345: [ s i0 get s i0 1 add get ] [ 10 10 ] eq
! 346: [ s i0 get s i0 1 add get s i0 2 add get s i0 3 add get]
! 347: [ 13 10 13 10] eq or
! 348: { exit } { } ifelse
! 349: } for
! 350: }{ } ifelse
! 351: } { } ifelse
! 352: (sta=) messagen sta message
1.7 takayama 353: /nnn httpd.textarea.name.aaa length 6 sub def
1.1 takayama 354:
355: /tname [ ] def
1.11 ! takayama 356: sta 1 s length 1 sub {
1.1 takayama 357: /i0 set
358: s i0 get 61 eq { %% 61 is =
359: i0 1 add /i0 set
1.7 takayama 360:
361: [
362: << tname length 1 sub >> -1
1.9 takayama 363: << tname length nnn sub >> dup 0 ge { } { pop 0 } ifelse
364: {
1.7 takayama 365: /i set
366: tname i get
367: } for
1.9 takayama 368: ] reverse /tname set
1.7 takayama 369: (GET /?) (array) dc tname join /tname set
370:
1.1 takayama 371: httpd.textarea.name.aaa message
372: tname httpd.textarea.name.aaa eq {
373: /httpd.textarea.valid 1 def
374: } {
375: /httpd.textarea.valid 0 def
1.11 ! takayama 376: tname message
1.7 takayama 377: httpd.textarea.name.aaa { (string) dc } map cat message
1.1 takayama 378: (Warning: got an invalid name for the text field.) message
379: } ifelse
380: exit
381: } { } ifelse
382: tname s i0 get append /tname set
383: } for
384:
385: /j 0 def
386: i0 1 s length 1 sub {
387: /i set
388: s2 j << s i get (string) dc >> put
1.8 takayama 389: j s2 length 1 sub lt { s2 j 1 add ( ) put } { } ifelse
390: %% might cause a BUG. It should be improved.
1.1 takayama 391: j 1 add /j set
392: } for
393: /arg1 s2 def
394: ] pop
395: arg1
396: } def
397:
398: /webstringToAscii {
399: /arg1 set
400: [/in-webstringToAscii /s /i /j /c /n] pushVariables
401: [
402: /s arg1 def
403: s (array) dc /s set
404: /j 0 def /n s length def
405: /i 0 def
406: {
407: s i get /c set
408: c 32 eq { exit } { } ifelse
409: c 37 eq { % c == %
410: [s i 1 add get s i 2 add get] fromHex /c set
411: s j c put
412: j 1 add /j set
413: i 3 add /i set
414: } {
415: c 43 eq { % c == +
416: s j 32 put
417: j 1 add /j set
418: i 1 add /i set
419: } {
420: c 13 eq { % c == 0xd
421: i 1 add /i set
422: } {
423: s j c put
424: j 1 add /j set
425: i 1 add /i set
426: } ifelse
427: } ifelse
428: } ifelse
429: i n ge { exit } { } ifelse
430: } loop
431: s j carN /s set
432: s { (string) dc } map cat /arg1 set
433: ] pop
434: popVariables
435: arg1
436: } def
437:
438: /preformatHTML {
439: /arg1 set
440: [/in-preformatHTML /sss /c] pushVariables
441: [
442: /sss arg1 def
443: sss (array) dc /sss set
444: sss {
445: /c set
446: [
447: c 60 eq {
448: /c (<) def
449: } { } ifelse
450: c 62 eq {
451: /c (>) def
452: } { } ifelse
453: c 38 eq {
454: /c (&) def
455: } { } ifelse
456: ] pop
457: c (string) dc
458: } map cat /sss set
459: [(<pre> ) sss ( </pre> )] cat /arg1 set
460: ] pop
461: popVariables
462: arg1
463: } def
1.2 takayama 464:
1.3 takayama 465: /executeStringAndSelectInputFromBrowserAndOxserver {
466: /arg3 set
1.2 takayama 467: /arg2 set
468: /arg1 set
1.3 takayama 469: [/in-executeStringAndSelectInputFromBrowserAndOxserver
1.2 takayama 470: /oxserver.ccc
471: /command.to.oxserver
472: /sss.engine
473: /sss.web
474: /sss
475: /err
476: /httpd.result
1.3 takayama 477: /stringOrCmo
1.2 takayama 478: ] pushVariables
479: % Global var: httpd.server.fd
480: [
481: /oxserver.ccc arg1 def
482: /command.to.oxserver arg2 def
1.3 takayama 483: /stringOrCmo arg3 def
1.2 takayama 484: oxserver.ccc
485: command.to.oxserver
486: oxexecutestring ;
487:
488: [(oxReq) oxserver.ccc SM_dupErrors ] extension pop
489:
490: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
1.3 takayama 491: stringOrCmo (string) eq {
492: [(oxReq) oxserver.ccc SM_popString ] extension pop
493: }{
494: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
495: } ifelse
1.2 takayama 496: [(flush)] extension pop
497: %% Select inputs for interruption.
498: %% Wait by the spin lock.
499: {
500: [(oxMultiSelect) [oxserver.ccc] 1] extension 1 get 0 get
501: /sss.engine set
502: [(sm1.socket) (mselect)
503: [[httpd.server.fd 0 get] 1]
504: ] extension 0 get /sss.web set
505: /sss [sss.engine sss.web] def
506: sss.engine { exit } { } ifelse
507: sss.web { exit } { } ifelse
508: } loop
509: sss message
510:
511: sss 0 get {
512: [(oxGet) oxserver.ccc] extension /err set
513: [(oxGet) oxserver.ccc] extension /httpd.result set
514: } {
515: oxserver.ccc oxreset
516: oxserver.ccc ("computation is interrupted.";) oxexecutestring ;
517: oxserver.ccc oxpopstring
518: /httpd.result set
519: exit
520: } ifelse
521: (------------- result -------------) message
522: httpd.result message
523: (----------------------------------) message
524: ( ) message
525:
526: err message
527: err [ ] eq {
528: } {
529: oxserver.ccc cleanErrors
530: [httpd.result 10 (string) dc err toString] cat
531: /httpd.result set
532: } ifelse
533: /arg1 [err httpd.result] def
534: ] pop
535: popVariables
536: arg1
537: } 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