===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/httpd-rpc.sm1,v
retrieving revision 1.9
retrieving revision 1.12
diff -u -p -r1.9 -r1.12
--- OpenXM/src/kan96xx/Doc/httpd-rpc.sm1	2002/10/29 10:54:17	1.9
+++ OpenXM/src/kan96xx/Doc/httpd-rpc.sm1	2002/11/10 07:00:03	1.12
@@ -1,17 +1,37 @@
-%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-rpc.sm1,v 1.8 2002/10/29 00:19:56 takayama Exp $
+%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-rpc.sm1,v 1.11 2002/11/04 05:40:40 takayama Exp $
 %% http server by sm1. Used for RPC.  Generic example.
 
 [(parse) (httpd.sm1) pushfile] extension pop
+
+/httpd_action {  
+   httpd_action_allow_file_transfer  
+        %% If OXWEB_HTTPD_ROOT is set, file transfer will be allowed.
+        %% Example:  export OXWEB_HTTPD_ROOT=/usr/local/www/data/
+        %% Do not forget the last /
+%  httpd_action_rpc_only    %% old
+} def
+%% keyword for rpc
 /httpd.textarea.name (rpc) def
 /httpd.textarea.name.aaa
   [(GET /?) httpd.textarea.name] cat (array) dc
 def
-/httpd.port 8090 def
+
+[(getenv) (OXWEB_PORT)] extension tag 0 eq {
+  (Default httpd port : ) messagen
+  /httpd.port 8090 def
+} {  
+  /httpd.port [(getenv) (OXWEB_PORT)] extension .. (integer) dc def
+} ifelse
+(httpd.port = ) messagen httpd.port message
+
 /httpd.serial 0 def
 
 /httpd.oxasir.timer 1 def  %% 1 to use timer, but it accepts only one command
                            %% 0 not to use timer. It accepts programs.
 
+/httpd.title  
+  (<H1><font color="green">OpenXM/Risa/Asir Online</font></H2><br>) 
+def
 %%******* Put initialization codes for ox_asir here. 
 /httpd.initialization
  [(if(1){)
@@ -73,7 +93,7 @@ oxNoX 
 } def
 
 
-/httpd_action {
+/httpd_action_rpc_only {
   [/in-httpd /ff /httpd.com /httpd.result /sss
    /sss.engine /sss.web /err
    /oxserver.vname /scheck
@@ -175,8 +195,133 @@ oxNoX 
 } def
 
 
+/httpd_action_allow_file_transfer {
+  [/in-httpd /ff /httpd.com /httpd.result /sss
+   /sss.engine /sss.web /err
+   /oxserver.vname /scheck /ff2
+  ] pushVariables
+  [
+   (httpd_action_allow_file_transfer: ) 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
+        }
+        {
+          (------------  start ----------------------) message
+             ff message
+          (-----------------------------------------) message
+             ff httpd.parse /ff2 set
+             ff2 message
+             /httpd.textarea.valid 0 def /httpd.com ( ) def
+             ff2 0 get (GET-file) eq {
+                ff2 length 1 eq httpd.root tag 0 eq {
+                  send-page-usage
+                  exit
+                } {  } ifelse
+                ff2 httpd_sendfile exit
+             } {  } ifelse
+             ff2 0 get (GET) eq ff2 0 get (POST) eq or {
+              ff2 1 get tag 6 eq 
+              ff2 1 get length 2 eq and
+              {  % list 
+                ff2 1 get 0 get httpd.textarea.name eq {
+                  /httpd.textarea.valid 1 def
+                  /httpd.com ff2 1 get 1 get def
+                }{ } ifelse
+                ff2 1 get 0 get (msg) eq { %% meta command
+                  /httpd.textarea.valid 0 def
+                  /httpd.com ff2 1 get 1 get def
+                }{ } ifelse
+              } { } ifelse
+             }{  } ifelse
+             %% ff removeGET webstringToAscii /httpd.com set
+             [(httpd.com=) httpd.com] cat message
+          (------------  end ----------------------) message
+          (   ) message
 
+          httpd.com metaCommand {
+            httpd.textarea.valid {
 
+              %%% Security check
+              [(regionMatches) httpd.com 
+               httpd.refusedCommands] extension /scheck set
+              scheck 0 get -1 eq {
+              }{ 
+                httpd.refusedCommands scheck 2 get get message
+                (Command is refused.) message
+                [
+                 httpd.refusedCommands scheck 2 get get
+                 httpd.com
+                ]
+                 send-page-refused exit
+              } ifelse
+
+              %%%  Executing command, here.
+              oxasir.ccc 
+              httpd.com cookedCommand 
+              oxexecutestring ;
+
+            }{
+              send-page-usage  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.
+            %% 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 oxreset
+                oxasir.ccc ("computation is interrupted.";) oxexecutestring ;
+                oxasir.ccc oxpopstring
+                /httpd.result set 
+                exit
+            } ifelse
+            (------------- result -------------) message
+            httpd.result message
+            (----------------------------------) message
+            (  ) message
+            
+            (----------- error -------------) message
+            err message
+            (-------------------------------) message
+            err [ ] eq  { 
+            } {
+              oxasir.ccc cleanErrors
+              [httpd.result 10 (string) dc err toString] cat
+              /httpd.result set
+            } ifelse
+
+            httpd.result send-page-result  exit  %% exit the loop LOOP-A
+          } { exit } ifelse  %% metaCommand
+        } ifelse
+  } loop  %% LOOP-A
+  ] pop
+  popVariables
+} def
+
+
 /metaCommand {
   /arg1 set
   [/in-metaCommand /msg /result /msg2 /nn
@@ -202,6 +347,24 @@ oxNoX 
   arg1
 } def
 
+ [
+  (Input example---factorization:<font color="blue"> fctr(x^3-1)</font>) 
+  (<br>) 
+  [(<font color="blue"> 
+    <a href=) httpd.asirman ( > AsirManual (En) </a> </font>, )] cat 
+  [(<font color="blue"> 
+    <a href=) httpd.asirman.ja ( > AsirManual (Ja) </a> </font>)] cat 
+   httpd.oxasir.timer {
+    (<br> It accepts only one command. The limit of CPU time is 30 seconds.
+          <font color="red"> Do not put <font color="blue"> ; </font> 
+                             (semi-colon) after the command. 
+          </font>) 
+   }{ } ifelse  
+   (<br>) 
+  [(You can also retrieve the result by GET /?) httpd.textarea.name (=) ( encoded_codes  HTTP/1.0)] 
+   (<br>) 
+ ] cat /httpd.msg1 set
+
 /send-page-usage {
   [/in-send-page-usage ] pushVariables
   [
@@ -210,7 +373,7 @@ oxNoX 
    (Content-Type: text/html) sendln
    0 sendln
 
-  (<H1><font color="green">OpenXM/Risa/Asir Online</font></H2><br>) sendln
+  httpd.title sendln
   [(getenv) (OXWEB_POST)] extension tag 0 eq {
     (<FORM NAME="myFORM">) sendln  % use get
   }{
@@ -221,22 +384,8 @@ oxNoX 
     ( rows=7 cols="80" wrap="soft"></textarea>)] cat sendln
    (</FORM>) sendln
 
-  (Input example---factorization:<font color="blue"> fctr(x^3-1)</font>) sendln
-  (<br>) sendln
-  [(<font color="blue"> 
-    <a href=) httpd.asirman ( > AsirManual (En) </a> </font>, )] cat sendln
-  [(<font color="blue"> 
-    <a href=) httpd.asirman.ja ( > AsirManual (Ja) </a> </font>)] cat sendln
-   httpd.oxasir.timer {
-    (<br> It accepts only one command. The limit of CPU time is 30 seconds.
-          <font color="red"> Do not put <font color="blue"> ; </font> 
-                             (semi-colon) after the command. 
-          </font>) sendln
-   }{ } ifelse  
-   (<br>) sendln
-  [(You can also retrieve the result by GET /?) httpd.textarea.name (=) ( encoded_codes  HTTP/1.0)] cat 
-  sendln
-   (<br>) sendln
+   httpd.msg1 sendln
+
    [$<a href="http://$ [(sm1.socket) (gethostname) []] extension 
     $:$ httpd.port toString
     $/?msg=httpdAsirMeta+quit"> Shutdown the oxserver (and restart it). </a>$
@@ -258,10 +407,13 @@ oxNoX 
    (HTTP/0.9 200 OK) sendln
    (Connection: close) sendln
    [(Content-length: ) result length toString ] cat sendln
-   (Content-Type: text/plain) sendln
+   (Content-Type: text/html) sendln
+   %(Content-Type: text/plain) sendln  % It does not work on some browsers.
    0 sendln
 
+   (<html> <body> <pre>) sendln
    result sendln
+   (</pre> </body> </html>) sendln
    0 sendln
    [(flush)] extension
   ] pop