=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v retrieving revision 1.1 retrieving revision 1.31 diff -u -p -r1.1 -r1.31 --- OpenXM/src/kan96xx/Doc/httpd-asir.sm1 2001/04/20 13:38:31 1.1 +++ OpenXM/src/kan96xx/Doc/httpd-asir.sm1 2014/08/28 11:27:34 1.31 @@ -1,234 +1,358 @@ -%% $OpenXM$ +%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v 1.30 2010/02/08 01:08:39 takayama Exp $ %% http server by sm1 + +[(parse) (httpd.sm1) pushfile] extension pop + +/httpd.port 1200 def +/httpd.image.name (kobeuniv2.jpg) def + +/httpd.initialization +%% Put initialization codes here. + [ + (XM_debug=0; ctrl("debug_window",0);) + ("Asirweb version 0.80. "+ + " 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 -/startserver { - [(sm1.socket) (open) [1200 (localhost)]] extension /server.fdAndPort set - (sm1.socket.open returns ) messagen server.fdAndPort message - [(sm1.socket) (accept) [server.fdAndPort 0 get]] extension - /server.fd set - (connected.) message - (sm1.socket.accept returns ) messagen server.fd message +/ox-win.start.iconic 1 def +/ox.win.set.start { + [(stat) (c:\windows\system32\cmd.exe)] extension 0 get + 0 eq { + /ox.win.start.0 [(c:\windows\system32\cmd.exe) (/c) (start)] def + /ox.win.start [ox.win.start.0 aload pop + ox-win.start.iconic { (/min) } { } ifelse ] def + }{ + [(stat) (c:\winnt\system32\cmd.exe)] extension 0 get + 0 eq { + /ox.win.start.0 [(c:\winnt\system32\cmd.exe) (/c) (start) ] def + /ox.win.start [ox.win.start.0 aload pop + ox-win.start.iconic { (/min) } { } ifelse ] def + }{ + /ox.win.start.0 [ (start) ] def + /ox.win.start [ ox.win.start.0 aload pop + ox-win.start.iconic { (/min) } { } ifelse ] def + } ifelse + } ifelse } def -/stopserver { - [(sm1.socket) (close) server.fd ] extension message -} def +/webasir { asirweb } def +/asirweb { + [/rrr /cmd] 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 -/send { - /arg1 set - [(sm1.socket) (write) [server.fd 0 get arg1]] extension message -} def + %%[(sleep 3; firefox -geometry 800x500 http://localhost:) + %% httpd.port toString + %% ( &)] cat system + [(ostype)] extension 0 get + (windows) eq { + %% On windows. + ox.win.set.start + [(forkExec) + [ + %%(c:\windows\command\start) + ox.win.start.0 aload pop + (iexplore) %% Starting internet explorer (TM). + [(http://localhost:) httpd.port toString] cat + ] + [ ] + 3] extension + }{ + %% On unix. + httpd.port httpd.startBrowserUnix + } ifelse -/sendln { - /mmm set - mmm tag 5 eq { - [mmm 10 (string) dc] cat /mmm set - }{ - 10 (string) dc /mmm set - } ifelse - [(sm1.socket) (write) [server.fd 0 get mmm]] extension message + httpd ; + ] pop + popVariables } def -/httpd { - { - startserver ; - action ; - stopserver ; - (5 sleep) system - } loop -} def -/action { +/httpd_action { + [/in-httpd /ff /httpd.com /httpd.result /sss + /sss.engine /sss.web /err + /oxserver.vname + ] pushVariables + [ { - /httpd.com.old ( ) def - [(sm1.socket) (select) [server.fd 0 get -1]] extension -%% wait for ever - { - [(sm1.socket) (read) [server.fd 0 get ]] extension /ff set - ff length 0 eq { - (connection is closed.) message + [(sm1.socket) (select) [httpd.server.fd 0 get -1]] extension + %% wait for ever + [(sm1.socket) (readHTTP) [httpd.server.fd 0 get ]] extension /ff set + ff tag 0 eq { + (connection is closed.) message exit } - ff (quit) eq - { (We exit the function httpd) message exit } - { %% [(SigIgn) 0] system_variable + { (------------ 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 - oxasir.ccc - [(if (1) {) httpd.com (};)] cat - oxexecutestring ; - oxasir.ccc oxpopstring /httpd.result set - /httpd.com.old httpd.com def - (------------- result -------------) message - httpd.result message - (----------------------------------) message - ( ) message - [(Input:) (
 ) httpd.com (
) (
) - (Output:) (
)
-            httpd.result 
-            (
) - ] cat - send-page-3 exit - %% [(SigIgn) 1] system_variable + httpd.serial 0 eq { + /httpd.com httpd.initialization def + /httpd.textarea.valid 1 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.textarea.valid { + /oxserver.vname + [Oxserver_history_variable httpd.serial toString] cat + def + 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_setName oxserver.vname] extension pop + oxasir.ccc [oxserver.vname (;)] cat oxexecutestring + + [(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 + 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 preformatHTML (
) + } ifelse + ( Output-) httpd.serial toString + (: ) + ( (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 %% exit the loop LOOP-A + } { exit } ifelse %% metaCommand } ifelse - } - { } ifelse - } loop + } loop %% LOOP-A + ] pop + popVariables } def -/send-page-1 { - (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 - 0 sendln - (HOGE HOGE!) sendln - 0 sendln - [(flush)] extension + +/httpd.asirman + ("http://www.math.sci.kobe-u.ac.jp/OpenXM/Current/doc/asir2000/html-ja/man_toc.html") +def +/httpd.asirman.contrib + ("http://www.math.sci.kobe-u.ac.jp/OpenXM/Current/doc/asir-contrib/ja/cman-html/cman-ja_toc.html") +def +/httpd.asir.intro + ("http://www.math.sci.kobe-u.ac.jp/~taka/asir-book-html/main") +def +/send-menu-1 { + + (FILE:) sendln + [$ Shutdown the asir server. , $ + ] cat sendln +%% [$ interrupt , $ +%% ] cat sendln + [$ save. , $ + ] cat sendln + ( ) sendln + + (HELP:) sendln + [( + AsirManual (Ja) , )] cat sendln + [( + AsirContrib (Ja) , )] cat sendln + [( + Intro (Ja) , )] cat sendln } def -/send-page-2 { +/send-page-save { + [/in-send-page-save /i] pushVariables + [ (HTTP/0.9 200 OK) sendln -%% (Content-Length: 10) sendln (Connection: close) sendln - (Content-Type: text/html) sendln + (Content-Type: text/plain) sendln 0 sendln - (
) sendln - () sendln - (
) 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-3 { + +/metaCommand { /arg1 set - [/in-send-page-3 /result] pushVariables + [/in-metaCommand /msg /result /msg2 /nn + /err /fn + ] pushVariables [ - /result arg1 def - (HTTP/0.9 200 OK) sendln - (Connection: close) sendln - (Content-Type: text/html) sendln - 0 sendln -%% (
) sendln - result sendln - () sendln - () sendln - () sendln - (
) sendln - 0 sendln - [(flush)] extension - ] pop - popVariables -} def + /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 + { + httpd.image.type tag 0 eq { + send-page-warning-image + /skip-image goto + } { } ifelse -/stopclient { - [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message -} def + msg2 2 get . (integer) dc /nn set + %% Reformat the "nn"-th result by tex and send it. + %% BUG: index is out of bound. httpd.result.history nn get message -/fromHex { - /arg1 set - [/in-fromHex /s1 /s2 /c /c2] pushVariables - [ - arg1 0 get /s1 set - arg1 1 get /s2 set + oxasir.ccc + [$print_$ httpd.image.type $_form(Oxserver_history_variable_$ + nn toString + $);$ + ] cat + (cmo) + executeStringAndSelectInputFromBrowserAndOxserver + dup 0 get /err set + 1 get /fn set + err [ ] eq { + fn 0 get httpd.image.type send-image + } { + [err preformatHTML] cat + send-page-3 + } ifelse + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - 48 s1 le s1 57 le and { % 0, ..., 9 - s1 48 sub /c set + /skip-image + /result 0 def + } { } ifelse }{ } 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 + msg (httpdAsirMeta quit) eq { + oxasir.ccc oxshutdown + send-page-bye + quit + /result 0 def + } { } ifelse + msg (httpdAsirMeta save) eq { + send-page-save + /result 0 def + } { } ifelse + msg (httpdAsirMeta interrupt) eq { + oxasir.ccc oxreset + (Interrupted!
) send-page-3 + /result 0 def + } { } ifelse + /arg1 result def ] pop popVariables arg1 } def -/removeGET { - /arg1 set - [/in-removeGET /s /s2 /i /j] pushVariables - [ - /s arg1 def - s 1 copy /s2 set - s (array) dc /s set - /j 0 def - 10 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 +/webasir2 { + [/rrr /cmd /mypid /lockname] 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 -/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 \ No newline at end of file + [(getpid)] extension (dollar) dc /mypid set + /httpd.textarea.name randomName def + [(/tmp/webasir-) mypid (.txt)] cat /lockname set + [(outputObjectToFile) lockname + [httpd.port nl httpd.textarea.name nl ] cat + ] extension + lockname message + [(cat ) lockname] cat (system) nl message + httpd ; + [(rm -f ) lockname] cat system + ] pop + popVariables +} def