=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/httpd.sm1,v retrieving revision 1.4 retrieving revision 1.20 diff -u -p -r1.4 -r1.20 --- OpenXM/src/kan96xx/Doc/httpd.sm1 2001/08/29 11:18:57 1.4 +++ OpenXM/src/kan96xx/Doc/httpd.sm1 2010/02/08 01:08:39 1.20 @@ -1,11 +1,31 @@ -%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.3 2001/08/23 02:08:41 takayama Exp $ +%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.19 2005/11/21 12:46:49 takayama Exp $ %% common modules for httpd on sm1. +% [(Strict) 1] system_variable % for debugging. /Oxserver_history_variable (Oxserver_history_variable_) def /httpd.image.type [(getenv) (OpenXM_PSTOIMG_TYPE)] extension def +/httpd_sm1.cookie + [(oxGenPass)] extension +def +/httpd.set-cookie { + [(Set-Cookie: httpd_sm1=) httpd_sm1.cookie] cat +} def + +[(getenv) (OXWEB_DEBUG)] extension tag 0 eq { + /httpd.debug 0 def +} { + /httpd.debug 1 def +} ifelse +[(getenv) (OXWEB_TAKE_LOG)] extension tag 0 eq { + /httpd.take.log 0 def +} { + /httpd.take.log 1 def +} ifelse + + /httpd_startserver { [(sm1.socket) (open) [httpd.port (localhost)]] extension /httpd.server.fdAndPort set @@ -27,7 +47,7 @@ def /sendln { /arg1 set - [/in-sendln /mmm] pushVariables + [/in-sendln /mmm /i] pushVariables [ arg1 /mmm set mmm tag 5 eq { [mmm 10 (string) dc] cat /mmm set @@ -37,7 +57,8 @@ def [(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension { (Warning (sendln): your peer closed the connection. Do not send the data.) message } { - [(sm1.socket) (write) [httpd.server.fd 0 get mmm]] extension message + [(sm1.socket) (write) [httpd.server.fd 0 get mmm]] extension /i set + httpd.debug { i message } { } ifelse } ifelse ] pop popVariables @@ -70,11 +91,13 @@ def /httpd.serial 0 def /httpd.history [ ] def /httpd.result.history [ 0 ] def + [(nobody)] extension pop { httpd_startserver ; httpd_action ; httpd_stopserver ; - (5 sleep) system + httpd.take.log { (date) system } { } ifelse +% (sleep 2) system httpd.serial 1 add /httpd.serial set } loop } def @@ -93,7 +116,7 @@ def 0 sendln () sendln (Shutdown the engine.
) sendln - (See you! Web/sm1 ) sendln + (See you! Web/asir, Web/sm1 ) sendln () sendln 0 sendln [(flush)] extension @@ -120,6 +143,7 @@ def (HTTP/0.9 200 OK) sendln (Connection: close) sendln (Content-Type: text/html) sendln + httpd.set-cookie sendln 0 sendln %% (

) sendln result sendln @@ -127,7 +151,11 @@ def %%(

) sendln %%test. It does not work always?! %%( Pretty format ) sendln %%test. It works. - () sendln + [(getenv) (OXWEB_POST)] extension tag 0 eq { + () sendln % use get + }{ + () sendln + } ifelse () sendln [()] cat sendln @@ -178,6 +206,17 @@ def [(flush)] extension } def +/send-page-warning-image { + (HTTP/0.9 200 OK) sendln + (Connection: close) sendln + (Content-Type: text/html) sendln + 0 sendln + (Error: Image translation is not supported on this server
) sendln + ( Check the value of the environmental variable OpenXM_PSTOIMG_TYPE
) sendln + 0 sendln + [(flush)] extension +} def + /stopclient { [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message } def @@ -258,27 +297,6 @@ def } ifelse -%% Decompose into tokens separated by a space. -%% (GET /hoge.jpeg ???) ---> [(GET) (/hoge.jpeg) (???)] -/toTokensBySpace { - /arg1 set - [/in-toTokesBySpace /ss /ss2 /i] pushVariables - [ - /ss arg1 def - ss 1 copy /ss set - ss (array) dc /ss2 set - 0 1 ss2 length 1 sub { - /i set - ss2 i get 32 eq { %% equal to space - ss i (,) put - } { } ifelse - } for - ss message - [ ss to_records pop] /arg1 set - ] pop - popVariables - arg1 -} def /askToSendFile { /arg1 set @@ -307,29 +325,59 @@ def arg1 } def -%% remove GET /?msg= +%% remove GET /?msg= or msg= /removeGET { /arg1 set [/in-removeGET /s /s2 /i /j /i0 - /tname + /tname /nnn /sta ] pushVariables [ /s arg1 def - /httpd.textarea.valid 1 def + /httpd.textarea.valid 0 def s 1 copy /s2 set s (array) dc /s set + /sta 0 def + + %% In case of POST, remove the HTTP header. cf. trouble for NS 6.0 + s length 4 gt { + [s 0 get s 1 get s 2 get s 3 get] (POST) (array) dc eq { + 0 1 s length 4 sub { + /i0 set + /sta i0 def + [ s i0 get s i0 1 add get ] [ 10 10 ] eq + [ s i0 get s i0 1 add get s i0 2 add get s i0 3 add get] + [ 13 10 13 10] eq or + { exit } { } ifelse + } for + }{ } ifelse + } { } ifelse + (sta=) messagen sta message + /nnn httpd.textarea.name.aaa length 6 sub def + /tname [ ] def - 0 1 s length 1 sub { + sta 1 s length 1 sub { /i0 set s i0 get 61 eq { %% 61 is = i0 1 add /i0 set - tname message - httpd.textarea.name.aaa message + + [ + << tname length 1 sub >> -1 + << tname length nnn sub >> dup 0 ge { } { pop 0 } ifelse + { + /i set + tname i get + } for + ] reverse /tname set + (GET /?) (array) dc tname join /tname set + + httpd.debug { httpd.textarea.name.aaa message } { } ifelse tname httpd.textarea.name.aaa eq { /httpd.textarea.valid 1 def } { /httpd.textarea.valid 0 def + tname message + httpd.textarea.name.aaa { (string) dc } map cat message (Warning: got an invalid name for the text field.) message } ifelse exit @@ -341,6 +389,8 @@ def i0 1 s length 1 sub { /i set s2 j << s i get (string) dc >> put + j s2 length 1 sub lt { s2 j 1 add ( ) put } { } ifelse + %% might cause a BUG. It should be improved. j 1 add /j set } for /arg1 s2 def @@ -393,6 +443,7 @@ def [/in-preformatHTML /sss /c] pushVariables [ /sss arg1 def + sss toString /sss set sss (array) dc /sss set sss { /c set @@ -487,4 +538,314 @@ def ] pop popVariables arg1 +} def + +% This function will be written in C in a future. +% [(httpd) (parseHTTP) string] extension +% [(GET) key-value-pair-1 key-value-pair-2 ...] +% [(POST) key-value-pair-1 key-value-pair-2 ...] +% [(GET-file) file-1 file2 ...] +% ex. (GET / HTT..) (GET /?rpc=1-2) +/httpd.parse { + /arg1 set + [/in-httpd.parse /s /s2 /sta /i0 + /ans /getKeyword /j /tname /tvalue + ] pushVariables + [ + /s arg1 def + s 1 copy /s2 set + s (array) dc /s set + + /sta 0 def + /getKeyword 0 def + + s length 7 lt { + /ans [(GET-file)] def + /httpd.exit goto + }{ } ifelse + + /ans [(GET)] def + [s 0 get s 1 get s 2 get s 3 get s 4 get s 5 get] (GET /?) (array) dc eq { + /sta 6 def + /getKeyword 1 def + }{ + [s 0 get s 1 get s 2 get s 3 get s 4 get] (GET /) (array) dc eq { + /sta 5 def + }{ + [s 0 get s 1 get s 2 get s 3 get] (GET ) (array) dc eq { + /ans [(GET-file)] def + /httpd.exit goto + } { /ans [ ] def /httpd.exit.goto } ifelse + } ifelse + }ifelse + + %% In case of POST, remove the HTTP header. cf. trouble for NS 6.0 + [s 0 get s 1 get s 2 get s 3 get] (POST) (array) dc eq { + /ans [(POST) ] def + /getKeyword 1 def + 0 1 s length 4 sub { + /i0 set + /sta i0 def + [ s i0 get s i0 1 add get ] [ 10 10 ] eq + [ s i0 get s i0 1 add get s i0 2 add get s i0 3 add get] + [ 13 10 13 10] eq or + { exit } { } ifelse + } for + }{ } ifelse + (sta=) messagen sta message + + %% get file name + getKeyword not { + /tname [ ] def + sta 1 << s length 1 sub >> { + /i0 set + s i0 get 32 le { %% 32 is " " + exit + } { } ifelse + tname s i0 get append /tname set + } for + httpd.debug { (Filename is ) messagen tname {(string) dc } map message} { } ifelse + /ans [(GET-file) tname { (string) dc } map cat ] def + /httpd.exit goto + } { } ifelse + + /tname [ ] def + sta 1 << s length 1 sub >> { + /i0 set + s i0 get 61 eq { %% 61 is = + httpd.debug { tname message tname {(string) dc } map cat message} { } ifelse + i0 1 add /i0 set + exit + } { } ifelse + tname s i0 get append /tname set + } for + + %% Remove space and cr/lf from the key word. + [ + 0 1 tname length 1 sub { + /j set + tname j get 36 le { + } { + tname j get + } ifelse + } for + ] /tname set + + /j 0 def + i0 1 s length 1 sub { + /i set + s2 j << s i get (string) dc >> put + j s2 length 1 sub lt { s2 j 1 add ( ) put } { } ifelse + %% might cause a BUG. It should be improved. + j 1 add /j set + } for + ans [tname {(string) dc} map cat + s2 webstringToAscii ] append + /ans set + + /httpd.exit + ans length 1 lt { + /ans [(Unknown)] def + } { } ifelse + /arg1 ans def + ] pop + popVariables + arg1 +} def + +/httpd.root [(getenv) (OXWEB_HTTPD_ROOT)] extension def +%% /usr/local/www/data/ Assume slash!! + +% [(GET-file) (filename)] httpd_sendfile +% [(MSG) (message)] httpd_sendfile +/httpd_sendfile { + /arg1 set + [/in-htpd_sendfile /msg /fname /fname2 + /fsize + ] pushVariables + [ + /msg arg1 def + %% Send message. [(MSG) msg2 ...] httpd_sendfile + msg message + msg 0 get (MSG) eq { + (HTTP/0.9 200 OK) sendln + (Connection: close) sendln + (Content-Type: text/html) sendln + 0 sendln + msg rest { sendln } map + 0 sendln + [(flush)] extension + /httpd_sendfile.L1 goto + }{ } ifelse + %% Get a file message. [(GET-file) fname] httpd_sendfile + msg 0 get (GET-file) eq { + httpd.root tag 5 eq not { + [(MSG) (

File transfer is not allowed on this server.

)] + httpd_sendfile + /httpd_sendfile.L1 /httpd_sendfile.L1 goto + } { } ifelse + msg length 1 eq { + /fname (index.html) def + }{ + /fname msg 1 get def + (fname=) messagen fname (array) dc message + fname tag 5 eq not { + [(MSG) (

Invalid file name.

)] + httpd_sendfile + /httpd_sendfile.L1 /httpd_sendfile.L1 goto + } { } ifelse + fname (array) dc /fname set + fname length 1 lt { + /fname (index.html) (array) dc def + } { } ifelse + + fname [47] eq { + /fname (index.html) (array) dc def + }{ } ifelse + + fname 0 get 47 eq { %% / + /fname fname rest def + } { } ifelse + + fname { (string) dc } map cat /fname set + } ifelse + + /fname2 fname def + [httpd.root fname2] cat /fname set + [(fname=) fname] cat message + fname httpd.check_name { + [(MSG) (Warning: invalid file name.)] httpd_sendfile + /httpd_sendfile.L1 /httpd_sendfile.L1 goto + } { } ifelse + [(stat) fname] extension 0 get tag 0 eq { + [(MSG) (Warning (sendfile): the file ) fname2 ( is not found.) ] + httpd_sendfile + /httpd_sendfile.L1 /httpd_sendfile.L1 goto + }{ }ifelse + [(stat) fname] extension 1 get 0 get toString /fsize set + (HTTP/1.1 200 OK) sendln + (Server: httpd_sm1) sendln + %% (ETag: "2197-bf6c-3b2d6541") sendln ??? + (Accept-Ranges: bytes) sendln + [(Content-Length: ) fsize] cat sendln + (Connection: close) sendln + [(Content-Type: ) fname httpd_type] cat sendln + [(flush)] extension + 0 sendln + fname sendBinaryFile + 0 sendln + [(flush)] extension + 0 sendln + [(flush)] extension + /httpd_sendfile.L1 goto + }{ + [(MSG) (Warning: unknown argument type for httpd_sendfile)] + httpd_sendfile + } ifelse + /httpd_sendfile.L1 + ] pop + popVariables +} def + +/httpd_type { + /arg1 set + [/in-httpd_type /fname /ftype /i /ans] pushVariables + [ + /fname arg1 def + fname getFileType /ftype set + + /ans (text/plain) def % .txt, .jar, + ftype (gif) eq { + /ans (image/gif) def + }{ } ifelse + ftype (jpeg) eq ftype (jpg) eq or { + /ans (image/jpeg) def + }{ } ifelse + ftype (png) eq { + /ans (image/png) def + }{ } ifelse + ftype (png) eq { + /ans (image/png) def + }{ } ifelse + ftype (html) eq ftype (htm) eq or { + /ans (text/html) def + } { } ifelse + ftype (wav) eq { + /ans (audio/x-wav) def + } { } ifelse + ftype (class) eq { + /ans (application/octet-stream) def + } { } ifelse + /arg1 ans def + ] pop + popVariables + arg1 +} def + +/httpd.check_name { + /arg1 set + [/in-httpd.check_name /fname /invalid] pushVariables + [ + /fname arg1 def + /invalid 0 def + [(regionMatches) fname [(..) (/.)]] extension 0 get -1 eq + { + } { + (The file name contains .. or /. ) message + /invalid 1 def /httpd.check_name.L1 /httpd.check_name.L1 goto + } ifelse + fname length 0 eq { + (Warning: empty file name.) + /invalid 1 def /httpd.check_name.L1 /httpd.check_name.L1 goto + }{ } ifelse + fname (array) dc 0 get 47 eq { + }{ + (Warning: The first letter is not /) message + /invalid 1 def /httpd.check_name.L1 /httpd.check_name.L1 goto + } ifelse + /httpd.check_name.L1 + /arg1 invalid def + ] pop + popVariables + arg1 +} def + +/httpd.startBrowserUnix { + /arg1 set + [/portnum /browser /cmd /fd /msg /htmlfn] pushVariables + [ + arg1 /portnum set + portnum toString /portnum set + [(getenv) (OX_BROWSER)] extension /browser set + { + browser tag 0 eq { + [(sleep 3 ; firefox http://localhost:) portnum ( & ) ] cat + /cmd set cmd message + cmd system + exit + }{ } ifelse + browser (mac) eq, browser (MAC) eq, or { + (.sm1.httpd.startBrowserUnix.html) /htmlfn set + htmlfn (w) file /fd set + fd tag 0 eq { (httpd.startBrowserUnix fails to open a file.) error } + { } ifelse + [() nl + () + (Click here to connect to the ox server) + () nl + () nl + ] cat /msg set + fd msg writestring fd closefile + [(sleep 3 ; open ) htmlfn ( &) ] cat + /cmd set cmd message + cmd system + exit + }{ } ifelse + [(sleep 3 ; ) browser ( http://localhost:) portnum ( & ) ] cat + /cmd set cmd message + cmd system + exit + } loop + ] pop + popVariables } def \ No newline at end of file