===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/httpd.sm1,v
retrieving revision 1.10
retrieving revision 1.17
diff -u -p -r1.10 -r1.17
--- OpenXM/src/kan96xx/Doc/httpd.sm1 2002/10/23 13:38:50 1.10
+++ OpenXM/src/kan96xx/Doc/httpd.sm1 2005/11/17 08:15:51 1.17
@@ -1,11 +1,22 @@
-%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.9 2002/10/21 10:43:52 takayama Exp $
+%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.16 2005/02/27 05:28:05 takayama Exp $
%% common modules for httpd on sm1.
/Oxserver_history_variable (Oxserver_history_variable_) def
/httpd.image.type
[(getenv) (OpenXM_PSTOIMG_TYPE)] extension
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 +38,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 +48,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,10 +82,12 @@ def
/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
@@ -273,27 +287,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
@@ -326,17 +319,34 @@ def
/removeGET {
/arg1 set
[/in-removeGET /s /s2 /i /j /i0
- /tname /nnn
+ /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
- 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
@@ -351,11 +361,12 @@ def
] reverse /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 {
/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
@@ -422,6 +433,7 @@ def
[/in-preformatHTML /sss /c] pushVariables
[
/sss arg1 def
+ sss toString /sss set
sss (array) dc /sss set
sss {
/c set
@@ -516,4 +528,320 @@ 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 (array) dc /fname set
+ fname reverse /fname set
+ [
+ 0 1 fname length 1 sub {
+ /i set
+ fname i get 46 eq { % '.'
+ exit
+ } { fname i get } ifelse
+ } for
+ ] /ftype set
+ ftype reverse {(string) dc} map cat /ftype set
+ /ans (text/plain) def
+ 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 (txt) eq {
+ /ans (text/html) 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
+ [() 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