version 1.11, 2002/10/29 07:29:23 |
version 1.18, 2005/11/21 09:12:22 |
|
|
%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.10 2002/10/23 13:38:50 takayama Exp $ |
%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.17 2005/11/17 08:15:51 takayama Exp $ |
%% common modules for httpd on sm1. |
%% common modules for httpd on sm1. |
|
% [(Strict) 1] system_variable % for debugging. |
/Oxserver_history_variable (Oxserver_history_variable_) def |
/Oxserver_history_variable (Oxserver_history_variable_) def |
/httpd.image.type |
/httpd.image.type |
[(getenv) (OpenXM_PSTOIMG_TYPE)] extension |
[(getenv) (OpenXM_PSTOIMG_TYPE)] extension |
def |
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 { |
/httpd_startserver { |
[(sm1.socket) (open) [httpd.port (localhost)]] extension |
[(sm1.socket) (open) [httpd.port (localhost)]] extension |
/httpd.server.fdAndPort set |
/httpd.server.fdAndPort set |
|
|
|
|
/sendln { |
/sendln { |
/arg1 set |
/arg1 set |
[/in-sendln /mmm] pushVariables |
[/in-sendln /mmm /i] pushVariables |
[ arg1 /mmm set |
[ arg1 /mmm set |
mmm tag 5 eq { |
mmm tag 5 eq { |
[mmm 10 (string) dc] cat /mmm set |
[mmm 10 (string) dc] cat /mmm set |
|
|
[(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension { |
[(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension { |
(Warning (sendln): your peer closed the connection. Do not send the data.) message |
(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 |
} ifelse |
] pop |
] pop |
popVariables |
popVariables |
|
|
/httpd.serial 0 def |
/httpd.serial 0 def |
/httpd.history [ ] def |
/httpd.history [ ] def |
/httpd.result.history [ 0 ] def |
/httpd.result.history [ 0 ] def |
|
[(nobody)] extension pop |
{ |
{ |
httpd_startserver ; |
httpd_startserver ; |
httpd_action ; |
httpd_action ; |
httpd_stopserver ; |
httpd_stopserver ; |
|
httpd.take.log { (date) system } { } ifelse |
% (sleep 2) system |
% (sleep 2) system |
httpd.serial 1 add /httpd.serial set |
httpd.serial 1 add /httpd.serial set |
} loop |
} loop |
|
|
} ifelse |
} 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 { |
/askToSendFile { |
/arg1 set |
/arg1 set |
|
|
] reverse /tname set |
] reverse /tname set |
(GET /?) (array) dc tname join /tname set |
(GET /?) (array) dc tname join /tname set |
|
|
httpd.textarea.name.aaa message |
httpd.debug { httpd.textarea.name.aaa message } { } ifelse |
tname httpd.textarea.name.aaa eq { |
tname httpd.textarea.name.aaa eq { |
/httpd.textarea.valid 1 def |
/httpd.textarea.valid 1 def |
} { |
} { |
/httpd.textarea.valid 0 def |
/httpd.textarea.valid 0 def |
tname message |
tname message |
httpd.textarea.name.aaa { (string) dc } map cat message |
httpd.textarea.name.aaa { (string) dc } map cat message |
(Warning: got an invalid name for the text field.) message |
(Warning: got an invalid name for the text field.) message |
} ifelse |
} ifelse |
|
|
[/in-preformatHTML /sss /c] pushVariables |
[/in-preformatHTML /sss /c] pushVariables |
[ |
[ |
/sss arg1 def |
/sss arg1 def |
|
sss toString /sss set |
sss (array) dc /sss set |
sss (array) dc /sss set |
sss { |
sss { |
/c set |
/c set |
|
|
] pop |
] pop |
popVariables |
popVariables |
arg1 |
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) (<h1> File transfer is not allowed on this server. </h1>)] |
|
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) (<h1> Invalid file name. </h1>)] |
|
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 ; netscape 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 |
|
[(<html><body>) nl |
|
(<a href="http://localhost:) portnum (">) |
|
(Click here to connect to the ox server) |
|
(</a>) nl |
|
(</body></html>) 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 |
} def |
|
|