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