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