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