Annotation of OpenXM/src/kan96xx/Doc/httpd.sm1, Revision 1.13
1.13 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.12 2002/10/30 13:23:06 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.12 takayama 8: [(getenv) (OXWEB_DEBUG)] extension tag 0 eq {
9: /httpd.debug 0 def
10: } {
11: /httpd.debug 1 def
12: } ifelse
13: [(getenv) (OXWEB_TAKE_LOG)] extension tag 0 eq {
14: /httpd.take.log 0 def
15: } {
16: /httpd.take.log 1 def
17: } ifelse
18:
1.2 takayama 19:
1.1 takayama 20: /httpd_startserver {
21: [(sm1.socket) (open) [httpd.port (localhost)]] extension
22: /httpd.server.fdAndPort set
23: (sm1.socket.open returns ) messagen httpd.server.fdAndPort message
24: [(sm1.socket) (accept) [httpd.server.fdAndPort 0 get]] extension
25: /httpd.server.fd set
26: (connected.) message
27: (sm1.socket.accept returns ) messagen httpd.server.fd message
28: } def
29:
30: /httpd_stopserver {
31: [(sm1.socket) (close) httpd.server.fd ] extension message
32: } def
33:
34: /send_packet {
35: /arg1 set
36: [(sm1.socket) (write) [httpd.server.fd 0 get arg1]] extension message
37: } def
38:
39: /sendln {
40: /arg1 set
1.12 takayama 41: [/in-sendln /mmm /i] pushVariables
1.1 takayama 42: [ arg1 /mmm set
43: mmm tag 5 eq {
44: [mmm 10 (string) dc] cat /mmm set
45: }{
46: 10 (string) dc /mmm set
47: } ifelse
48: [(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension {
49: (Warning (sendln): your peer closed the connection. Do not send the data.) message
50: } {
1.12 takayama 51: [(sm1.socket) (write) [httpd.server.fd 0 get mmm]] extension /i set
52: httpd.debug { i message } { } ifelse
1.1 takayama 53: } ifelse
54: ] pop
55: popVariables
56: } def
57:
58: /sendBinaryFile {
59: /arg1 set
60: [/in-sendln /fname /fd /c /cdata] pushVariables
61: [ arg1 /fname set
62: [(sendBinaryFile: sending data) ] cat message
63: [(fp2openForRead) fname] extension /fd set fd message
64: fd 0 lt {
65: [(Error: sendBinaryFile: file ) fname ( is not found.)] cat message
66: /aaaa goto
67: } { } ifelse
68: [(fp2pushfile) fname] extension /cdata set
69: [(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension {
70: (Warning (sendBinaryFile): your peer closed the connection. Do not send the data.)
71: message
72: exit
73: } {
74: [(sm1.socket) (writeByte) [httpd.server.fd 0 get cdata]] extension pop
75: } ifelse
76: /aaaa
77: ] pop
78: popVariables
79: } def
80:
81: /httpd {
82: /httpd.serial 0 def
83: /httpd.history [ ] def
84: /httpd.result.history [ 0 ] def
85: {
86: httpd_startserver ;
87: httpd_action ;
88: httpd_stopserver ;
1.12 takayama 89: httpd.take.log { (date) system } { } ifelse
1.6 takayama 90: % (sleep 2) system
1.1 takayama 91: httpd.serial 1 add /httpd.serial set
92: } loop
93: } def
94:
95: /send-page-bye {
96: (HTTP/0.9 200 OK) sendln
97: %% (Date: Sun, 18 Mar 2001 02:54:50 GMT) sendln
98: %% (Server: sm1/0.1 (Unix)) sendln
99: %% (Last-Modified: Wed, 23 Aug 2000 11:19:27 GMT) sendln
100: %% (ETag: "1f8f-5df-39a3b33f") sendln
101: %% (Accept-Ranges: bytes) sendln
102: %% (Content-Length: 10) sendln
103: (Connection: close) sendln
104: % (Content-Type: text/plain) sendln
105: (Content-Type: text/html) sendln
106: 0 sendln
107: (<html>) sendln
108: (Shutdown the engine. <br>) sendln
1.6 takayama 109: (See you! <a href="http://www.openxm.org"> Web/asir, Web/sm1 </a>) sendln
1.1 takayama 110: (</html>) sendln
111: 0 sendln
112: [(flush)] extension
113: } def
114:
115: /send-page-2 {
116: (HTTP/0.9 200 OK) sendln
117: %% (Content-Length: 10) sendln
118: (Connection: close) sendln
119: (Content-Type: text/html) sendln
120: 0 sendln
121: (<FORM NAME="myFORM">) sendln
122: (<INPUT TYPE="TEXT" NAME="Num">) sendln
123: (</FORM>) sendln
124: 0 sendln
125: [(flush)] extension
126: } def
127:
128: /send-page-3 {
129: /arg1 set
130: [/in-send-page-3 /result] pushVariables
131: [
132: /result arg1 def
133: (HTTP/0.9 200 OK) sendln
134: (Connection: close) sendln
135: (Content-Type: text/html) sendln
136: 0 sendln
137: %% (<FORM NAME="myFORM" METHOD="POST">) sendln
138: result sendln
139:
140: %%(<img src="hoge.jpeg"> <img>) sendln %%test. It does not work always?!
141: %%(<a href="hoge.jpeg"> Pretty format </a>) sendln %%test. It works.
142:
1.7 takayama 143: [(getenv) (OXWEB_POST)] extension tag 0 eq {
144: (<FORM NAME="myFORM">) sendln % use get
145: }{
146: (<FORM NAME="myFORM" METHOD="POST">) sendln
147: } ifelse
1.1 takayama 148: (<INPUT TYPE=submit VALUE="submit">) sendln
149: [(<textarea name=) httpd.textarea.name
150: ( rows=10 cols="80" wrap="soft"></textarea>)] cat sendln
151: (</FORM>) sendln
152: send-menu-1
153: 0 sendln
154: [(flush)] extension
155: ] pop
156: popVariables
157: } def
158:
159: /send-image {
160: /arg2 set
161: /arg1 set
162: [/in-send-jpeg /fname /imagetype /ff /fsize] pushVariables
163: [
164: /fname arg1 def % set the jpeg file name.
165: /imagetype arg2 def % jpeg or gif
166: [(stat) fname] extension 0 get tag 0 eq {
167: (Warning (send-image): the file ) messagen fname messagen ( is not found.) message
168: /notFound goto
169: }{ }ifelse
170: [(stat) fname] extension 1 get 0 get toString /fsize set
171: (HTTP/1.1 200 OK) dup message sendln
172: (Server: httpd_sm1) dup message sendln
173: %% (ETag: "2197-bf6c-3b2d6541") sendln ???
174: (Accept-Ranges: bytes) dup message sendln
175: [(Content-Length: ) fsize] cat dup message sendln
176: (Connection: close) dup message sendln
177: [(Content-Type: image/) imagetype] cat dup message sendln
178: [(flush)] extension
179: 0 sendln
180: fname sendBinaryFile
181: 0 sendln
182: [(flush)] extension
183: /notFound
184: ] pop
185: popVariables
186: } def
187:
188: /send-page-warning {
189: (HTTP/0.9 200 OK) sendln
190: (Connection: close) sendln
191: (Content-Type: text/html) sendln
192: 0 sendln
193: (You cannot execute ox servers without a session key! <br>) sendln
1.5 takayama 194: 0 sendln
195: [(flush)] extension
196: } def
197:
198: /send-page-warning-image {
199: (HTTP/0.9 200 OK) sendln
200: (Connection: close) sendln
201: (Content-Type: text/html) sendln
202: 0 sendln
203: (Error: Image translation is not supported on this server<br>) sendln
204: ( Check the value of the environmental variable OpenXM_PSTOIMG_TYPE <br>) sendln
1.1 takayama 205: 0 sendln
206: [(flush)] extension
207: } def
208:
209: /stopclient {
210: [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
211: } def
212:
213:
214: /cleanErrors {
215: /arg1 set
216: [/in-cleanErrors /clientt /spp] pushVariables
217: [
218: /clientt arg1 def
219: clientt oxgetsp (integer) dc /spp set
220: clientt spp oxpops
221: ] pop
222: popVariables
223: } def
224:
225:
226: /fromHex {
227: /arg1 set
228: [/in-fromHex /s1 /s2 /c /c2] pushVariables
229: [
230: arg1 0 get /s1 set
231: arg1 1 get /s2 set
232:
233: 48 s1 le s1 57 le and { % 0, ..., 9
234: s1 48 sub /c set
235: }{ } ifelse
236: 65 s1 le s1 70 le and { % A, ..., F
237: s1 65 sub 10 add /c set
238: }{ } ifelse
239: 97 s1 le s1 102 le and { % a, ..., f
240: s1 97 sub 10 add /c set
241: }{ } ifelse
242: c 16 mul /c set
243:
244: 48 s2 le s2 57 le and { % 0, ..., 9
245: s2 48 sub /c2 set
246: }{ } ifelse
247: 65 s2 le s2 70 le and { % A, ..., F
248: s2 65 sub 10 add /c2 set
249: }{ } ifelse
250: 97 s2 le s2 102 le and { % a, ..., f
251: s2 97 sub 10 add /c2 set
252: }{ } ifelse
253: c c2 add /arg1 set
254: ] pop
255: popVariables
256: arg1
257: } def
258:
259: /randomName {
260: [/in-randomName /sss /rrr ] pushVariables
261: [
262: %% Seed name
263: /sss [ 97 97 97 97 97 97 97 97 97 97 ] def %% 97 == 'a'
264: %% This procedure to generate port number might fail.
265: sss {
266: [
267: [(oxGenPass)] extension .. /rrr set
268: [(tdiv_qr) rrr (26)..] mpzext 1 get /rrr set
269: ] pop
270: rrr (integer) dc add
271: } map
272: /sss set
273: sss {(string) dc} map cat /arg1 set
274: ] pop
275: popVariables
276: arg1
277: } def
278:
279: (httpd.textarea.name) boundp { }
280: {
281: /httpd.textarea.name randomName def
282: /httpd.textarea.name.aaa
283: [(GET /?) httpd.textarea.name] cat
284: (array) dc
285: def
286: } ifelse
287:
288:
289: %% Decompose into tokens separated by a space.
290: %% (GET /hoge.jpeg ???) ---> [(GET) (/hoge.jpeg) (???)]
291: /toTokensBySpace {
292: /arg1 set
293: [/in-toTokesBySpace /ss /ss2 /i] pushVariables
294: [
295: /ss arg1 def
296: ss 1 copy /ss set
297: ss (array) dc /ss2 set
298: 0 1 ss2 length 1 sub {
299: /i set
300: ss2 i get 32 eq { %% equal to space
301: ss i (,) put
302: } { } ifelse
303: } for
1.12 takayama 304: httpd.debug { ss message } { } ifelse
1.1 takayama 305: [ ss to_records pop] /arg1 set
306: ] pop
307: popVariables
308: arg1
309: } def
310:
311: /askToSendFile {
312: /arg1 set
313: [/in-askToSendFile /ss /fname] pushVariables
314: [
315: /ss arg1 def
316: /fname null def
317: ss toTokensBySpace /ss set
318: ss 0 get (GET) eq {
319: ss 1 get length 1 gt {
320: ss 1 get (array) dc 1 get 63 eq { %% See if /?
321: /fname null def
322: }{
323: /fname ss 1 get def % set the file name.
324: fname (array) dc rest /fname set % remove /
325: fname { (string) dc } map cat /fname set
326: } ifelse
327: }{ /fname null def } ifelse
328: }{
329: /fname null def
330: } ifelse
331: (::::) messagen ss message fname message
332: /arg1 fname def
333: ] pop
334: popVariables
335: arg1
336: } def
337:
1.8 takayama 338: %% remove GET /?msg= or msg=
1.1 takayama 339: /removeGET {
340: /arg1 set
341: [/in-removeGET /s /s2 /i /j /i0
1.11 takayama 342: /tname /nnn /sta
1.1 takayama 343: ] pushVariables
344: [
345: /s arg1 def
1.10 takayama 346: /httpd.textarea.valid 0 def
1.1 takayama 347: s 1 copy /s2 set
348: s (array) dc /s set
1.11 takayama 349:
350: /sta 0 def
351:
352: %% In case of POST, remove the HTTP header. cf. trouble for NS 6.0
353: s length 4 gt {
354: [s 0 get s 1 get s 2 get s 3 get] (POST) (array) dc eq {
355: 0 1 s length 4 sub {
356: /i0 set
357: /sta i0 def
358: [ s i0 get s i0 1 add get ] [ 10 10 ] eq
359: [ s i0 get s i0 1 add get s i0 2 add get s i0 3 add get]
360: [ 13 10 13 10] eq or
361: { exit } { } ifelse
362: } for
363: }{ } ifelse
364: } { } ifelse
365: (sta=) messagen sta message
1.7 takayama 366: /nnn httpd.textarea.name.aaa length 6 sub def
1.1 takayama 367:
368: /tname [ ] def
1.11 takayama 369: sta 1 s length 1 sub {
1.1 takayama 370: /i0 set
371: s i0 get 61 eq { %% 61 is =
372: i0 1 add /i0 set
1.7 takayama 373:
374: [
375: << tname length 1 sub >> -1
1.9 takayama 376: << tname length nnn sub >> dup 0 ge { } { pop 0 } ifelse
377: {
1.7 takayama 378: /i set
379: tname i get
380: } for
1.9 takayama 381: ] reverse /tname set
1.7 takayama 382: (GET /?) (array) dc tname join /tname set
383:
1.12 takayama 384: httpd.debug { httpd.textarea.name.aaa message } { } ifelse
1.1 takayama 385: tname httpd.textarea.name.aaa eq {
386: /httpd.textarea.valid 1 def
387: } {
388: /httpd.textarea.valid 0 def
1.12 takayama 389: tname message
1.7 takayama 390: httpd.textarea.name.aaa { (string) dc } map cat message
1.1 takayama 391: (Warning: got an invalid name for the text field.) message
392: } ifelse
393: exit
394: } { } ifelse
395: tname s i0 get append /tname set
396: } for
397:
398: /j 0 def
399: i0 1 s length 1 sub {
400: /i set
401: s2 j << s i get (string) dc >> put
1.8 takayama 402: j s2 length 1 sub lt { s2 j 1 add ( ) put } { } ifelse
403: %% might cause a BUG. It should be improved.
1.1 takayama 404: j 1 add /j set
405: } for
406: /arg1 s2 def
407: ] pop
408: arg1
409: } def
410:
411: /webstringToAscii {
412: /arg1 set
413: [/in-webstringToAscii /s /i /j /c /n] pushVariables
414: [
415: /s arg1 def
416: s (array) dc /s set
417: /j 0 def /n s length def
418: /i 0 def
419: {
420: s i get /c set
421: c 32 eq { exit } { } ifelse
422: c 37 eq { % c == %
423: [s i 1 add get s i 2 add get] fromHex /c set
424: s j c put
425: j 1 add /j set
426: i 3 add /i set
427: } {
428: c 43 eq { % c == +
429: s j 32 put
430: j 1 add /j set
431: i 1 add /i set
432: } {
433: c 13 eq { % c == 0xd
434: i 1 add /i set
435: } {
436: s j c put
437: j 1 add /j set
438: i 1 add /i set
439: } ifelse
440: } ifelse
441: } ifelse
442: i n ge { exit } { } ifelse
443: } loop
444: s j carN /s set
445: s { (string) dc } map cat /arg1 set
446: ] pop
447: popVariables
448: arg1
449: } def
450:
451: /preformatHTML {
452: /arg1 set
453: [/in-preformatHTML /sss /c] pushVariables
454: [
455: /sss arg1 def
456: sss (array) dc /sss set
457: sss {
458: /c set
459: [
460: c 60 eq {
461: /c (<) def
462: } { } ifelse
463: c 62 eq {
464: /c (>) def
465: } { } ifelse
466: c 38 eq {
467: /c (&) def
468: } { } ifelse
469: ] pop
470: c (string) dc
471: } map cat /sss set
472: [(<pre> ) sss ( </pre> )] cat /arg1 set
473: ] pop
474: popVariables
475: arg1
476: } def
1.2 takayama 477:
1.3 takayama 478: /executeStringAndSelectInputFromBrowserAndOxserver {
479: /arg3 set
1.2 takayama 480: /arg2 set
481: /arg1 set
1.3 takayama 482: [/in-executeStringAndSelectInputFromBrowserAndOxserver
1.2 takayama 483: /oxserver.ccc
484: /command.to.oxserver
485: /sss.engine
486: /sss.web
487: /sss
488: /err
489: /httpd.result
1.3 takayama 490: /stringOrCmo
1.2 takayama 491: ] pushVariables
492: % Global var: httpd.server.fd
493: [
494: /oxserver.ccc arg1 def
495: /command.to.oxserver arg2 def
1.3 takayama 496: /stringOrCmo arg3 def
1.2 takayama 497: oxserver.ccc
498: command.to.oxserver
499: oxexecutestring ;
500:
501: [(oxReq) oxserver.ccc SM_dupErrors ] extension pop
502:
503: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
1.3 takayama 504: stringOrCmo (string) eq {
505: [(oxReq) oxserver.ccc SM_popString ] extension pop
506: }{
507: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
508: } ifelse
1.2 takayama 509: [(flush)] extension pop
510: %% Select inputs for interruption.
511: %% Wait by the spin lock.
512: {
513: [(oxMultiSelect) [oxserver.ccc] 1] extension 1 get 0 get
514: /sss.engine set
515: [(sm1.socket) (mselect)
516: [[httpd.server.fd 0 get] 1]
517: ] extension 0 get /sss.web set
518: /sss [sss.engine sss.web] def
519: sss.engine { exit } { } ifelse
520: sss.web { exit } { } ifelse
521: } loop
522: sss message
523:
524: sss 0 get {
525: [(oxGet) oxserver.ccc] extension /err set
526: [(oxGet) oxserver.ccc] extension /httpd.result set
527: } {
528: oxserver.ccc oxreset
529: oxserver.ccc ("computation is interrupted.";) oxexecutestring ;
530: oxserver.ccc oxpopstring
531: /httpd.result set
532: exit
533: } ifelse
534: (------------- result -------------) message
535: httpd.result message
536: (----------------------------------) message
537: ( ) message
538:
539: err message
540: err [ ] eq {
541: } {
542: oxserver.ccc cleanErrors
543: [httpd.result 10 (string) dc err toString] cat
544: /httpd.result set
545: } ifelse
546: /arg1 [err httpd.result] def
547: ] pop
548: popVariables
549: arg1
1.13 ! takayama 550: } def
! 551:
! 552: % This function will be written in C in a future.
! 553: % [(httpd) (parseHTTP) string] extension
! 554: % [(GET) key-value-pair-1 key-value-pair-2 ...]
! 555: % [(POST) key-value-pair-1 key-value-pair-2 ...]
! 556: % [(GET-file) file-1 file2 ...]
! 557: % ex. (GET / HTT..) (GET /?rpc=1-2)
! 558: /httpd.parse {
! 559: /arg1 set
! 560: [/in-httpd.parse /s /s2 /sta /i0
! 561: /ans /getKeyword /j /tname /tvalue
! 562: ] pushVariables
! 563: [
! 564: /s arg1 def
! 565: s 1 copy /s2 set
! 566: s (array) dc /s set
! 567:
! 568: /sta 0 def
! 569: /getKeyword 0 def
! 570:
! 571: s length 7 lt {
! 572: /ans [(GET-file)] def
! 573: /httpd.exit goto
! 574: }{ } ifelse
! 575:
! 576: /ans [(GET)] def
! 577: [s 0 get s 1 get s 2 get s 3 get s 4 get s 5 get] (GET /?) (array) dc eq {
! 578: /sta 6 def
! 579: /getKeyword 1 def
! 580: }{
! 581: [s 0 get s 1 get s 2 get s 3 get s 4 get] (GET /) (array) dc eq {
! 582: /sta 5 def
! 583: }{
! 584: [s 0 get s 1 get s 2 get s 3 get] (GET ) (array) dc eq {
! 585: /ans [(GET-file)] def
! 586: /httpd.exit goto
! 587: } { /ans [ ] def /httpd.exit.goto } ifelse
! 588: } ifelse
! 589: }ifelse
! 590:
! 591: %% In case of POST, remove the HTTP header. cf. trouble for NS 6.0
! 592: [s 0 get s 1 get s 2 get s 3 get] (POST) (array) dc eq {
! 593: /ans [(POST) ] def
! 594: /getKeyword 1 def
! 595: 0 1 s length 4 sub {
! 596: /i0 set
! 597: /sta i0 def
! 598: [ s i0 get s i0 1 add get ] [ 10 10 ] eq
! 599: [ s i0 get s i0 1 add get s i0 2 add get s i0 3 add get]
! 600: [ 13 10 13 10] eq or
! 601: { exit } { } ifelse
! 602: } for
! 603: }{ } ifelse
! 604: (sta=) messagen sta message
! 605:
! 606: %% get file name
! 607: getKeyword not {
! 608: /tname [ ] def
! 609: sta 1 << s length 1 sub >> {
! 610: /i0 set
! 611: s i0 get 32 le { %% 32 is " "
! 612: exit
! 613: } { } ifelse
! 614: tname s i0 get append /tname set
! 615: } for
! 616: httpd.debug { (Filename is ) messagen tname {(string) dc } map message} { } ifelse
! 617: /ans [(GET-file) tname { (string) dc } map cat ] def
! 618: /httpd.exit goto
! 619: } { } ifelse
! 620:
! 621: /tname [ ] def
! 622: sta 1 << s length 1 sub >> {
! 623: /i0 set
! 624: s i0 get 61 eq { %% 61 is =
! 625: httpd.debug { tname message tname {(string) dc } map cat message} { } ifelse
! 626: i0 1 add /i0 set
! 627: exit
! 628: } { } ifelse
! 629: tname s i0 get append /tname set
! 630: } for
! 631:
! 632: /j 0 def
! 633: i0 1 s length 1 sub {
! 634: /i set
! 635: s2 j << s i get (string) dc >> put
! 636: j s2 length 1 sub lt { s2 j 1 add ( ) put } { } ifelse
! 637: %% might cause a BUG. It should be improved.
! 638: j 1 add /j set
! 639: } for
! 640: ans [tname {(string) dc} map cat
! 641: s2 webstringToAscii ] append
! 642: /ans set
! 643:
! 644: /httpd.exit
! 645: /arg1 ans def
! 646: ] pop
! 647: popVariables
! 648: arg1
1.2 takayama 649: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>