[BACK]Return to httpd-asir.sm1 CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Doc

Diff for /OpenXM/src/kan96xx/Doc/httpd-asir.sm1 between version 1.5 and 1.11

version 1.5, 2001/04/21 13:54:29 version 1.11, 2001/08/12 07:20:37
Line 1 
Line 1 
 %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v 1.4 2001/04/21 11:16:30 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  %% http server by sm1
   
 /httpd.port 1200 def  /httpd.port 1200 def
   /httpd.image.name (kobeuniv2.jpg) def
   /httpd.image.type (jpeg) def
   
 /httpd.initialization  /httpd.initialization
 %% Put initialization codes here.  %% Put initialization codes here.
  [   [
Line 9 
Line 12 
    " Risa/Asir oxasir version "+rtostr(version());)     " Risa/Asir oxasir version "+rtostr(version());)
  ] cat   ] cat
 def  def
   
 [(parse) (oxasir.sm1) pushfile] extension  [(parse) (oxasir.sm1) pushfile] extension
 (oxasir.started) boundp {  (oxasir.started) boundp {
 } {  } {
     %% Initialize oxasir.
   [(x^2-1) (x)] fctr pop    [(x^2-1) (x)] fctr pop
   oxasir.ccc oxmathcap    oxasir.ccc oxmathcap
   oxasir.ccc oxsetmathcap    oxasir.ccc oxsetmathcap
 } ifelse  } ifelse
   
 /asirweb {  /asirweb {
   (sleep 3; netscape -geometry 800x500 http://localhost:1200 &) system   [/rrr ] pushVariables
    [
     %% This procedure to generate port number might fail.
     [(oxGenPass)] extension . (integer) dc  /rrr set
     rrr << rrr 20000 idiv 20000 mul >> sub /rrr set
     /httpd.port 1200 rrr add def
     httpd.port message
   
     [(sleep 3; netscape -geometry 800x500 http://localhost:)
       httpd.port toString
      ( &)] cat system
    httpd ;     httpd ;
     ] pop
     popVariables
 } def  } def
   
 /httpd_startserver {  /httpd_startserver {
Line 50  def
Line 67  def
   }{    }{
     10 (string) dc /mmm set      10 (string) dc /mmm set
   } ifelse    } 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   ] pop
  popVariables   popVariables
 } def  } 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 {
   /httpd.serial 0 def    /httpd.serial 0 def
   /httpd.history [ ] def    /httpd.history [ ] def
     /httpd.result.history [ 0 ] def
   {    {
     httpd_startserver ;      httpd_startserver ;
     httpd_action ;      httpd_action ;
Line 69  def
Line 114  def
   
 /httpd_action {  /httpd_action {
   [/in-httpd /ff /httpd.com /httpd.result /sss    [/in-httpd /ff /httpd.com /httpd.result /sss
    /sss.engine /sss.web     /sss.engine /sss.web /err
   ] pushVariables    ] pushVariables
   [    [
   {    {
Line 83  def
Line 128  def
           (------------  start ----------------------) message            (------------  start ----------------------) message
              ff message               ff message
           (-----------------------------------------) message            (-----------------------------------------) message
              ff removeGET webstringToAscii /httpd.com set               ff 1 copy askToSendFile /httpd.sendFile set
              httpd.com message               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            (------------  end ----------------------) message
           (   ) message            (   ) message
           httpd.serial 0 eq {            httpd.serial 0 eq {
             /httpd.com  httpd.initialization def              /httpd.com  httpd.initialization def
           } { } ifelse            } { } ifelse
             httpd.sendFile tag 0 eq { }
             {
               httpd.sendFile httpd.image.type send-image
               exit  %% exit the loop LOOP-A
             } ifelse
           httpd.com metaCommand {            httpd.com metaCommand {
             /httpd.history              httpd.textarea.valid {
                 httpd.history                oxasir.ccc
                 [10 (string) dc                 [(if (1) {)  httpd.com  (; };)] cat
                  (/**** ) httpd.serial toString ( ****/)                oxexecutestring ;
                  10 (string) dc              }{
                   httpd.com                send-page-warning  exit
                  ] cat              } ifelse
                 append              [(oxReq) oxasir.ccc SM_dupErrors ] extension pop
             def  
             oxasir.ccc  
              [(if (1) {)  httpd.com  (};)] cat  
             oxexecutestring ;  
   
               [(oxReq) oxasir.ccc SM_popCMO ] extension pop
             [(oxReq) oxasir.ccc SM_popString ] extension pop              [(oxReq) oxasir.ccc SM_popString ] extension pop
             [(flush)] extension pop              [(flush)] extension pop
             %% Select inputs for interruption.              %% Select inputs for interruption.
Line 121  def
Line 174  def
             sss message              sss message
   
             sss 0 get {              sss 0 get {
                   [(oxGet) oxasir.ccc] extension  /err          set
                 [(oxGet) oxasir.ccc] extension  /httpd.result set                  [(oxGet) oxasir.ccc] extension  /httpd.result set
                 %% oxasir.ccc oxpopstring /httpd.result set                  %% oxasir.ccc oxpopstring /httpd.result set
             } {              } {
Line 134  def
Line 188  def
             httpd.result message              httpd.result message
             (----------------------------------) message              (----------------------------------) message
             (  ) message              (  ) message
   
               err message
               err [ ] eq  {
                 /httpd.history
                   httpd.history
                   [10 (string) dc
                    (/**** ) httpd.serial toString ( ****/)
                    10 (string) dc
                     httpd.com
                    (;)  %% add extra ;
                    ] cat
                   append
                 def
               } {
                 oxasir.ccc cleanErrors
                 [httpd.result 10 (string) dc err toString] cat
                 /httpd.result set
               } ifelse
   
             [httpd.serial 0 eq { } {              [httpd.serial 0 eq { } {
                 (<title> asirweb </title> )                  (<title> asirweb </title> )
                 (<font color="blue"> Input-) httpd.serial toString                  (<font color="blue"> Input-) httpd.serial toString
                  (: </font> )                   (: </font> )
                 (<pre> ) httpd.com (</pre>) (<br>)                   httpd.com preformatHTML (<br>)
               } ifelse                } ifelse
              (<font color="green"> Output-) httpd.serial toString               (<font color="green"> Output-) httpd.serial toString
              (: </font> )               (: </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              ] cat
             send-page-3  exit              send-page-3  exit  %% exit the loop LOOP-A
           } { exit } ifelse  %% metaCommand            } { exit } ifelse  %% metaCommand
         } ifelse          } ifelse
   } loop    } loop  %% LOOP-A
   ] pop    ] pop
   popVariables    popVariables
 } def  } def
Line 199  def
Line 277  def
    result sendln     result sendln
    (<FORM NAME="myFORM">) sendln     (<FORM NAME="myFORM">) sendln
    (<INPUT TYPE=submit VALUE="submit">) 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     (</FORM>) sendln
    send-menu-1     send-menu-1
    0 sendln     0 sendln
Line 208  def
Line 287  def
   popVariables    popVariables
 } def  } 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  /httpd.asirman
  ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_toc.html")   ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_toc.html")
 def  def
Line 245  def
Line 353  def
  [   [
    (HTTP/0.9 200 OK) sendln     (HTTP/0.9 200 OK) sendln
    (Connection: close) sendln     (Connection: close) sendln
    (Content-Type: text/html) sendln     (Content-Type: text/plain) sendln
    0 sendln     0 sendln
    (<html> <body>) sendln     (/* Saved the following to sm1out.txt */) sendln
    (/* Save the following to  sm1out.txt */<br>) sendln     (/* Save the following by your browser as a text file. */) sendln
   
    (<pre>) sendln  
    0 1 httpd.history length 1 sub {     0 1 httpd.history length 1 sub {
      /i set       /i set
      httpd.history i get sendln       httpd.history i get sendln
    } for     } for
    (</pre>) sendln     ( end$) sendln
    (</body> </html>) sendln  
    0 sendln     0 sendln
    [(flush)] extension     [(flush)] extension
    [(PrintDollar) 1] system_variable     [(PrintDollar) 1] system_variable
Line 266  def
Line 372  def
  popVariables   popVariables
 } def  } 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 {  /stopclient {
   [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message    [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
 } def  } 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 {  /fromHex {
   /arg1 set    /arg1 set
   [/in-fromHex /s1 /s2 /c /c2] pushVariables    [/in-fromHex /s1 /s2 /c /c2] pushVariables
Line 305  def
Line 432  def
   arg1    arg1
 } def  } 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 {  /removeGET {
   /arg1 set    /arg1 set
   [/in-removeGET /s /s2 /i /j] pushVariables    [/in-removeGET /s /s2 /i /j /i0
      /tname
     ] pushVariables
   [    [
      /s arg1 def       /s arg1 def
        /httpd.textarea.valid 1 def
      s 1 copy /s2 set       s 1 copy /s2 set
      s (array) dc /s 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       /j 0 def
      10 1 s length 1 sub {       i0 1 s length 1 sub {
        /i set         /i set
        s2 j << s i get (string) dc >> put         s2 j << s i get (string) dc >> put
        j 1 add /j set         j 1 add /j set
Line 363  def
Line 592  def
   arg1    arg1
 } def  } 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 {  /metaCommand {
   /arg1 set    /arg1 set
   [/in-metaCommand /msg /result] pushVariables    [/in-metaCommand /msg /result /msg2 /nn] pushVariables
   [    [
     /msg arg1 def      /msg arg1 def
     /result 1 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 {      msg (httpdAsirMeta quit) eq {
          oxasir.ccc oxshutdown
        send-page-bye         send-page-bye
        quit         quit
        /result 0 def         /result 0 def
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.11
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>