Annotation of OpenXM/src/kan96xx/Doc/httpd.sm1, Revision 1.16
1.16 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.15 2002/11/10 07:00:03 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
1.15 takayama 85: [(nobody)] extension pop
1.1 takayama 86: {
87: httpd_startserver ;
88: httpd_action ;
89: httpd_stopserver ;
1.12 takayama 90: httpd.take.log { (date) system } { } ifelse
1.6 takayama 91: % (sleep 2) system
1.1 takayama 92: httpd.serial 1 add /httpd.serial set
93: } loop
94: } def
95:
96: /send-page-bye {
97: (HTTP/0.9 200 OK) sendln
98: %% (Date: Sun, 18 Mar 2001 02:54:50 GMT) sendln
99: %% (Server: sm1/0.1 (Unix)) sendln
100: %% (Last-Modified: Wed, 23 Aug 2000 11:19:27 GMT) sendln
101: %% (ETag: "1f8f-5df-39a3b33f") sendln
102: %% (Accept-Ranges: bytes) sendln
103: %% (Content-Length: 10) sendln
104: (Connection: close) sendln
105: % (Content-Type: text/plain) sendln
106: (Content-Type: text/html) sendln
107: 0 sendln
108: (<html>) sendln
109: (Shutdown the engine. <br>) sendln
1.6 takayama 110: (See you! <a href="http://www.openxm.org"> Web/asir, Web/sm1 </a>) sendln
1.1 takayama 111: (</html>) sendln
112: 0 sendln
113: [(flush)] extension
114: } def
115:
116: /send-page-2 {
117: (HTTP/0.9 200 OK) sendln
118: %% (Content-Length: 10) sendln
119: (Connection: close) sendln
120: (Content-Type: text/html) sendln
121: 0 sendln
122: (<FORM NAME="myFORM">) sendln
123: (<INPUT TYPE="TEXT" NAME="Num">) sendln
124: (</FORM>) sendln
125: 0 sendln
126: [(flush)] extension
127: } def
128:
129: /send-page-3 {
130: /arg1 set
131: [/in-send-page-3 /result] pushVariables
132: [
133: /result arg1 def
134: (HTTP/0.9 200 OK) sendln
135: (Connection: close) sendln
136: (Content-Type: text/html) sendln
137: 0 sendln
138: %% (<FORM NAME="myFORM" METHOD="POST">) sendln
139: result sendln
140:
141: %%(<img src="hoge.jpeg"> <img>) sendln %%test. It does not work always?!
142: %%(<a href="hoge.jpeg"> Pretty format </a>) sendln %%test. It works.
143:
1.7 takayama 144: [(getenv) (OXWEB_POST)] extension tag 0 eq {
145: (<FORM NAME="myFORM">) sendln % use get
146: }{
147: (<FORM NAME="myFORM" METHOD="POST">) sendln
148: } ifelse
1.1 takayama 149: (<INPUT TYPE=submit VALUE="submit">) sendln
150: [(<textarea name=) httpd.textarea.name
151: ( rows=10 cols="80" wrap="soft"></textarea>)] cat sendln
152: (</FORM>) sendln
153: send-menu-1
154: 0 sendln
155: [(flush)] extension
156: ] pop
157: popVariables
158: } def
159:
160: /send-image {
161: /arg2 set
162: /arg1 set
163: [/in-send-jpeg /fname /imagetype /ff /fsize] pushVariables
164: [
165: /fname arg1 def % set the jpeg file name.
166: /imagetype arg2 def % jpeg or gif
167: [(stat) fname] extension 0 get tag 0 eq {
168: (Warning (send-image): the file ) messagen fname messagen ( is not found.) message
169: /notFound goto
170: }{ }ifelse
171: [(stat) fname] extension 1 get 0 get toString /fsize set
172: (HTTP/1.1 200 OK) dup message sendln
173: (Server: httpd_sm1) dup message sendln
174: %% (ETag: "2197-bf6c-3b2d6541") sendln ???
175: (Accept-Ranges: bytes) dup message sendln
176: [(Content-Length: ) fsize] cat dup message sendln
177: (Connection: close) dup message sendln
178: [(Content-Type: image/) imagetype] cat dup message sendln
179: [(flush)] extension
180: 0 sendln
181: fname sendBinaryFile
182: 0 sendln
183: [(flush)] extension
184: /notFound
185: ] pop
186: popVariables
187: } def
188:
189: /send-page-warning {
190: (HTTP/0.9 200 OK) sendln
191: (Connection: close) sendln
192: (Content-Type: text/html) sendln
193: 0 sendln
194: (You cannot execute ox servers without a session key! <br>) sendln
1.5 takayama 195: 0 sendln
196: [(flush)] extension
197: } def
198:
199: /send-page-warning-image {
200: (HTTP/0.9 200 OK) sendln
201: (Connection: close) sendln
202: (Content-Type: text/html) sendln
203: 0 sendln
204: (Error: Image translation is not supported on this server<br>) sendln
205: ( Check the value of the environmental variable OpenXM_PSTOIMG_TYPE <br>) sendln
1.1 takayama 206: 0 sendln
207: [(flush)] extension
208: } def
209:
210: /stopclient {
211: [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
212: } def
213:
214:
215: /cleanErrors {
216: /arg1 set
217: [/in-cleanErrors /clientt /spp] pushVariables
218: [
219: /clientt arg1 def
220: clientt oxgetsp (integer) dc /spp set
221: clientt spp oxpops
222: ] pop
223: popVariables
224: } def
225:
226:
227: /fromHex {
228: /arg1 set
229: [/in-fromHex /s1 /s2 /c /c2] pushVariables
230: [
231: arg1 0 get /s1 set
232: arg1 1 get /s2 set
233:
234: 48 s1 le s1 57 le and { % 0, ..., 9
235: s1 48 sub /c set
236: }{ } ifelse
237: 65 s1 le s1 70 le and { % A, ..., F
238: s1 65 sub 10 add /c set
239: }{ } ifelse
240: 97 s1 le s1 102 le and { % a, ..., f
241: s1 97 sub 10 add /c set
242: }{ } ifelse
243: c 16 mul /c set
244:
245: 48 s2 le s2 57 le and { % 0, ..., 9
246: s2 48 sub /c2 set
247: }{ } ifelse
248: 65 s2 le s2 70 le and { % A, ..., F
249: s2 65 sub 10 add /c2 set
250: }{ } ifelse
251: 97 s2 le s2 102 le and { % a, ..., f
252: s2 97 sub 10 add /c2 set
253: }{ } ifelse
254: c c2 add /arg1 set
255: ] pop
256: popVariables
257: arg1
258: } def
259:
260: /randomName {
261: [/in-randomName /sss /rrr ] pushVariables
262: [
263: %% Seed name
264: /sss [ 97 97 97 97 97 97 97 97 97 97 ] def %% 97 == 'a'
265: %% This procedure to generate port number might fail.
266: sss {
267: [
268: [(oxGenPass)] extension .. /rrr set
269: [(tdiv_qr) rrr (26)..] mpzext 1 get /rrr set
270: ] pop
271: rrr (integer) dc add
272: } map
273: /sss set
274: sss {(string) dc} map cat /arg1 set
275: ] pop
276: popVariables
277: arg1
278: } def
279:
280: (httpd.textarea.name) boundp { }
281: {
282: /httpd.textarea.name randomName def
283: /httpd.textarea.name.aaa
284: [(GET /?) httpd.textarea.name] cat
285: (array) dc
286: def
287: } ifelse
288:
289:
290:
291: /askToSendFile {
292: /arg1 set
293: [/in-askToSendFile /ss /fname] pushVariables
294: [
295: /ss arg1 def
296: /fname null def
297: ss toTokensBySpace /ss set
298: ss 0 get (GET) eq {
299: ss 1 get length 1 gt {
300: ss 1 get (array) dc 1 get 63 eq { %% See if /?
301: /fname null def
302: }{
303: /fname ss 1 get def % set the file name.
304: fname (array) dc rest /fname set % remove /
305: fname { (string) dc } map cat /fname set
306: } ifelse
307: }{ /fname null def } ifelse
308: }{
309: /fname null def
310: } ifelse
311: (::::) messagen ss message fname message
312: /arg1 fname def
313: ] pop
314: popVariables
315: arg1
316: } def
317:
1.8 takayama 318: %% remove GET /?msg= or msg=
1.1 takayama 319: /removeGET {
320: /arg1 set
321: [/in-removeGET /s /s2 /i /j /i0
1.11 takayama 322: /tname /nnn /sta
1.1 takayama 323: ] pushVariables
324: [
325: /s arg1 def
1.10 takayama 326: /httpd.textarea.valid 0 def
1.1 takayama 327: s 1 copy /s2 set
328: s (array) dc /s set
1.11 takayama 329:
330: /sta 0 def
331:
332: %% In case of POST, remove the HTTP header. cf. trouble for NS 6.0
333: s length 4 gt {
334: [s 0 get s 1 get s 2 get s 3 get] (POST) (array) dc eq {
335: 0 1 s length 4 sub {
336: /i0 set
337: /sta i0 def
338: [ s i0 get s i0 1 add get ] [ 10 10 ] eq
339: [ s i0 get s i0 1 add get s i0 2 add get s i0 3 add get]
340: [ 13 10 13 10] eq or
341: { exit } { } ifelse
342: } for
343: }{ } ifelse
344: } { } ifelse
345: (sta=) messagen sta message
1.7 takayama 346: /nnn httpd.textarea.name.aaa length 6 sub def
1.1 takayama 347:
348: /tname [ ] def
1.11 takayama 349: sta 1 s length 1 sub {
1.1 takayama 350: /i0 set
351: s i0 get 61 eq { %% 61 is =
352: i0 1 add /i0 set
1.7 takayama 353:
354: [
355: << tname length 1 sub >> -1
1.9 takayama 356: << tname length nnn sub >> dup 0 ge { } { pop 0 } ifelse
357: {
1.7 takayama 358: /i set
359: tname i get
360: } for
1.9 takayama 361: ] reverse /tname set
1.7 takayama 362: (GET /?) (array) dc tname join /tname set
363:
1.12 takayama 364: httpd.debug { httpd.textarea.name.aaa message } { } ifelse
1.1 takayama 365: tname httpd.textarea.name.aaa eq {
366: /httpd.textarea.valid 1 def
367: } {
368: /httpd.textarea.valid 0 def
1.12 takayama 369: tname message
1.7 takayama 370: httpd.textarea.name.aaa { (string) dc } map cat message
1.1 takayama 371: (Warning: got an invalid name for the text field.) message
372: } ifelse
373: exit
374: } { } ifelse
375: tname s i0 get append /tname set
376: } for
377:
378: /j 0 def
379: i0 1 s length 1 sub {
380: /i set
381: s2 j << s i get (string) dc >> put
1.8 takayama 382: j s2 length 1 sub lt { s2 j 1 add ( ) put } { } ifelse
383: %% might cause a BUG. It should be improved.
1.1 takayama 384: j 1 add /j set
385: } for
386: /arg1 s2 def
387: ] pop
388: arg1
389: } def
390:
391: /webstringToAscii {
392: /arg1 set
393: [/in-webstringToAscii /s /i /j /c /n] pushVariables
394: [
395: /s arg1 def
396: s (array) dc /s set
397: /j 0 def /n s length def
398: /i 0 def
399: {
400: s i get /c set
401: c 32 eq { exit } { } ifelse
402: c 37 eq { % c == %
403: [s i 1 add get s i 2 add get] fromHex /c set
404: s j c put
405: j 1 add /j set
406: i 3 add /i set
407: } {
408: c 43 eq { % c == +
409: s j 32 put
410: j 1 add /j set
411: i 1 add /i set
412: } {
413: c 13 eq { % c == 0xd
414: i 1 add /i set
415: } {
416: s j c put
417: j 1 add /j set
418: i 1 add /i set
419: } ifelse
420: } ifelse
421: } ifelse
422: i n ge { exit } { } ifelse
423: } loop
424: s j carN /s set
425: s { (string) dc } map cat /arg1 set
426: ] pop
427: popVariables
428: arg1
429: } def
430:
431: /preformatHTML {
432: /arg1 set
433: [/in-preformatHTML /sss /c] pushVariables
434: [
435: /sss arg1 def
436: sss (array) dc /sss set
437: sss {
438: /c set
439: [
440: c 60 eq {
441: /c (<) def
442: } { } ifelse
443: c 62 eq {
444: /c (>) def
445: } { } ifelse
446: c 38 eq {
447: /c (&) def
448: } { } ifelse
449: ] pop
450: c (string) dc
451: } map cat /sss set
452: [(<pre> ) sss ( </pre> )] cat /arg1 set
453: ] pop
454: popVariables
455: arg1
456: } def
1.2 takayama 457:
1.3 takayama 458: /executeStringAndSelectInputFromBrowserAndOxserver {
459: /arg3 set
1.2 takayama 460: /arg2 set
461: /arg1 set
1.3 takayama 462: [/in-executeStringAndSelectInputFromBrowserAndOxserver
1.2 takayama 463: /oxserver.ccc
464: /command.to.oxserver
465: /sss.engine
466: /sss.web
467: /sss
468: /err
469: /httpd.result
1.3 takayama 470: /stringOrCmo
1.2 takayama 471: ] pushVariables
472: % Global var: httpd.server.fd
473: [
474: /oxserver.ccc arg1 def
475: /command.to.oxserver arg2 def
1.3 takayama 476: /stringOrCmo arg3 def
1.2 takayama 477: oxserver.ccc
478: command.to.oxserver
479: oxexecutestring ;
480:
481: [(oxReq) oxserver.ccc SM_dupErrors ] extension pop
482:
483: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
1.3 takayama 484: stringOrCmo (string) eq {
485: [(oxReq) oxserver.ccc SM_popString ] extension pop
486: }{
487: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
488: } ifelse
1.2 takayama 489: [(flush)] extension pop
490: %% Select inputs for interruption.
491: %% Wait by the spin lock.
492: {
493: [(oxMultiSelect) [oxserver.ccc] 1] extension 1 get 0 get
494: /sss.engine set
495: [(sm1.socket) (mselect)
496: [[httpd.server.fd 0 get] 1]
497: ] extension 0 get /sss.web set
498: /sss [sss.engine sss.web] def
499: sss.engine { exit } { } ifelse
500: sss.web { exit } { } ifelse
501: } loop
502: sss message
503:
504: sss 0 get {
505: [(oxGet) oxserver.ccc] extension /err set
506: [(oxGet) oxserver.ccc] extension /httpd.result set
507: } {
508: oxserver.ccc oxreset
509: oxserver.ccc ("computation is interrupted.";) oxexecutestring ;
510: oxserver.ccc oxpopstring
511: /httpd.result set
512: exit
513: } ifelse
514: (------------- result -------------) message
515: httpd.result message
516: (----------------------------------) message
517: ( ) message
518:
519: err message
520: err [ ] eq {
521: } {
522: oxserver.ccc cleanErrors
523: [httpd.result 10 (string) dc err toString] cat
524: /httpd.result set
525: } ifelse
526: /arg1 [err httpd.result] def
527: ] pop
528: popVariables
529: arg1
1.13 takayama 530: } def
531:
532: % This function will be written in C in a future.
533: % [(httpd) (parseHTTP) string] extension
534: % [(GET) key-value-pair-1 key-value-pair-2 ...]
535: % [(POST) key-value-pair-1 key-value-pair-2 ...]
536: % [(GET-file) file-1 file2 ...]
537: % ex. (GET / HTT..) (GET /?rpc=1-2)
538: /httpd.parse {
539: /arg1 set
540: [/in-httpd.parse /s /s2 /sta /i0
541: /ans /getKeyword /j /tname /tvalue
542: ] pushVariables
543: [
544: /s arg1 def
545: s 1 copy /s2 set
546: s (array) dc /s set
547:
548: /sta 0 def
549: /getKeyword 0 def
550:
551: s length 7 lt {
552: /ans [(GET-file)] def
553: /httpd.exit goto
554: }{ } ifelse
555:
556: /ans [(GET)] def
557: [s 0 get s 1 get s 2 get s 3 get s 4 get s 5 get] (GET /?) (array) dc eq {
558: /sta 6 def
559: /getKeyword 1 def
560: }{
561: [s 0 get s 1 get s 2 get s 3 get s 4 get] (GET /) (array) dc eq {
562: /sta 5 def
563: }{
564: [s 0 get s 1 get s 2 get s 3 get] (GET ) (array) dc eq {
565: /ans [(GET-file)] def
566: /httpd.exit goto
567: } { /ans [ ] def /httpd.exit.goto } ifelse
568: } ifelse
569: }ifelse
570:
571: %% In case of POST, remove the HTTP header. cf. trouble for NS 6.0
572: [s 0 get s 1 get s 2 get s 3 get] (POST) (array) dc eq {
573: /ans [(POST) ] def
574: /getKeyword 1 def
575: 0 1 s length 4 sub {
576: /i0 set
577: /sta i0 def
578: [ s i0 get s i0 1 add get ] [ 10 10 ] eq
579: [ s i0 get s i0 1 add get s i0 2 add get s i0 3 add get]
580: [ 13 10 13 10] eq or
581: { exit } { } ifelse
582: } for
583: }{ } ifelse
584: (sta=) messagen sta message
585:
586: %% get file name
587: getKeyword not {
588: /tname [ ] def
589: sta 1 << s length 1 sub >> {
590: /i0 set
591: s i0 get 32 le { %% 32 is " "
592: exit
593: } { } ifelse
594: tname s i0 get append /tname set
595: } for
596: httpd.debug { (Filename is ) messagen tname {(string) dc } map message} { } ifelse
597: /ans [(GET-file) tname { (string) dc } map cat ] def
598: /httpd.exit goto
599: } { } ifelse
600:
601: /tname [ ] def
602: sta 1 << s length 1 sub >> {
603: /i0 set
604: s i0 get 61 eq { %% 61 is =
605: httpd.debug { tname message tname {(string) dc } map cat message} { } ifelse
606: i0 1 add /i0 set
607: exit
608: } { } ifelse
609: tname s i0 get append /tname set
610: } for
611:
1.15 takayama 612: %% Remove space and cr/lf from the key word.
613: [
614: 0 1 tname length 1 sub {
615: /j set
616: tname j get 36 le {
617: } {
618: tname j get
619: } ifelse
620: } for
621: ] /tname set
622:
1.13 takayama 623: /j 0 def
624: i0 1 s length 1 sub {
625: /i set
626: s2 j << s i get (string) dc >> put
627: j s2 length 1 sub lt { s2 j 1 add ( ) put } { } ifelse
628: %% might cause a BUG. It should be improved.
629: j 1 add /j set
630: } for
631: ans [tname {(string) dc} map cat
632: s2 webstringToAscii ] append
633: /ans set
634:
635: /httpd.exit
1.14 takayama 636: ans length 1 lt {
637: /ans [(Unknown)] def
638: } { } ifelse
1.13 takayama 639: /arg1 ans def
640: ] pop
641: popVariables
642: arg1
1.14 takayama 643: } def
644:
645: /httpd.root [(getenv) (OXWEB_HTTPD_ROOT)] extension def
646: %% /usr/local/www/data/ Assume slash!!
647:
648: % [(GET-file) (filename)] httpd_sendfile
649: % [(MSG) (message)] httpd_sendfile
650: /httpd_sendfile {
651: /arg1 set
652: [/in-htpd_sendfile /msg /fname /fname2
653: /fsize
654: ] pushVariables
655: [
656: /msg arg1 def
657: %% Send message. [(MSG) msg2 ...] httpd_sendfile
658: msg message
659: msg 0 get (MSG) eq {
660: (HTTP/0.9 200 OK) sendln
661: (Connection: close) sendln
662: (Content-Type: text/html) sendln
663: 0 sendln
664: msg rest { sendln } map
665: 0 sendln
666: [(flush)] extension
667: /httpd_sendfile.L1 goto
668: }{ } ifelse
669: %% Get a file message. [(GET-file) fname] httpd_sendfile
670: msg 0 get (GET-file) eq {
671: httpd.root tag 5 eq not {
672: [(MSG) (<h1> File transfer is not allowed on this server. </h1>)]
673: httpd_sendfile
674: /httpd_sendfile.L1 /httpd_sendfile.L1 goto
675: } { } ifelse
676: msg length 1 eq {
677: /fname (index.html) def
678: }{
679: /fname msg 1 get def
1.15 takayama 680: (fname=) messagen fname (array) dc message
1.14 takayama 681: fname tag 5 eq not {
682: [(MSG) (<h1> Invalid file name. </h1>)]
683: httpd_sendfile
684: /httpd_sendfile.L1 /httpd_sendfile.L1 goto
685: } { } ifelse
686: fname (array) dc /fname set
687: fname length 1 lt {
1.15 takayama 688: /fname (index.html) (array) dc def
1.14 takayama 689: } { } ifelse
690:
691: fname [47] eq {
692: /fname (index.html) (array) dc def
693: }{ } ifelse
694:
695: fname 0 get 47 eq { %% /
696: /fname fname rest def
697: } { } ifelse
698:
699: fname { (string) dc } map cat /fname set
700: } ifelse
701:
702: /fname2 fname def
703: [httpd.root fname2] cat /fname set
704: [(fname=) fname] cat message
1.15 takayama 705: fname httpd.check_name {
706: [(MSG) (Warning: invalid file name.)] httpd_sendfile
707: /httpd_sendfile.L1 /httpd_sendfile.L1 goto
708: } { } ifelse
1.14 takayama 709: [(stat) fname] extension 0 get tag 0 eq {
710: [(MSG) (Warning (sendfile): the file ) fname2 ( is not found.) ]
711: httpd_sendfile
712: /httpd_sendfile.L1 /httpd_sendfile.L1 goto
713: }{ }ifelse
714: [(stat) fname] extension 1 get 0 get toString /fsize set
715: (HTTP/1.1 200 OK) sendln
716: (Server: httpd_sm1) sendln
717: %% (ETag: "2197-bf6c-3b2d6541") sendln ???
718: (Accept-Ranges: bytes) sendln
719: [(Content-Length: ) fsize] cat sendln
720: (Connection: close) sendln
721: [(Content-Type: ) fname httpd_type] cat sendln
722: [(flush)] extension
723: 0 sendln
724: fname sendBinaryFile
725: 0 sendln
726: [(flush)] extension
727: 0 sendln
728: [(flush)] extension
729: /httpd_sendfile.L1 goto
730: }{
731: [(MSG) (Warning: unknown argument type for httpd_sendfile)]
732: httpd_sendfile
733: } ifelse
734: /httpd_sendfile.L1
735: ] pop
736: popVariables
737: } def
738:
739: /httpd_type {
740: /arg1 set
741: [/in-httpd_type /fname /ftype /i /ans] pushVariables
742: [
743: /fname arg1 def
744: fname (array) dc /fname set
745: fname reverse /fname set
746: [
747: 0 1 fname length 1 sub {
748: /i set
749: fname i get 46 eq { % '.'
750: exit
751: } { fname i get } ifelse
752: } for
753: ] /ftype set
754: ftype reverse {(string) dc} map cat /ftype set
755: /ans (text/plain) def
756: ftype (gif) eq {
757: /ans (image/gif) def
758: }{ } ifelse
759: ftype (jpeg) eq ftype (jpg) eq or {
760: /ans (image/jpeg) def
761: }{ } ifelse
762: ftype (png) eq {
763: /ans (image/png) def
764: }{ } ifelse
765: ftype (png) eq {
766: /ans (image/png) def
767: }{ } ifelse
768: ftype (html) eq ftype (htm) eq or {
769: /ans (text/html) def
770: } { } ifelse
771: ftype (txt) eq {
772: /ans (text/html) def
773: } { } ifelse
774: /arg1 ans def
775: ] pop
776: popVariables
777: arg1
778: } def
1.15 takayama 779:
780: /httpd.check_name {
781: /arg1 set
782: [/in-httpd.check_name /fname /invalid] pushVariables
783: [
784: /fname arg1 def
785: /invalid 0 def
786: [(regionMatches) fname [(..) (/.)]] extension 0 get -1 eq
787: {
788: } {
789: (The file name contains .. or /. ) message
790: /invalid 1 def /httpd.check_name.L1 /httpd.check_name.L1 goto
791: } ifelse
792: fname length 0 eq {
793: (Warning: empty file name.)
794: /invalid 1 def /httpd.check_name.L1 /httpd.check_name.L1 goto
795: }{ } ifelse
796: fname (array) dc 0 get 47 eq {
797: }{
798: (Warning: The first letter is not /) message
799: /invalid 1 def /httpd.check_name.L1 /httpd.check_name.L1 goto
800: } ifelse
801: /httpd.check_name.L1
802: /arg1 invalid def
803: ] pop
804: popVariables
805: arg1
806: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>