===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v
retrieving revision 1.7
retrieving revision 1.11
diff -u -p -r1.7 -r1.11
--- OpenXM/src/kan96xx/Doc/httpd-asir.sm1	2001/04/22 01:02:27	1.7
+++ 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.6 2001/04/22 00:34:01 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,6 +12,7 @@
    " Risa/Asir oxasir version "+rtostr(version());)
  ] cat
 def
+
 [(parse) (oxasir.sm1) pushfile] extension 
 (oxasir.started) boundp { 
 } {
@@ -63,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 ;
@@ -96,17 +128,32 @@ 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 {
-            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
@@ -150,6 +197,7 @@ def
                  (/**** ) httpd.serial toString ( ****/) 
                  10 (string) dc
                   httpd.com 
+                 (;)  %% add extra ;
                  ] cat
                 append 
               def
@@ -163,16 +211,21 @@ def
                 (<title> asirweb </title> )
                 (<font color="blue"> Input-) httpd.serial toString
                  (: </font> )  
-                (<pre> ) httpd.com (</pre>) (<br>)
+                 httpd.com preformatHTML (<br>)
               } ifelse
              (<font color="green"> Output-) httpd.serial toString
              (: </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
-            send-page-3  exit
+            send-page-3  exit  %% exit the loop LOOP-A
           } { exit } ifelse  %% metaCommand
         } ifelse
-  } loop
+  } loop  %% LOOP-A
   ] pop
   popVariables
 } def
@@ -224,7 +277,8 @@ def
    result sendln
    (<FORM NAME="myFORM">) 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
    send-menu-1
    0 sendln
@@ -233,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
@@ -270,19 +353,16 @@ def
  [
    (HTTP/0.9 200 OK) sendln
    (Connection: close) sendln
-   (Content-Type: text/html) sendln
+   (Content-Type: text/plain) sendln
    0 sendln
-   (<html> <body>) sendln
-   (/* Saved the following to sm1out.txt */<br>) sendln
-   (/* Save the following by your browser as a text file. */<br>) sendln
+   (/* Saved the following to sm1out.txt */) sendln
+   (/* Save the following by your browser as a text file. */) sendln
    
-   (<pre>) sendln
    0 1 httpd.history length 1 sub {
      /i set
      httpd.history i get sendln
    } for
-   (</pre>) sendln
-   (</body> </html>) sendln
+   ( end$) sendln
    0 sendln
    [(flush)] extension
    [(PrintDollar) 1] system_variable
@@ -292,6 +372,15 @@ 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! <br>) sendln
+   0 sendln
+   [(flush)] extension
+} def
 
 /stopclient {
   [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
@@ -343,21 +432,113 @@ 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 /i0] 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
@@ -411,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 (&lt) def
+          } {  } ifelse
+          c 62 eq {
+            /c (&gt) def
+          } {  } ifelse
+          c 38 eq {
+            /c (&amp) def
+          } {  } ifelse
+        ] pop
+        c (string) dc
+     } map cat /sss set
+     [(<pre> ) sss ( </pre> )] 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