%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-rpc.sm1,v 1.17 2013/03/07 02:10:32 takayama Exp $
%% http server by sm1. Used for RPC.  Generic example.

[(parse) (httpd.sm1) pushfile] extension pop
/httpd.textmode 1 def  %% It does not work on some browsers.

/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

[(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){)
  (XM_debug=0; ctrl("debug_window",0); Xm_noX=1;)
  ("Asirweb version 0.80. "+
   " Risa/Asir oxasir version "+rtostr(version());)
  (};)
 ] cat
def

/httpd.asirman
 ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.2.1/doc/asir2000/html-en/man_toc.html")
def
/httpd.asirman.ja
 ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.2.1/doc/asir2000/html-ja/man_toc.html")
def

[(parse) (oxasir.sm1) pushfile] extension 
oxNoX 
(oxasir.started) boundp { 
} {
  %% Initialize oxasir.
  [(x^2-1) (x)] fctr pop
  oxasir.ccc oxmathcap
  oxasir.ccc oxsetmathcap
  oxasir.ccc httpd.initialization oxexecutestring ;
  (Initialization returns ...: ) messagen
  oxasir.ccc oxpopcmo message ;
} ifelse

/webrpc  {
 [/rrr ] pushVariables
 [
  [(oxGenPass)] extension . (integer) dc  /rrr set

  [(ostype)] extension 0 get
   (windows) eq {
     %% On windows.
      [(forkExec)
       [
         ox.win.start.0 aload pop
         (iexplore)   %% Starting internet explorer (TM).
         [(http://) [(sm1.socket) (gethostname) []] extension 
          (:) httpd.port toString] cat
       ]
       [  ]
      3] extension
   }{
      %% On unix.
      [(ostype)] extension 1 get (mac) eq {
        /webrpc.browser (open) def
      } { /webrpc.browser (firefox) def } ifelse
      [(sleep 3 ; ) webrpc.browser ( http://) 
                 [(sm1.socket) (gethostname) []] extension 
                (:) httpd.port toString ( & ) ] cat
      system
   } ifelse

   httpd ;
  ] pop
  popVariables
} def


/httpd_action_rpc_only {
  [/in-httpd /ff /httpd.com /httpd.result /sss
   /sss.engine /sss.web /err
   /oxserver.vname /scheck
  ] pushVariables
  [
  {
       [(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 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


/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
   /err /fn
  ] pushVariables
  [
    /msg arg1 def
    /result 1 def
    msg (httpdAsirMeta quit) eq {
       oxasir.ccc oxshutdown
       send-page-bye
       quit
       /result 0 def
    } { } ifelse
    msg (httpdAsirMeta interrupt) eq {
       oxasir.ccc oxreset
       (Interrupted! <br>) send-page-3
       /result 0 def
    } { } ifelse
    /arg1 result def
  ] pop
  popVariables
  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
  [
   (HTTP/0.9 200 OK) sendln
   (Connection: close) sendln
   (Content-Type: text/html) sendln
   0 sendln

  httpd.title sendln
  [(getenv) (OXWEB_POST)] extension tag 0 eq {
    (<FORM NAME="myFORM">) sendln  % use get
  }{
    (<FORM NAME="myFORM" METHOD="POST">) sendln
  } ifelse
   (<INPUT TYPE=submit VALUE="submit">) sendln
   [(<textarea name=) httpd.textarea.name 
    ( rows=7 cols="80" wrap="soft"></textarea>)] cat sendln
   (</FORM>) sendln

   httpd.msg1 sendln

   [$<a href="http://$ [(sm1.socket) (gethostname) []] extension 
    $:$ httpd.port toString
    $/?msg=httpdAsirMeta+quit"> Shutdown the oxserver (and restart it). </a>$
   ] cat sendln
   (<h3 align="right"><font color="gree">Powered by OpenXM and httpd on Kan/sm1 </font> </h3>_) sendln
   0 sendln
   [(flush)] extension
  ] pop
  popVariables
} def



/send-page-result {
  /arg1 set
  [/in-send-page-result /result /hlen /msg1 /msg2] pushVariables
  [
   /result arg1 def
   /msg1 (<html> <body> <pre>)  def
   /msg2  (</pre> </body> </html>) def
   httpd.textmode { 0 /hlen set }
   { msg1 length msg2 length add 3 add /hlen set } ifelse
   (HTTP/0.9 200 OK) sendln
   (Connection: close) sendln
   [(Content-length: ) result length hlen add toString ] cat sendln
   httpd.textmode
   { (Content-Type: text/plain) sendln }  % It does not work on some browsers.
   { (Content-Type: text/html) sendln } ifelse
   0 sendln

   httpd.textmode { } { msg1 sendln } ifelse
   result sendln
   httpd.textmode { } { msg2 sendln } ifelse
   0 sendln
   [(flush)] extension
  ] pop
  popVariables
} def

/send-page-refused {  
  /arg1 set
  [/in-send-page-refused /reason] pushVariables
  [
   /reason arg1 def
   (HTTP/0.9 200 OK) sendln
   (Connection: close) sendln
   (Content-Type: text/html) sendln
   0 sendln

  (<H2> Your request is refused. </H2> <br> ) sendln
  (Because your input contains the key word <font color="red">) sendln
  reason 0 get sendln
  ( </font> ) sendln
  (<br> <br>) sendln
  (Your input is <br> ) sendln
  (<pre> ) sendln
  reason 1 get sendln
  (</pre> ) sendln

   0 sendln
   [(flush)] extension
  ] pop
  popVariables
} def

%% **** Overwrites the definition in httpd.sm1
/httpd_startserver {
   (httpd server accessible outside localhost.) message
   %%  get the hostname of this machine.
   [(sm1.socket) (open) [httpd.port 
                         [(sm1.socket) (gethostname) [ ] ]extension ] ]
    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 <httpd.server.fd> ) messagen 
   httpd.server.fd message

} def

%% ******* sample of cooked command
/cookedCommand.simplest {
  /arg1 set
  [/in-cookedCommand /httpd.com] pushVariables
  [
    /httpd.com arg1 def
    [(if (1) {)  httpd.com  (; };)] cat
    /arg1 set
  ] pop
  popVariables
  arg1
} def
/cookedCommand {
  /arg1 set
  [/in-cookedCommand /httpd.com /fff] pushVariables
  [
    /httpd.com arg1 def
    httpd.oxasir.timer not {
      [(if (1) {)  httpd.com  (; };)] cat
      /fff set
    }{
%%  It does not work.
%%      [$timer(30,eval_str("$ 
%%          (if (1) {)  httpd.com  (; };)
%%       $"),"Computation is aborted with the resource limit ( 30 seconds)");$
%%      ] cat
     [$timer(30,$   httpd.com
        $,"Computation is aborted with the resource limit ( 30 seconds) or there was a syntax error.");$
     ] cat
      /fff set
    } ifelse
    (cooked command is ) messagen fff message
    /arg1 fff def
  ] pop
  popVariables
  arg1
} def
/httpd.refusedCommands 
   [(shell) (eval_str) (ox_) (sm1_)  
    (m_start) (m_N_) (m_Inverse) (m_TexForm) %(m_) 
    (connect) (load)  (bload) (bsave) 
    (end) (quit) (output) (bload27) (open)
    (plot) (ctrl) (debug) (error) (port) (bind) (accept)
    (draw)  (peek) (poke)
    (write_string_to_a_file) (_filter)
   ]
def