===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v
retrieving revision 1.11
retrieving revision 1.30
diff -u -p -r1.11 -r1.30
--- OpenXM/src/kan96xx/Doc/httpd-asir.sm1 2001/08/12 07:20:37 1.11
+++ OpenXM/src/kan96xx/Doc/httpd-asir.sm1 2010/02/08 01:08:39 1.30
@@ -1,13 +1,15 @@
-%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v 1.10 2001/04/23 13:34:00 takayama Exp $
+%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v 1.29 2009/02/22 17:30:03 ohara Exp $
%% http server by sm1
+[(parse) (httpd.sm1) pushfile] extension pop
+
/httpd.port 1200 def
/httpd.image.name (kobeuniv2.jpg) def
-/httpd.image.type (jpeg) 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
@@ -22,8 +24,30 @@ def
oxasir.ccc oxsetmathcap
} ifelse
+/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
+
+/webasir { asirweb } def
/asirweb {
- [/rrr ] pushVariables
+ [/rrr /cmd] pushVariables
[
%% This procedure to generate port number might fail.
[(oxGenPass)] extension . (integer) dc /rrr set
@@ -31,98 +55,45 @@ def
/httpd.port 1200 rrr add def
httpd.port message
- [(sleep 3; netscape -geometry 800x500 http://localhost:)
- httpd.port toString
- ( &)] cat system
+ %%[(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
+
httpd ;
] pop
popVariables
} 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: 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 {
[/in-httpd /ff /httpd.com /httpd.result /sss
/sss.engine /sss.web /err
+ /oxserver.vname
] pushVariables
[
{
[(sm1.socket) (select) [httpd.server.fd 0 get -1]] extension
%% wait for ever
- [(sm1.socket) (read) [httpd.server.fd 0 get ]] extension /ff set
- ff length 0 eq {
- (connection is closed.) message
+ [(sm1.socket) (readHTTP) [httpd.server.fd 0 get ]] extension /ff set
+ ff tag 0 eq {
+ (connection is closed.) message exit
}
{
(------------ start ----------------------) message
@@ -140,6 +111,7 @@ def
( ) message
httpd.serial 0 eq {
/httpd.com httpd.initialization def
+ /httpd.textarea.valid 1 def
} { } ifelse
httpd.sendFile tag 0 eq { }
{
@@ -148,8 +120,11 @@ def
} ifelse
httpd.com metaCommand {
httpd.textarea.valid {
+ /oxserver.vname
+ [Oxserver_history_variable httpd.serial toString] cat
+ def
oxasir.ccc
- [(if (1) {) httpd.com (; };)] cat
+ [(if (1) {) httpd.com (; };)] cat
oxexecutestring ;
}{
send-page-warning exit
@@ -157,6 +132,10 @@ def
[(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.
@@ -231,96 +210,12 @@ 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
- () sendln
- (Shutdown the engine.
) sendln
- (See you! asirweb ) sendln
- () 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
- () 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
-%% () 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.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/Current/doc/asir2000/html-ja/man_toc.html")
def
-/httpd.asirman.index
- ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_262.html#SEC262")
+/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")
@@ -343,7 +238,7 @@ def
[(
AsirManual (Ja) , )] cat sendln
[(
- Index (Ja) , )] cat sendln
+ AsirContrib (Ja) , )] cat sendln
[(
Intro (Ja) , )] cat sendln
} def
@@ -372,257 +267,13 @@ 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 {
+/metaCommand {
/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
+ [/in-metaCommand /msg /result /msg2 /nn
+ /err /fn
] 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
- [( ) sss (
)] cat /arg1 set
- ] pop
- popVariables
- arg1
-} def
-
-/metaCommand {
- /arg1 set
- [/in-metaCommand /msg /result /msg2 /nn] pushVariables
- [
/msg arg1 def
/result 1 def
msg 1 copy toTokensBySpace /msg2 set
@@ -630,14 +281,35 @@ def
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
+
+
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
+ %% BUG: index is out of bound. httpd.result.history nn get message
+
+ 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
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ /skip-image
/result 0 def
} { } ifelse
}{ } ifelse