File: [local] / OpenXM / src / kan96xx / Doc / httpd.sm1 (download)
Revision 1.5, Thu Sep 20 05:57:40 2001 UTC (22 years, 9 months ago) by takayama
Branch: MAIN
CVS Tags: RELEASE_1_2_1
Changes since 1.4: +12 -1
lines
Send a warning message when image translation is not available.
|
%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.5 2001/09/20 05:57:40 takayama Exp $
%% common modules for httpd on sm1.
/Oxserver_history_variable (Oxserver_history_variable_) def
/httpd.image.type
[(getenv) (OpenXM_PSTOIMG_TYPE)] extension
def
/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] 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 message
} 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
{
httpd_startserver ;
httpd_action ;
httpd_stopserver ;
(5 sleep) 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
(<html>) sendln
(Shutdown the engine. <br>) sendln
(See you! <a href="http://www.openxm.org"> Web/sm1 </a>) sendln
(</html>) 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
(<FORM NAME="myFORM">) sendln
(<INPUT TYPE="TEXT" NAME="Num">) sendln
(</FORM>) 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
0 sendln
%% (<FORM NAME="myFORM" METHOD="POST">) sendln
result sendln
%%(<img src="hoge.jpeg"> <img>) sendln %%test. It does not work always?!
%%(<a href="hoge.jpeg"> Pretty format </a>) sendln %%test. It works.
(<FORM NAME="myFORM">) sendln
(<INPUT TYPE=submit VALUE="submit">) sendln
[(<textarea name=) httpd.textarea.name
( rows=10 cols="80" wrap="soft"></textarea>)] cat sendln
(</FORM>) 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! <br>) 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<br>) sendln
( Check the value of the environmental variable OpenXM_PSTOIMG_TYPE <br>) 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
%% 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
[/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=
/removeGET {
/arg1 set
[/in-removeGET /s /s2 /i /j /i0
/tname
] pushVariables
[
/s arg1 def
/httpd.textarea.valid 1 def
s 1 copy /s2 set
s (array) dc /s set
/tname [ ] def
0 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 httpd.textarea.name.aaa eq {
/httpd.textarea.valid 1 def
} {
/httpd.textarea.valid 0 def
(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 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 == +
s j 32 put
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 (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
[(<pre> ) sss ( </pre> )] 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![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to httpd.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc