version 1.4, 2001/04/21 11:16:30 |
version 1.11, 2001/08/12 07:20:37 |
|
|
%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v 1.3 2001/04/21 08:18:03 takayama Exp $ |
%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v 1.10 2001/04/23 13:34:00 takayama Exp $ |
%% http server by sm1 |
%% http server by sm1 |
|
|
/httpd.port 1200 def |
/httpd.port 1200 def |
|
/httpd.image.name (kobeuniv2.jpg) def |
|
/httpd.image.type (jpeg) def |
|
|
/httpd.initialization |
/httpd.initialization |
%% Put initialization codes here. |
%% Put initialization codes here. |
[ |
[ |
("Risa/Asir web version 0.80. "+ |
("Asirweb version 0.80. "+ |
" Risa/Asir oxasir version "+rtostr(version());) |
" Risa/Asir oxasir version "+rtostr(version());) |
] cat |
] cat |
def |
def |
|
|
[(parse) (oxasir.sm1) pushfile] extension |
[(parse) (oxasir.sm1) pushfile] extension |
(oxasir.started) boundp { |
(oxasir.started) boundp { |
} { |
} { |
|
%% Initialize oxasir. |
[(x^2-1) (x)] fctr pop |
[(x^2-1) (x)] fctr pop |
|
oxasir.ccc oxmathcap |
|
oxasir.ccc oxsetmathcap |
} ifelse |
} ifelse |
|
|
|
/asirweb { |
|
[/rrr ] pushVariables |
|
[ |
|
%% This procedure to generate port number might fail. |
|
[(oxGenPass)] extension . (integer) dc /rrr set |
|
rrr << rrr 20000 idiv 20000 mul >> sub /rrr set |
|
/httpd.port 1200 rrr add def |
|
httpd.port message |
|
|
|
[(sleep 3; netscape -geometry 800x500 http://localhost:) |
|
httpd.port toString |
|
( &)] cat system |
|
httpd ; |
|
] pop |
|
popVariables |
|
} def |
|
|
/httpd_startserver { |
/httpd_startserver { |
[(sm1.socket) (open) [httpd.port (localhost)]] extension |
[(sm1.socket) (open) [httpd.port (localhost)]] extension |
/server.fdAndPort set |
/httpd.server.fdAndPort set |
(sm1.socket.open returns ) messagen server.fdAndPort message |
(sm1.socket.open returns ) messagen httpd.server.fdAndPort message |
[(sm1.socket) (accept) [server.fdAndPort 0 get]] extension |
[(sm1.socket) (accept) [httpd.server.fdAndPort 0 get]] extension |
/server.fd set |
/httpd.server.fd set |
(connected.) message |
(connected.) message |
(sm1.socket.accept returns ) messagen server.fd message |
(sm1.socket.accept returns ) messagen httpd.server.fd message |
} def |
} def |
|
|
/httpd_stopserver { |
/httpd_stopserver { |
[(sm1.socket) (close) server.fd ] extension message |
[(sm1.socket) (close) httpd.server.fd ] extension message |
} def |
} def |
|
|
/send_packet { |
/send_packet { |
/arg1 set |
/arg1 set |
[(sm1.socket) (write) [server.fd 0 get arg1]] extension message |
[(sm1.socket) (write) [httpd.server.fd 0 get arg1]] extension message |
} def |
} def |
|
|
/sendln { |
/sendln { |
|
|
}{ |
}{ |
10 (string) dc /mmm set |
10 (string) dc /mmm set |
} ifelse |
} ifelse |
[(sm1.socket) (write) [server.fd 0 get mmm]] extension message |
[(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension { |
|
(Warning: your peer closed the connection. Do not send the data.) message |
|
} { |
|
[(sm1.socket) (write) [httpd.server.fd 0 get mmm]] extension message |
|
} ifelse |
] pop |
] pop |
popVariables |
popVariables |
} def |
} 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 { |
/httpd.serial 0 def |
/httpd.serial 0 def |
/httpd.history [ ] def |
/httpd.history [ ] def |
|
/httpd.result.history [ 0 ] def |
{ |
{ |
httpd_startserver ; |
httpd_startserver ; |
httpd_action ; |
httpd_action ; |
|
|
} def |
} def |
|
|
/httpd_action { |
/httpd_action { |
[/in-httpd /httpd.com.old /ff /httpd.com /httpd.result |
[/in-httpd /ff /httpd.com /httpd.result /sss |
|
/sss.engine /sss.web /err |
] pushVariables |
] pushVariables |
[ |
[ |
{ |
{ |
/httpd.com.old ( ) def |
[(sm1.socket) (select) [httpd.server.fd 0 get -1]] extension |
[(sm1.socket) (select) [server.fd 0 get -1]] extension |
%% wait for ever |
%% wait for ever |
[(sm1.socket) (read) [httpd.server.fd 0 get ]] extension /ff set |
[(sm1.socket) (read) [server.fd 0 get ]] extension /ff set |
|
ff length 0 eq { |
ff length 0 eq { |
(connection is closed.) message |
(connection is closed.) message |
} |
} |
|
|
(------------ start ----------------------) message |
(------------ start ----------------------) message |
ff message |
ff message |
(-----------------------------------------) message |
(-----------------------------------------) message |
ff removeGET webstringToAscii /httpd.com set |
ff 1 copy askToSendFile /httpd.sendFile set |
httpd.com message |
httpd.sendFile tag 0 eq { |
|
ff removeGET webstringToAscii /httpd.com set |
|
} { |
|
/httpd.com (NONE) def |
|
} ifelse |
|
[(httpd.com=) httpd.com] cat message |
|
(httpd.sendFile=) messagen httpd.sendFile message |
(------------ end ----------------------) message |
(------------ end ----------------------) message |
( ) message |
( ) message |
httpd.serial 0 eq { |
httpd.serial 0 eq { |
/httpd.com httpd.initialization def |
/httpd.com httpd.initialization def |
} { } ifelse |
} { } ifelse |
|
httpd.sendFile tag 0 eq { } |
|
{ |
|
httpd.sendFile httpd.image.type send-image |
|
exit %% exit the loop LOOP-A |
|
} ifelse |
httpd.com metaCommand { |
httpd.com metaCommand { |
/httpd.history httpd.history httpd.com append def |
httpd.textarea.valid { |
oxasir.ccc |
oxasir.ccc |
[(if (1) {) httpd.com (};)] cat |
[(if (1) {) httpd.com (; };)] cat |
oxexecutestring ; |
oxexecutestring ; |
oxasir.ccc oxpopstring /httpd.result set |
}{ |
/httpd.com.old httpd.com def |
send-page-warning exit |
|
} ifelse |
|
[(oxReq) oxasir.ccc SM_dupErrors ] extension pop |
|
|
|
[(oxReq) oxasir.ccc SM_popCMO ] extension pop |
|
[(oxReq) oxasir.ccc SM_popString ] extension pop |
|
[(flush)] extension pop |
|
%% Select inputs for interruption. |
|
%% Wait by the spin lock. |
|
{ |
|
[(oxMultiSelect) [oxasir.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) oxasir.ccc] extension /err set |
|
[(oxGet) oxasir.ccc] extension /httpd.result set |
|
%% oxasir.ccc oxpopstring /httpd.result set |
|
} { |
|
oxasir.ccc oxreset |
|
oxasir.ccc ("computation is interrupted.";) oxexecutestring ; |
|
oxasir.ccc oxpopstring |
|
/httpd.result set |
|
exit |
|
} ifelse |
(------------- result -------------) message |
(------------- result -------------) message |
httpd.result message |
httpd.result message |
(----------------------------------) message |
(----------------------------------) message |
( ) message |
( ) message |
|
|
|
err message |
|
err [ ] eq { |
|
/httpd.history |
|
httpd.history |
|
[10 (string) dc |
|
(/**** ) httpd.serial toString ( ****/) |
|
10 (string) dc |
|
httpd.com |
|
(;) %% add extra ; |
|
] cat |
|
append |
|
def |
|
} { |
|
oxasir.ccc cleanErrors |
|
[httpd.result 10 (string) dc err toString] cat |
|
/httpd.result set |
|
} ifelse |
|
|
[httpd.serial 0 eq { } { |
[httpd.serial 0 eq { } { |
(<title> asirweb </title> ) |
(<title> asirweb </title> ) |
(<font color="blue"> Input-) httpd.serial toString |
(<font color="blue"> Input-) httpd.serial toString |
(: </font> ) |
(: </font> ) |
(<pre> ) httpd.com (</pre>) (<br>) |
httpd.com preformatHTML (<br>) |
} ifelse |
} ifelse |
(<font color="green"> Output-) httpd.serial toString |
(<font color="green"> Output-) httpd.serial toString |
(: </font> ) |
(: </font> ) |
(<pre>) httpd.result (</pre>) |
(<a href="http://localhost:) httpd.port toString |
|
(/?msg=httpdAsirMeta+Pretty+) httpd.serial toString |
|
("> (in pretty format) </a>) |
|
%%(<a href=") httpd.image.name ("> (in pretty format) </a>) %%test |
|
httpd.result preformatHTML |
|
httpd.result.history httpd.result append /httpd.result.history set |
] cat |
] cat |
send-page-3 exit |
send-page-3 exit %% exit the loop LOOP-A |
} { } ifelse %% metaCommand |
} { exit } ifelse %% metaCommand |
} ifelse |
} ifelse |
} loop |
} loop %% LOOP-A |
] pop |
] pop |
popVariables |
popVariables |
} def |
} def |
|
|
result sendln |
result sendln |
(<FORM NAME="myFORM">) sendln |
(<FORM NAME="myFORM">) sendln |
(<INPUT TYPE=submit VALUE="submit">) sendln |
(<INPUT TYPE=submit VALUE="submit">) sendln |
(<textarea name=msg rows=10 cols="80" wrap="soft"></textarea>) sendln |
[(<textarea name=) httpd.textarea.name |
|
( rows=10 cols="80" wrap="soft"></textarea>)] cat sendln |
(</FORM>) sendln |
(</FORM>) sendln |
send-menu-1 |
send-menu-1 |
0 sendln |
0 sendln |
|
|
popVariables |
popVariables |
} def |
} 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.asirman |
/httpd.asirman |
("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_toc.html") |
("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_toc.html") |
def |
def |
|
|
[$<a href="http://localhost:$ httpd.port toString |
[$<a href="http://localhost:$ httpd.port toString |
$/?msg=httpdAsirMeta+quit"> Shutdown the asir server. </a>, $ |
$/?msg=httpdAsirMeta+quit"> Shutdown the asir server. </a>, $ |
] cat sendln |
] cat sendln |
|
%% [$<a href="http://localhost:$ httpd.port toString |
|
%% $/?msg=httpdAsirMeta+interrupt"> interrupt </a>, $ |
|
%% ] cat sendln |
|
[$<a href="http://localhost:$ httpd.port toString |
|
$/?msg=httpdAsirMeta+save"> save. </a>, $ |
|
] cat sendln |
( <spacer type=horizontal size=80> ) sendln |
( <spacer type=horizontal size=80> ) sendln |
|
|
(HELP:) sendln |
(HELP:) sendln |
|
|
<a href=) httpd.asir.intro ( > Intro (Ja) </a> </font>, )] cat sendln |
<a href=) httpd.asir.intro ( > Intro (Ja) </a> </font>, )] cat sendln |
} def |
} def |
|
|
|
/send-page-save { |
|
[/in-send-page-save /i] pushVariables |
|
[ |
|
(HTTP/0.9 200 OK) sendln |
|
(Connection: close) sendln |
|
(Content-Type: text/plain) sendln |
|
0 sendln |
|
(/* Saved the following to sm1out.txt */) sendln |
|
(/* Save the following by your browser as a text file. */) sendln |
|
|
|
0 1 httpd.history length 1 sub { |
|
/i set |
|
httpd.history i get sendln |
|
} for |
|
( end$) sendln |
|
0 sendln |
|
[(flush)] extension |
|
[(PrintDollar) 1] system_variable |
|
httpd.history output |
|
[(PrintDollar) 0] system_variable |
|
] 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 oxasir without a session key! <br>) sendln |
|
0 sendln |
|
[(flush)] extension |
|
} def |
|
|
/stopclient { |
/stopclient { |
[(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message |
[(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message |
} def |
} 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 { |
/fromHex { |
/arg1 set |
/arg1 set |
[/in-fromHex /s1 /s2 /c /c2] pushVariables |
[/in-fromHex /s1 /s2 /c /c2] pushVariables |
|
|
arg1 |
arg1 |
} def |
} 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 { |
/removeGET { |
/arg1 set |
/arg1 set |
[/in-removeGET /s /s2 /i /j] pushVariables |
[/in-removeGET /s /s2 /i /j /i0 |
|
/tname |
|
] pushVariables |
[ |
[ |
/s arg1 def |
/s arg1 def |
|
/httpd.textarea.valid 1 def |
s 1 copy /s2 set |
s 1 copy /s2 set |
s (array) dc /s 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 |
/j 0 def |
10 1 s length 1 sub { |
i0 1 s length 1 sub { |
/i set |
/i set |
s2 j << s i get (string) dc >> put |
s2 j << s i get (string) dc >> put |
j 1 add /j set |
j 1 add /j set |
|
|
arg1 |
arg1 |
} def |
} 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 |
[/in-metaCommand /msg /result] pushVariables |
[/in-metaCommand /msg /result /msg2 /nn] pushVariables |
[ |
[ |
/msg arg1 def |
/msg arg1 def |
/result 1 def |
/result 1 def |
|
msg 1 copy toTokensBySpace /msg2 set |
|
msg2 length 3 eq { |
|
msg2 0 get (httpdAsirMeta) eq |
|
msg2 1 get (Pretty) eq and |
|
{ |
|
msg2 2 get . (integer) dc /nn set |
|
|
|
%%BUG: This part should be rewritten. |
|
%% Reformat the "nn"-th result by tex and send it. |
|
httpd.result.history nn get message |
|
httpd.image.name httpd.image.type send-image |
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
|
|
|
/result 0 def |
|
} { } ifelse |
|
}{ } ifelse |
msg (httpdAsirMeta quit) eq { |
msg (httpdAsirMeta quit) eq { |
|
oxasir.ccc oxshutdown |
send-page-bye |
send-page-bye |
quit |
quit |
|
/result 0 def |
|
} { } ifelse |
|
msg (httpdAsirMeta save) eq { |
|
send-page-save |
|
/result 0 def |
|
} { } ifelse |
|
msg (httpdAsirMeta interrupt) eq { |
|
oxasir.ccc oxreset |
|
(Interrupted! <br>) send-page-3 |
/result 0 def |
/result 0 def |
} { } ifelse |
} { } ifelse |
/arg1 result def |
/arg1 result def |