version 1.7, 2001/08/21 14:21:29 |
version 1.11, 2002/01/16 09:20:00 |
|
|
%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-sm1.sm1,v 1.6 2001/08/21 14:12:45 takayama Exp $ |
%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-sm1.sm1,v 1.10 2001/12/28 01:20:25 takayama Exp $ |
%% http server by sm1 |
%% http server by sm1 |
%% Note to run on the Windows (TM). |
%% Note to run on the Windows (TM). |
%% (A) You need to set IE (internet explorer) as follows: |
%% (A) You need to set IE (internet explorer) as follows: |
|
|
%% (B) You need to have the "start.exe" at c:\windows\command\start.exe |
%% (B) You need to have the "start.exe" at c:\windows\command\start.exe |
%% (C) cygwin1.dll should be by sm1.exe, ox_sm1.exe and ox.exe |
%% (C) cygwin1.dll should be by sm1.exe, ox_sm1.exe and ox.exe |
|
|
|
[(parse) (httpd.sm1) pushfile] extension pop |
|
|
/httpd.image.name (kobeuniv2.jpg) def |
/httpd.image.name (kobeuniv2.jpg) def |
/httpd.image.type (jpeg) def |
/httpd.image.type (jpeg) def |
|
|
} { |
} { |
%% Initialize ox_sm1 |
%% Initialize ox_sm1 |
[(ostype)] extension 0 get |
[(ostype)] extension 0 get |
(windows) eq { |
sm1connectr |
[(getenv) (OSTYPE)] extension |
|
(cygwin) eq { |
|
sm1connectr %% Cygwin |
|
}{ |
|
sm1connectr_win %% Native Windows. |
|
} ifelse |
|
}{ |
|
sm1connectr %% Unix |
|
} ifelse |
|
ox.ccc oxmathcap |
ox.ccc oxmathcap |
ox.ccc oxsetmathcap |
ox.ccc oxsetmathcap |
} ifelse |
} ifelse |
|
|
%% On windows. |
%% On windows. |
[(forkExec) |
[(forkExec) |
[ |
[ |
(c:/windows/command/start) |
%%(c:/windows/command/start) |
|
(start) |
(iexplore) %% Starting internet explorer (TM). |
(iexplore) %% Starting internet explorer (TM). |
[(http://localhost:) httpd.port toString] cat |
[(http://localhost:) httpd.port toString] cat |
] |
] |
|
|
popVariables |
popVariables |
} def |
} 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 |
|
|
|
/httpd_action { |
/httpd_action { |
[/in-httpd /ff /httpd.com /httpd.result /sss |
[/in-httpd /ff /httpd.com /httpd.result /sss |
/sss.engine /sss.web /err /httpd.sendFile |
/sss.engine /sss.web /err /httpd.sendFile |
|
/oxserver.vname |
] pushVariables |
] pushVariables |
[ |
[ |
{ |
{ |
|
|
} ifelse |
} ifelse |
httpd.com metaCommand { |
httpd.com metaCommand { |
httpd.textarea.valid { |
httpd.textarea.valid { |
|
/oxserver.vname |
|
[Oxserver_history_variable httpd.serial toString] cat |
|
def |
ox.ccc |
ox.ccc |
[ httpd.com ] cat |
[ |
|
httpd.com |
|
( /) oxserver.vname ( set ) |
|
oxserver.vname ( ) |
|
] cat |
oxexecutestring ; |
oxexecutestring ; |
}{ |
}{ |
send-page-warning exit |
send-page-warning exit |
|
|
} def |
} 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 |
|
|
|
/httpd.sm1man |
/httpd.sm1man |
("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/kan96xx/onlinehelp/index.html") |
("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/kan96xx/onlinehelp/index.html") |
def |
def |
|
|
popVariables |
popVariables |
} def |
} def |
|
|
/send-page-warning { |
|
(HTTP/0.9 200 OK) sendln |
|
(Connection: close) sendln |
|
(Content-Type: text/html) sendln |
|
0 sendln |
|
(You cannot execute ox_sm1 without a session key! <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 |
|
|
|
/metaCommand { |
/metaCommand { |
/arg1 set |
/arg1 set |