Annotation of OpenXM/src/kan96xx/Doc/httpd.sm1, Revision 1.15
1.15 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpdsm1,v 1.14 2002/11/09 12:42:25 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: %% Decompose into tokens separated by a space.
291: %% (GET /hoge.jpeg ???) ---> [(GET) (/hoge.jpeg) (???)]
292: /toTokensBySpace {
293: /arg1 set
294: [/in-toTokesBySpace /ss /ss2 /i] pushVariables
295: [
296: /ss arg1 def
297: ss 1 copy /ss set
298: ss (array) dc /ss2 set
299: 0 1 ss2 length 1 sub {
300: /i set
301: ss2 i get 32 eq { %% equal to space
302: ss i (,) put
303: } { } ifelse
304: } for
1.12 takayama 305: httpd.debug { ss message } { } ifelse
1.1 takayama 306: [ ss to_records pop] /arg1 set
307: ] pop
308: popVariables
309: arg1
310: } def
311:
312: /askToSendFile {
313: /arg1 set
314: [/in-askToSendFile /ss /fname] pushVariables
315: [
316: /ss arg1 def
317: /fname null def
318: ss toTokensBySpace /ss set
319: ss 0 get (GET) eq {
320: ss 1 get length 1 gt {
321: ss 1 get (array) dc 1 get 63 eq { %% See if /?
322: /fname null def
323: }{
324: /fname ss 1 get def % set the file name.
325: fname (array) dc rest /fname set % remove /
326: fname { (string) dc } map cat /fname set
327: } ifelse
328: }{ /fname null def } ifelse
329: }{
330: /fname null def
331: } ifelse
332: (::::) messagen ss message fname message
333: /arg1 fname def
334: ] pop
335: popVariables
336: arg1
337: } def
338:
1.8 takayama 339: %% remove GET /?msg= or msg=
1.1 takayama 340: /removeGET {
341: /arg1 set
342: [/in-removeGET /s /s2 /i /j /i0
1.11 takayama 343: /tname /nnn /sta
1.1 takayama 344: ] pushVariables
345: [
346: /s arg1 def
1.10 takayama 347: /httpd.textarea.valid 0 def
1.1 takayama 348: s 1 copy /s2 set
349: s (array) dc /s set
1.11 takayama 350:
351: /sta 0 def
352:
353: %% In case of POST, remove the HTTP header. cf. trouble for NS 6.0
354: s length 4 gt {
355: [s 0 get s 1 get s 2 get s 3 get] (POST) (array) dc eq {
356: 0 1 s length 4 sub {
357: /i0 set
358: /sta i0 def
359: [ s i0 get s i0 1 add get ] [ 10 10 ] eq
360: [ s i0 get s i0 1 add get s i0 2 add get s i0 3 add get]
361: [ 13 10 13 10] eq or
362: { exit } { } ifelse
363: } for
364: }{ } ifelse
365: } { } ifelse
366: (sta=) messagen sta message
1.7 takayama 367: /nnn httpd.textarea.name.aaa length 6 sub def
1.1 takayama 368:
369: /tname [ ] def
1.11 takayama 370: sta 1 s length 1 sub {
1.1 takayama 371: /i0 set
372: s i0 get 61 eq { %% 61 is =
373: i0 1 add /i0 set
1.7 takayama 374:
375: [
376: << tname length 1 sub >> -1
1.9 takayama 377: << tname length nnn sub >> dup 0 ge { } { pop 0 } ifelse
378: {
1.7 takayama 379: /i set
380: tname i get
381: } for
1.9 takayama 382: ] reverse /tname set
1.7 takayama 383: (GET /?) (array) dc tname join /tname set
384:
1.12 takayama 385: httpd.debug { httpd.textarea.name.aaa message } { } ifelse
1.1 takayama 386: tname httpd.textarea.name.aaa eq {
387: /httpd.textarea.valid 1 def
388: } {
389: /httpd.textarea.valid 0 def
1.12 takayama 390: tname message
1.7 takayama 391: httpd.textarea.name.aaa { (string) dc } map cat message
1.1 takayama 392: (Warning: got an invalid name for the text field.) message
393: } ifelse
394: exit
395: } { } ifelse
396: tname s i0 get append /tname set
397: } for
398:
399: /j 0 def
400: i0 1 s length 1 sub {
401: /i set
402: s2 j << s i get (string) dc >> put
1.8 takayama 403: j s2 length 1 sub lt { s2 j 1 add ( ) put } { } ifelse
404: %% might cause a BUG. It should be improved.
1.1 takayama 405: j 1 add /j set
406: } for
407: /arg1 s2 def
408: ] pop
409: arg1
410: } def
411:
412: /webstringToAscii {
413: /arg1 set
414: [/in-webstringToAscii /s /i /j /c /n] pushVariables
415: [
416: /s arg1 def
417: s (array) dc /s set
418: /j 0 def /n s length def
419: /i 0 def
420: {
421: s i get /c set
422: c 32 eq { exit } { } ifelse
423: c 37 eq { % c == %
424: [s i 1 add get s i 2 add get] fromHex /c set
425: s j c put
426: j 1 add /j set
427: i 3 add /i set
428: } {
429: c 43 eq { % c == +
430: s j 32 put
431: j 1 add /j set
432: i 1 add /i set
433: } {
434: c 13 eq { % c == 0xd
435: i 1 add /i set
436: } {
437: s j c put
438: j 1 add /j set
439: i 1 add /i set
440: } ifelse
441: } ifelse
442: } ifelse
443: i n ge { exit } { } ifelse
444: } loop
445: s j carN /s set
446: s { (string) dc } map cat /arg1 set
447: ] pop
448: popVariables
449: arg1
450: } def
451:
452: /preformatHTML {
453: /arg1 set
454: [/in-preformatHTML /sss /c] pushVariables
455: [
456: /sss arg1 def
457: sss (array) dc /sss set
458: sss {
459: /c set
460: [
461: c 60 eq {
462: /c (<) def
463: } { } ifelse
464: c 62 eq {
465: /c (>) def
466: } { } ifelse
467: c 38 eq {
468: /c (&) def
469: } { } ifelse
470: ] pop
471: c (string) dc
472: } map cat /sss set
473: [(<pre> ) sss ( </pre> )] cat /arg1 set
474: ] pop
475: popVariables
476: arg1
477: } def
1.2 takayama 478:
1.3 takayama 479: /executeStringAndSelectInputFromBrowserAndOxserver {
480: /arg3 set
1.2 takayama 481: /arg2 set
482: /arg1 set
1.3 takayama 483: [/in-executeStringAndSelectInputFromBrowserAndOxserver
1.2 takayama 484: /oxserver.ccc
485: /command.to.oxserver
486: /sss.engine
487: /sss.web
488: /sss
489: /err
490: /httpd.result
1.3 takayama 491: /stringOrCmo
1.2 takayama 492: ] pushVariables
493: % Global var: httpd.server.fd
494: [
495: /oxserver.ccc arg1 def
496: /command.to.oxserver arg2 def
1.3 takayama 497: /stringOrCmo arg3 def
1.2 takayama 498: oxserver.ccc
499: command.to.oxserver
500: oxexecutestring ;
501:
502: [(oxReq) oxserver.ccc SM_dupErrors ] extension pop
503:
504: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
1.3 takayama 505: stringOrCmo (string) eq {
506: [(oxReq) oxserver.ccc SM_popString ] extension pop
507: }{
508: [(oxReq) oxserver.ccc SM_popCMO ] extension pop
509: } ifelse
1.2 takayama 510: [(flush)] extension pop
511: %% Select inputs for interruption.
512: %% Wait by the spin lock.
513: {
514: [(oxMultiSelect) [oxserver.ccc] 1] extension 1 get 0 get
515: /sss.engine set
516: [(sm1.socket) (mselect)
517: [[httpd.server.fd 0 get] 1]
518: ] extension 0 get /sss.web set
519: /sss [sss.engine sss.web] def
520: sss.engine { exit } { } ifelse
521: sss.web { exit } { } ifelse
522: } loop
523: sss message
524:
525: sss 0 get {
526: [(oxGet) oxserver.ccc] extension /err set
527: [(oxGet) oxserver.ccc] extension /httpd.result set
528: } {
529: oxserver.ccc oxreset
530: oxserver.ccc ("computation is interrupted.";) oxexecutestring ;
531: oxserver.ccc oxpopstring
532: /httpd.result set
533: exit
534: } ifelse
535: (------------- result -------------) message
536: httpd.result message
537: (----------------------------------) message
538: ( ) message
539:
540: err message
541: err [ ] eq {
542: } {
543: oxserver.ccc cleanErrors
544: [httpd.result 10 (string) dc err toString] cat
545: /httpd.result set
546: } ifelse
547: /arg1 [err httpd.result] def
548: ] pop
549: popVariables
550: arg1
1.13 takayama 551: } def
552:
553: % This function will be written in C in a future.
554: % [(httpd) (parseHTTP) string] extension
555: % [(GET) key-value-pair-1 key-value-pair-2 ...]
556: % [(POST) key-value-pair-1 key-value-pair-2 ...]
557: % [(GET-file) file-1 file2 ...]
558: % ex. (GET / HTT..) (GET /?rpc=1-2)
559: /httpd.parse {
560: /arg1 set
561: [/in-httpd.parse /s /s2 /sta /i0
562: /ans /getKeyword /j /tname /tvalue
563: ] pushVariables
564: [
565: /s arg1 def
566: s 1 copy /s2 set
567: s (array) dc /s set
568:
569: /sta 0 def
570: /getKeyword 0 def
571:
572: s length 7 lt {
573: /ans [(GET-file)] def
574: /httpd.exit goto
575: }{ } ifelse
576:
577: /ans [(GET)] def
578: [s 0 get s 1 get s 2 get s 3 get s 4 get s 5 get] (GET /?) (array) dc eq {
579: /sta 6 def
580: /getKeyword 1 def
581: }{
582: [s 0 get s 1 get s 2 get s 3 get s 4 get] (GET /) (array) dc eq {
583: /sta 5 def
584: }{
585: [s 0 get s 1 get s 2 get s 3 get] (GET ) (array) dc eq {
586: /ans [(GET-file)] def
587: /httpd.exit goto
588: } { /ans [ ] def /httpd.exit.goto } ifelse
589: } ifelse
590: }ifelse
591:
592: %% In case of POST, remove the HTTP header. cf. trouble for NS 6.0
593: [s 0 get s 1 get s 2 get s 3 get] (POST) (array) dc eq {
594: /ans [(POST) ] def
595: /getKeyword 1 def
596: 0 1 s length 4 sub {
597: /i0 set
598: /sta i0 def
599: [ s i0 get s i0 1 add get ] [ 10 10 ] eq
600: [ s i0 get s i0 1 add get s i0 2 add get s i0 3 add get]
601: [ 13 10 13 10] eq or
602: { exit } { } ifelse
603: } for
604: }{ } ifelse
605: (sta=) messagen sta message
606:
607: %% get file name
608: getKeyword not {
609: /tname [ ] def
610: sta 1 << s length 1 sub >> {
611: /i0 set
612: s i0 get 32 le { %% 32 is " "
613: exit
614: } { } ifelse
615: tname s i0 get append /tname set
616: } for
617: httpd.debug { (Filename is ) messagen tname {(string) dc } map message} { } ifelse
618: /ans [(GET-file) tname { (string) dc } map cat ] def
619: /httpd.exit goto
620: } { } ifelse
621:
622: /tname [ ] def
623: sta 1 << s length 1 sub >> {
624: /i0 set
625: s i0 get 61 eq { %% 61 is =
626: httpd.debug { tname message tname {(string) dc } map cat message} { } ifelse
627: i0 1 add /i0 set
628: exit
629: } { } ifelse
630: tname s i0 get append /tname set
631: } for
632:
1.15 ! takayama 633: %% Remove space and cr/lf from the key word.
! 634: [
! 635: 0 1 tname length 1 sub {
! 636: /j set
! 637: tname j get 36 le {
! 638: } {
! 639: tname j get
! 640: } ifelse
! 641: } for
! 642: ] /tname set
! 643:
1.13 takayama 644: /j 0 def
645: i0 1 s length 1 sub {
646: /i set
647: s2 j << s i get (string) dc >> put
648: j s2 length 1 sub lt { s2 j 1 add ( ) put } { } ifelse
649: %% might cause a BUG. It should be improved.
650: j 1 add /j set
651: } for
652: ans [tname {(string) dc} map cat
653: s2 webstringToAscii ] append
654: /ans set
655:
656: /httpd.exit
1.14 takayama 657: ans length 1 lt {
658: /ans [(Unknown)] def
659: } { } ifelse
1.13 takayama 660: /arg1 ans def
661: ] pop
662: popVariables
663: arg1
1.14 takayama 664: } def
665:
666: /httpd.root [(getenv) (OXWEB_HTTPD_ROOT)] extension def
667: %% /usr/local/www/data/ Assume slash!!
668:
669: % [(GET-file) (filename)] httpd_sendfile
670: % [(MSG) (message)] httpd_sendfile
671: /httpd_sendfile {
672: /arg1 set
673: [/in-htpd_sendfile /msg /fname /fname2
674: /fsize
675: ] pushVariables
676: [
677: /msg arg1 def
678: %% Send message. [(MSG) msg2 ...] httpd_sendfile
679: msg message
680: msg 0 get (MSG) eq {
681: (HTTP/0.9 200 OK) sendln
682: (Connection: close) sendln
683: (Content-Type: text/html) sendln
684: 0 sendln
685: msg rest { sendln } map
686: 0 sendln
687: [(flush)] extension
688: /httpd_sendfile.L1 goto
689: }{ } ifelse
690: %% Get a file message. [(GET-file) fname] httpd_sendfile
691: msg 0 get (GET-file) eq {
692: httpd.root tag 5 eq not {
693: [(MSG) (<h1> File transfer is not allowed on this server. </h1>)]
694: httpd_sendfile
695: /httpd_sendfile.L1 /httpd_sendfile.L1 goto
696: } { } ifelse
697: msg length 1 eq {
698: /fname (index.html) def
699: }{
700: /fname msg 1 get def
1.15 ! takayama 701: (fname=) messagen fname (array) dc message
1.14 takayama 702: fname tag 5 eq not {
703: [(MSG) (<h1> Invalid file name. </h1>)]
704: httpd_sendfile
705: /httpd_sendfile.L1 /httpd_sendfile.L1 goto
706: } { } ifelse
707: fname (array) dc /fname set
708: fname length 1 lt {
1.15 ! takayama 709: /fname (index.html) (array) dc def
1.14 takayama 710: } { } ifelse
711:
712: fname [47] eq {
713: /fname (index.html) (array) dc def
714: }{ } ifelse
715:
716: fname 0 get 47 eq { %% /
717: /fname fname rest def
718: } { } ifelse
719:
720: fname { (string) dc } map cat /fname set
721: } ifelse
722:
723: /fname2 fname def
724: [httpd.root fname2] cat /fname set
725: [(fname=) fname] cat message
1.15 ! takayama 726: fname httpd.check_name {
! 727: [(MSG) (Warning: invalid file name.)] httpd_sendfile
! 728: /httpd_sendfile.L1 /httpd_sendfile.L1 goto
! 729: } { } ifelse
1.14 takayama 730: [(stat) fname] extension 0 get tag 0 eq {
731: [(MSG) (Warning (sendfile): the file ) fname2 ( is not found.) ]
732: httpd_sendfile
733: /httpd_sendfile.L1 /httpd_sendfile.L1 goto
734: }{ }ifelse
735: [(stat) fname] extension 1 get 0 get toString /fsize set
736: (HTTP/1.1 200 OK) sendln
737: (Server: httpd_sm1) sendln
738: %% (ETag: "2197-bf6c-3b2d6541") sendln ???
739: (Accept-Ranges: bytes) sendln
740: [(Content-Length: ) fsize] cat sendln
741: (Connection: close) sendln
742: [(Content-Type: ) fname httpd_type] cat sendln
743: [(flush)] extension
744: 0 sendln
745: fname sendBinaryFile
746: 0 sendln
747: [(flush)] extension
748: 0 sendln
749: [(flush)] extension
750: /httpd_sendfile.L1 goto
751: }{
752: [(MSG) (Warning: unknown argument type for httpd_sendfile)]
753: httpd_sendfile
754: } ifelse
755: /httpd_sendfile.L1
756: ] pop
757: popVariables
758: } def
759:
760: /httpd_type {
761: /arg1 set
762: [/in-httpd_type /fname /ftype /i /ans] pushVariables
763: [
764: /fname arg1 def
765: fname (array) dc /fname set
766: fname reverse /fname set
767: [
768: 0 1 fname length 1 sub {
769: /i set
770: fname i get 46 eq { % '.'
771: exit
772: } { fname i get } ifelse
773: } for
774: ] /ftype set
775: ftype reverse {(string) dc} map cat /ftype set
776: /ans (text/plain) def
777: ftype (gif) eq {
778: /ans (image/gif) def
779: }{ } ifelse
780: ftype (jpeg) eq ftype (jpg) eq or {
781: /ans (image/jpeg) def
782: }{ } ifelse
783: ftype (png) eq {
784: /ans (image/png) def
785: }{ } ifelse
786: ftype (png) eq {
787: /ans (image/png) def
788: }{ } ifelse
789: ftype (html) eq ftype (htm) eq or {
790: /ans (text/html) def
791: } { } ifelse
792: ftype (txt) eq {
793: /ans (text/html) def
794: } { } ifelse
795: /arg1 ans def
796: ] pop
797: popVariables
798: arg1
799: } def
1.15 ! takayama 800:
! 801: /httpd.check_name {
! 802: /arg1 set
! 803: [/in-httpd.check_name /fname /invalid] pushVariables
! 804: [
! 805: /fname arg1 def
! 806: /invalid 0 def
! 807: [(regionMatches) fname [(..) (/.)]] extension 0 get -1 eq
! 808: {
! 809: } {
! 810: (The file name contains .. or /. ) message
! 811: /invalid 1 def /httpd.check_name.L1 /httpd.check_name.L1 goto
! 812: } ifelse
! 813: fname length 0 eq {
! 814: (Warning: empty file name.)
! 815: /invalid 1 def /httpd.check_name.L1 /httpd.check_name.L1 goto
! 816: }{ } ifelse
! 817: fname (array) dc 0 get 47 eq {
! 818: }{
! 819: (Warning: The first letter is not /) message
! 820: /invalid 1 def /httpd.check_name.L1 /httpd.check_name.L1 goto
! 821: } ifelse
! 822: /httpd.check_name.L1
! 823: /arg1 invalid def
! 824: ] pop
! 825: popVariables
! 826: arg1
! 827: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>