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