%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.22 2013/03/07 02:10:32 takayama Exp $ %% common modules for httpd on sm1. % [(Strict) 1] system_variable % for debugging. /httpd.rawplus 0 def /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 (sm1.socket.open returns ) messagen httpd.server.fdAndPort message [(sm1.socket) (accept) [httpd.server.fdAndPort 0 get]] extension /httpd.server.fd set (connected.) message (sm1.socket.accept returns ) messagen httpd.server.fd message } def /httpd_stopserver { [(sm1.socket) (close) httpd.server.fd ] extension message } def /send_packet { /arg1 set [(sm1.socket) (write) [httpd.server.fd 0 get arg1]] extension message } def /sendln { /arg1 set [/in-sendln /mmm /i] pushVariables [ arg1 /mmm set mmm tag 5 eq { [mmm 10 (string) dc] cat /mmm set }{ 10 (string) dc /mmm set } ifelse [(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 /i set httpd.debug { i message } { } ifelse } ifelse ] pop popVariables } def /sendBinaryFile { /arg1 set [/in-sendln /fname /fd /c /cdata] pushVariables [ arg1 /fname set [(sendBinaryFile: sending data) ] cat message [(fp2openForRead) fname] extension /fd set fd message fd 0 lt { [(Error: sendBinaryFile: file ) fname ( is not found.)] cat message /aaaa goto } { } ifelse [(fp2pushfile) fname] extension /cdata set [(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension { (Warning (sendBinaryFile): your peer closed the connection. Do not send the data.) message exit } { [(sm1.socket) (writeByte) [httpd.server.fd 0 get cdata]] extension pop } ifelse /aaaa ] pop popVariables } def /httpd { /httpd.serial 0 def /httpd.history [ ] def /httpd.result.history [ 0 ] def [(nobody)] extension pop { httpd_startserver ; httpd_action ; httpd_stopserver ; httpd.take.log { (date) system } { } ifelse % (sleep 2) system httpd.serial 1 add /httpd.serial set } loop } def /send-page-bye { (HTTP/0.9 200 OK) sendln %% (Date: Sun, 18 Mar 2001 02:54:50 GMT) sendln %% (Server: sm1/0.1 (Unix)) sendln %% (Last-Modified: Wed, 23 Aug 2000 11:19:27 GMT) sendln %% (ETag: "1f8f-5df-39a3b33f") sendln %% (Accept-Ranges: bytes) sendln %% (Content-Length: 10) sendln (Connection: close) sendln % (Content-Type: text/plain) sendln (Content-Type: text/html) sendln 0 sendln () sendln (Shutdown the engine.
) sendln (See you! Web/asir, Web/sm1 ) sendln () sendln 0 sendln [(flush)] extension } def /send-page-2 { (HTTP/0.9 200 OK) sendln %% (Content-Length: 10) sendln (Connection: close) sendln (Content-Type: text/html) sendln 0 sendln () sendln 0 sendln [(flush)] extension } def /send-page-3 { /arg1 set [/in-send-page-3 /result] pushVariables [ /result arg1 def (HTTP/0.9 200 OK) sendln (Connection: close) sendln (Content-Type: text/html) sendln httpd.set-cookie sendln 0 sendln %% () sendln send-menu-1 0 sendln [(flush)] extension ] pop popVariables } def /send-image { /arg2 set /arg1 set [/in-send-jpeg /fname /imagetype /ff /fsize] pushVariables [ /fname arg1 def % set the jpeg file name. /imagetype arg2 def % jpeg or gif [(stat) fname] extension 0 get tag 0 eq { (Warning (send-image): the file ) messagen fname messagen ( is not found.) message /notFound goto }{ }ifelse [(stat) fname] extension 1 get 0 get toString /fsize set (HTTP/1.1 200 OK) dup message sendln (Server: httpd_sm1) dup message sendln %% (ETag: "2197-bf6c-3b2d6541") sendln ??? (Accept-Ranges: bytes) dup message sendln [(Content-Length: ) fsize] cat dup message sendln (Connection: close) dup message sendln [(Content-Type: image/) imagetype] cat dup message sendln [(flush)] extension 0 sendln fname sendBinaryFile 0 sendln [(flush)] extension /notFound ] pop popVariables } def /send-page-warning { (HTTP/0.9 200 OK) sendln (Connection: close) sendln (Content-Type: text/html) sendln 0 sendln (You cannot execute ox servers without a session key!
) sendln 0 sendln [(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 /cleanErrors { /arg1 set [/in-cleanErrors /clientt /spp] pushVariables [ /clientt arg1 def clientt oxgetsp (integer) dc /spp set clientt spp oxpops ] pop popVariables } def /fromHex { /arg1 set [/in-fromHex /s1 /s2 /c /c2] pushVariables [ arg1 0 get /s1 set arg1 1 get /s2 set 48 s1 le s1 57 le and { % 0, ..., 9 s1 48 sub /c set }{ } ifelse 65 s1 le s1 70 le and { % A, ..., F s1 65 sub 10 add /c set }{ } ifelse 97 s1 le s1 102 le and { % a, ..., f s1 97 sub 10 add /c set }{ } ifelse c 16 mul /c set 48 s2 le s2 57 le and { % 0, ..., 9 s2 48 sub /c2 set }{ } ifelse 65 s2 le s2 70 le and { % A, ..., F s2 65 sub 10 add /c2 set }{ } ifelse 97 s2 le s2 102 le and { % a, ..., f s2 97 sub 10 add /c2 set }{ } ifelse c c2 add /arg1 set ] pop popVariables arg1 } def /randomName { [/in-randomName /sss /rrr ] pushVariables [ %% Seed name /sss [ 97 97 97 97 97 97 97 97 97 97 ] def %% 97 == 'a' %% This procedure to generate port number might fail. sss { [ [(oxGenPass)] extension .. /rrr set [(tdiv_qr) rrr (26)..] mpzext 1 get /rrr set ] pop rrr (integer) dc add } map /sss set sss {(string) dc} map cat /arg1 set ] pop popVariables arg1 } def (httpd.textarea.name) boundp { } { /httpd.textarea.name randomName def /httpd.textarea.name.aaa [(GET /?) httpd.textarea.name] cat (array) dc def } ifelse /askToSendFile { /arg1 set [/in-askToSendFile /ss /fname] pushVariables [ /ss arg1 def /fname null def ss toTokensBySpace /ss set ss 0 get (GET) eq { ss 1 get length 1 gt { ss 1 get (array) dc 1 get 63 eq { %% See if /? /fname null def }{ /fname ss 1 get def % set the file name. fname (array) dc rest /fname set % remove / fname { (string) dc } map cat /fname set } ifelse }{ /fname null def } ifelse }{ /fname null def } ifelse (::::) messagen ss message fname message /arg1 fname def ] pop popVariables arg1 } def %% remove GET /?msg= or msg= /removeGET { /arg1 set [/in-removeGET /s /s2 /i /j /i0 /tname /nnn /sta ] pushVariables [ /s arg1 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 sta 1 s length 1 sub { /i0 set s i0 get 61 eq { %% 61 is = i0 1 add /i0 set [ << 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 } { } ifelse tname s i0 get append /tname set } for /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 /arg1 s2 def ] pop arg1 } def /webstringToAscii { /arg1 set [/in-webstringToAscii /s /i /j /c /n] pushVariables [ /s arg1 def s (array) dc /s set /j 0 def /n s length def /i 0 def { s i get /c set c 32 eq { exit } { } ifelse c 37 eq { % c == % [s i 1 add get s i 2 add get] fromHex /c set s j c put j 1 add /j set i 3 add /i set } { c 43 eq { % c == + httpd.rawplus { s j 43 put } { s j 32 put } ifelse j 1 add /j set i 1 add /i set } { c 13 eq { % c == 0xd i 1 add /i set } { s j c put j 1 add /j set i 1 add /i set } ifelse } ifelse } ifelse i n ge { exit } { } ifelse } loop s j carN /s set s { (string) dc } map cat /arg1 set ] pop popVariables arg1 } def /preformatHTML { /arg1 set [/in-preformatHTML /sss /c] pushVariables [ /sss arg1 def sss toString /sss set sss (array) dc /sss set sss { /c set [ c 60 eq { /c (<) def } { } ifelse c 62 eq { /c (>) def } { } ifelse c 38 eq { /c (&) def } { } ifelse ] pop c (string) dc } map cat /sss set [(

 ) sss (

)] cat /arg1 set ] pop popVariables arg1 } def /executeStringAndSelectInputFromBrowserAndOxserver { /arg3 set /arg2 set /arg1 set [/in-executeStringAndSelectInputFromBrowserAndOxserver /oxserver.ccc /command.to.oxserver /sss.engine /sss.web /sss /err /httpd.result /stringOrCmo ] pushVariables % Global var: httpd.server.fd [ /oxserver.ccc arg1 def /command.to.oxserver arg2 def /stringOrCmo arg3 def oxserver.ccc command.to.oxserver oxexecutestring ; [(oxReq) oxserver.ccc SM_dupErrors ] extension pop [(oxReq) oxserver.ccc SM_popCMO ] extension pop stringOrCmo (string) eq { [(oxReq) oxserver.ccc SM_popString ] extension pop }{ [(oxReq) oxserver.ccc SM_popCMO ] extension pop } ifelse [(flush)] extension pop %% Select inputs for interruption. %% Wait by the spin lock. { [(oxMultiSelect) [oxserver.ccc] 1] extension 1 get 0 get /sss.engine set [(sm1.socket) (mselect) [[httpd.server.fd 0 get] 1] ] extension 0 get /sss.web set /sss [sss.engine sss.web] def sss.engine { exit } { } ifelse sss.web { exit } { } ifelse } loop sss message sss 0 get { [(oxGet) oxserver.ccc] extension /err set [(oxGet) oxserver.ccc] extension /httpd.result set } { oxserver.ccc oxreset oxserver.ccc ("computation is interrupted.";) oxexecutestring ; oxserver.ccc oxpopstring /httpd.result set exit } ifelse (------------- result -------------) message httpd.result message (----------------------------------) message ( ) message err message err [ ] eq { } { oxserver.ccc cleanErrors [httpd.result 10 (string) dc err toString] cat /httpd.result set } ifelse /arg1 [err httpd.result] 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 { [(ostype)] extension 1 get (mac) eq { [(sleep 3 ; open http://localhost:) portnum ( & ) ] cat /cmd set cmd message }{ [(sleep 3 ; firefox http://localhost:) portnum ( & ) ] cat /cmd set cmd message }ifelse 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