%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v 1.5 2001/04/21 13:54:29 takayama Exp $
%% http server by sm1

/httpd.port 1200 def
/httpd.initialization
%% Put initialization codes here.
 [
  ("Asirweb version 0.80. "+
   " Risa/Asir oxasir version "+rtostr(version());)
 ] cat
def
[(parse) (oxasir.sm1) pushfile] extension 
(oxasir.started) boundp { 
} {
  [(x^2-1) (x)] fctr pop
  oxasir.ccc oxmathcap
  oxasir.ccc oxsetmathcap
} ifelse

/asirweb {
  (sleep 3; netscape -geometry 800x500 http://localhost:1200 &) system
   httpd ;
} 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) (write) [httpd.server.fd 0 get mmm]] extension message
 ] pop
 popVariables
} def

/httpd {
  /httpd.serial 0 def
  /httpd.history [ ] 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
  ] 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
        }
        {
          (------------  start ----------------------) message
             ff message
          (-----------------------------------------) message
             ff removeGET webstringToAscii /httpd.com set 
             httpd.com message
          (------------  end ----------------------) message
          (   ) message
          httpd.serial 0 eq {
            /httpd.com  httpd.initialization def 
          } { } ifelse
          httpd.com metaCommand {
            /httpd.history 
                httpd.history 
                [10 (string) dc 
                 (/**** ) httpd.serial toString ( ****/) 
                 10 (string) dc
                  httpd.com 
                 ] cat
                append 
            def
            oxasir.ccc 
             [(if (1) {)  httpd.com  (};)] cat
            oxexecutestring ;

            [(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  /httpd.result set
                %% oxasir.ccc oxpopstring /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
            [httpd.serial 0 eq { } {
                (<title> asirweb </title> )
                (<font color="blue"> Input-) httpd.serial toString
                 (: </font> )  
                (<pre> ) httpd.com (</pre>) (<br>)
              } ifelse
             (<font color="green"> Output-) httpd.serial toString
             (: </font> ) 
             (<pre>) httpd.result (</pre>) 
            ] cat
            send-page-3  exit
          } { exit } ifelse  %% metaCommand
        } ifelse
  } loop
  ] pop
  popVariables
} 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
   (<html>) sendln
   (Shutdown the engine. <br>) sendln
   (See you! <a href="http://www.openxm.org"> asirweb </a>) sendln
   (</html>) 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
   (<FORM NAME="myFORM">) sendln
   (<INPUT TYPE="TEXT" NAME="Num">) sendln
   (</FORM>) 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
%%   (<FORM NAME="myFORM" METHOD="POST">) sendln
   result sendln
   (<FORM NAME="myFORM">) sendln
   (<INPUT TYPE=submit VALUE="submit">) sendln
   (<textarea name=msg rows=10 cols="80" wrap="soft"></textarea>) sendln
   (</FORM>) sendln
   send-menu-1
   0 sendln
   [(flush)] extension
  ] 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
/httpd.asirman.index
  ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_262.html#SEC262")
def
/httpd.asir.intro
   ("http://www.math.sci.kobe-u.ac.jp/~taka/asir-book-html/main")
def
/send-menu-1 {
  
  (FILE:) sendln
  [$<a href="http://localhost:$ httpd.port toString
   $/?msg=httpdAsirMeta+quit"> Shutdown the asir server. </a>, $
  ] cat sendln
%%  [$<a href="http://localhost:$ httpd.port toString
%%   $/?msg=httpdAsirMeta+interrupt"> interrupt </a>, $
%%  ] cat sendln
  [$<a href="http://localhost:$ httpd.port toString
   $/?msg=httpdAsirMeta+save"> save. </a>, $
  ] cat sendln
  ( <spacer type=horizontal size=80> ) sendln

  (HELP:) sendln
  [(<font color="red"> 
    <a href=) httpd.asirman ( > AsirManual (Ja) </a> </font>, )] cat sendln
  [(<font color="purple"> 
    <a href=) httpd.asirman.index ( > Index (Ja) </a> </font>, )] cat sendln
  [(<font color="blue"> 
    <a href=) httpd.asir.intro ( > Intro (Ja) </a> </font>, )] cat sendln
} def

/send-page-save {
 [/in-send-page-save /i] pushVariables
 [
   (HTTP/0.9 200 OK) sendln
   (Connection: close) sendln
   (Content-Type: text/html) sendln
   0 sendln
   (<html> <body>) sendln
   (/* Save the following to  sm1out.txt */<br>) sendln
   
   (<pre>) sendln
   0 1 httpd.history length 1 sub {
     /i set
     httpd.history i get sendln
   } for
   (</pre>) sendln
   (</body> </html>) sendln
   0 sendln
   [(flush)] extension
   [(PrintDollar) 1] system_variable
   httpd.history output
   [(PrintDollar) 0] system_variable
 ] pop
 popVariables
} def


/stopclient {
  [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
} 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

/removeGET {
  /arg1 set
  [/in-removeGET /s /s2 /i /j] pushVariables
  [
     /s arg1 def
     s 1 copy /s2 set
     s (array) dc /s set
     /j 0 def
     10 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

/metaCommand {
  /arg1 set
  [/in-metaCommand /msg /result] pushVariables
  [
    /msg arg1 def
    /result 1 def
    msg (httpdAsirMeta quit) eq {
       send-page-bye
       quit
       /result 0 def
    } { } ifelse
    msg (httpdAsirMeta save) eq {
       send-page-save
       /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