=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v retrieving revision 1.11 retrieving revision 1.12 diff -u -p -r1.11 -r1.12 --- OpenXM/src/kan96xx/Doc/httpd-asir.sm1 2001/08/12 07:20:37 1.11 +++ OpenXM/src/kan96xx/Doc/httpd-asir.sm1 2001/08/23 00:16:55 1.12 @@ -1,6 +1,8 @@ -%% $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.11 2001/08/12 07:20:37 takayama 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 @@ -22,6 +24,7 @@ def oxasir.ccc oxsetmathcap } ifelse +/webasir { asirweb } def /asirweb { [/rrr ] pushVariables [ @@ -39,79 +42,7 @@ def 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 @@ -231,91 +162,7 @@ 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 - () 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 - result sendln - () sendln - () sendln - [()] cat 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") def @@ -372,252 +219,6 @@ 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 - [ - 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 - [(
 ) sss ( 
)] cat /arg1 set - ] pop - popVariables - arg1 -} def /metaCommand { /arg1 set