=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v retrieving revision 1.5 retrieving revision 1.11 diff -u -p -r1.5 -r1.11 --- OpenXM/src/kan96xx/Doc/httpd-asir.sm1 2001/04/21 13:54:29 1.5 +++ OpenXM/src/kan96xx/Doc/httpd-asir.sm1 2001/08/12 07:20:37 1.11 @@ -1,7 +1,10 @@ -%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v 1.4 2001/04/21 11:16:30 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 /httpd.port 1200 def +/httpd.image.name (kobeuniv2.jpg) def +/httpd.image.type (jpeg) def + /httpd.initialization %% Put initialization codes here. [ @@ -9,17 +12,31 @@ " Risa/Asir oxasir version "+rtostr(version());) ] cat def + [(parse) (oxasir.sm1) pushfile] extension (oxasir.started) boundp { } { + %% Initialize oxasir. [(x^2-1) (x)] fctr pop oxasir.ccc oxmathcap oxasir.ccc oxsetmathcap } ifelse /asirweb { - (sleep 3; netscape -geometry 800x500 http://localhost:1200 &) system + [/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 { @@ -50,14 +67,42 @@ def }{ 10 (string) dc /mmm set } ifelse - [(sm1.socket) (write) [httpd.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 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 ; @@ -69,7 +114,7 @@ def /httpd_action { [/in-httpd /ff /httpd.com /httpd.result /sss - /sss.engine /sss.web + /sss.engine /sss.web /err ] pushVariables [ { @@ -83,27 +128,35 @@ def (------------ start ----------------------) message ff message (-----------------------------------------) message - ff removeGET webstringToAscii /httpd.com set - httpd.com message + ff 1 copy askToSendFile /httpd.sendFile set + 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 ( ) message httpd.serial 0 eq { /httpd.com httpd.initialization def } { } ifelse + httpd.sendFile tag 0 eq { } + { + httpd.sendFile httpd.image.type send-image + exit %% exit the loop LOOP-A + } ifelse httpd.com metaCommand { - /httpd.history - httpd.history - [10 (string) dc - (/**** ) httpd.serial toString ( ****/) - 10 (string) dc - httpd.com - ] cat - append - def - oxasir.ccc - [(if (1) {) httpd.com (};)] cat - oxexecutestring ; + httpd.textarea.valid { + oxasir.ccc + [(if (1) {) httpd.com (; };)] cat + oxexecutestring ; + }{ + 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. @@ -121,6 +174,7 @@ def sss message sss 0 get { + [(oxGet) oxasir.ccc] extension /err set [(oxGet) oxasir.ccc] extension /httpd.result set %% oxasir.ccc oxpopstring /httpd.result set } { @@ -134,20 +188,44 @@ def httpd.result 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 { } { ( asirweb ) ( Input-) httpd.serial toString (: ) - (
 ) httpd.com (
) (
) + httpd.com preformatHTML (
) } ifelse ( Output-) httpd.serial toString (: ) - (
) httpd.result (
) + ( (in pretty format) ) + %%( (in pretty format) ) %%test + httpd.result preformatHTML + httpd.result.history httpd.result append /httpd.result.history set ] cat - send-page-3 exit + send-page-3 exit %% exit the loop LOOP-A } { exit } ifelse %% metaCommand } ifelse - } loop + } loop %% LOOP-A ] pop popVariables } def @@ -199,7 +277,8 @@ def result sendln (
) sendln () sendln - () sendln + [()] cat sendln (
) sendln send-menu-1 0 sendln @@ -208,6 +287,35 @@ def 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.asirman ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_toc.html") def @@ -245,18 +353,16 @@ def [ (HTTP/0.9 200 OK) sendln (Connection: close) sendln - (Content-Type: text/html) sendln + (Content-Type: text/plain) sendln 0 sendln - ( ) sendln - (/* Save the following to sm1out.txt */
) sendln + (/* Saved the following to sm1out.txt */) sendln + (/* Save the following by your browser as a text file. */) sendln - (
) sendln
    0 1 httpd.history length 1 sub {
      /i set
      httpd.history i get sendln
    } for
-   (
) sendln - ( ) sendln + ( end$) sendln 0 sendln [(flush)] extension [(PrintDollar) 1] system_variable @@ -266,12 +372,33 @@ def 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!
) 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 @@ -305,15 +432,117 @@ def 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] pushVariables + [/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 - 10 1 s length 1 sub { + i0 1 s length 1 sub { /i set s2 j << s i get (string) dc >> put j 1 add /j set @@ -363,13 +592,57 @@ def 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 + [(
 ) sss (
)] cat /arg1 set + ] pop + popVariables + arg1 +} def + /metaCommand { /arg1 set - [/in-metaCommand /msg /result] pushVariables + [/in-metaCommand /msg /result /msg2 /nn] pushVariables [ /msg arg1 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 { + oxasir.ccc oxshutdown send-page-bye quit /result 0 def