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

Annotation of OpenXM/src/kan96xx/Doc/httpd-asir.sm1, Revision 1.6

1.6     ! takayama    1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-asir.sm1,v 1.5 2001/04/21 13:54:29 takayama Exp $
1.1       takayama    2: %% http server by sm1
1.2       takayama    3:
                      4: /httpd.port 1200 def
1.4       takayama    5: /httpd.initialization
                      6: %% Put initialization codes here.
                      7:  [
1.5       takayama    8:   ("Asirweb version 0.80. "+
1.4       takayama    9:    " Risa/Asir oxasir version "+rtostr(version());)
                     10:  ] cat
                     11: def
1.1       takayama   12: [(parse) (oxasir.sm1) pushfile] extension
                     13: (oxasir.started) boundp {
                     14: } {
1.6     ! takayama   15:   %% Initialize oxasir.
1.1       takayama   16:   [(x^2-1) (x)] fctr pop
1.5       takayama   17:   oxasir.ccc oxmathcap
                     18:   oxasir.ccc oxsetmathcap
1.1       takayama   19: } ifelse
                     20:
1.5       takayama   21: /asirweb {
1.6     ! takayama   22:   [(sleep 3; netscape -geometry 800x500 http://localhost:)
        !            23:     httpd.port toString
        !            24:    ( &)] cat system
1.5       takayama   25:    httpd ;
                     26: } def
                     27:
1.2       takayama   28: /httpd_startserver {
                     29:    [(sm1.socket) (open) [httpd.port (localhost)]] extension
1.5       takayama   30:    /httpd.server.fdAndPort set
                     31:    (sm1.socket.open returns  ) messagen httpd.server.fdAndPort message
                     32:    [(sm1.socket) (accept) [httpd.server.fdAndPort 0 get]] extension
                     33:    /httpd.server.fd set
1.1       takayama   34:    (connected.) message
1.5       takayama   35:    (sm1.socket.accept returns  ) messagen httpd.server.fd message
1.1       takayama   36: } def
                     37:
1.2       takayama   38: /httpd_stopserver {
1.5       takayama   39:    [(sm1.socket) (close) httpd.server.fd ] extension message
1.1       takayama   40: } def
                     41:
1.3       takayama   42: /send_packet {
1.1       takayama   43:   /arg1 set
1.5       takayama   44:   [(sm1.socket) (write) [httpd.server.fd 0 get arg1]] extension message
1.1       takayama   45: } def
                     46:
                     47: /sendln {
1.2       takayama   48:  /arg1 set
                     49:  [/in-sendln /mmm] pushVariables
                     50:  [ arg1 /mmm set
1.1       takayama   51:   mmm tag 5 eq {
                     52:     [mmm 10 (string) dc] cat /mmm set
                     53:   }{
                     54:     10 (string) dc /mmm set
                     55:   } ifelse
1.5       takayama   56:   [(sm1.socket) (write) [httpd.server.fd 0 get mmm]] extension message
1.2       takayama   57:  ] pop
                     58:  popVariables
1.1       takayama   59: } def
                     60:
                     61: /httpd {
1.4       takayama   62:   /httpd.serial 0 def
1.3       takayama   63:   /httpd.history [ ] def
1.1       takayama   64:   {
1.2       takayama   65:     httpd_startserver ;
                     66:     httpd_action ;
                     67:     httpd_stopserver ;
1.1       takayama   68:     (5 sleep) system
1.3       takayama   69:     httpd.serial 1 add /httpd.serial set
1.1       takayama   70:   } loop
                     71: } def
                     72:
1.2       takayama   73: /httpd_action {
1.5       takayama   74:   [/in-httpd /ff /httpd.com /httpd.result /sss
1.6     ! takayama   75:    /sss.engine /sss.web /err
1.3       takayama   76:   ] pushVariables
1.2       takayama   77:   [
1.1       takayama   78:   {
1.5       takayama   79:        [(sm1.socket) (select) [httpd.server.fd 0 get -1]] extension
                     80:        %%     wait for ever
                     81:         [(sm1.socket) (read) [httpd.server.fd 0 get ]] extension /ff set
1.1       takayama   82:         ff length 0 eq {
                     83:            (connection is closed.) message
                     84:         }
1.4       takayama   85:         {
1.1       takayama   86:           (------------  start ----------------------) message
                     87:              ff message
                     88:           (-----------------------------------------) message
                     89:              ff removeGET webstringToAscii /httpd.com set
                     90:              httpd.com message
                     91:           (------------  end ----------------------) message
                     92:           (   ) message
1.4       takayama   93:           httpd.serial 0 eq {
                     94:             /httpd.com  httpd.initialization def
                     95:           } { } ifelse
1.3       takayama   96:           httpd.com metaCommand {
                     97:             oxasir.ccc
                     98:              [(if (1) {)  httpd.com  (};)] cat
                     99:             oxexecutestring ;
1.6     ! takayama  100:             [(oxReq) oxasir.ccc SM_dupErrors ] extension pop
1.5       takayama  101:
1.6     ! takayama  102:             [(oxReq) oxasir.ccc SM_popCMO ] extension pop
1.5       takayama  103:             [(oxReq) oxasir.ccc SM_popString ] extension pop
                    104:             [(flush)] extension pop
                    105:             %% Select inputs for interruption.
                    106:             %% Wait by the spin lock.
                    107:             {
                    108:               [(oxMultiSelect) [oxasir.ccc] 1] extension 1 get 0 get
                    109:               /sss.engine set
                    110:               [(sm1.socket) (mselect)
                    111:                 [[httpd.server.fd 0 get] 1]
                    112:               ] extension 0 get /sss.web set
                    113:               /sss [sss.engine sss.web] def
                    114:               sss.engine { exit } { } ifelse
                    115:               sss.web    { exit } { } ifelse
                    116:             } loop
                    117:             sss message
                    118:
                    119:             sss 0 get {
1.6     ! takayama  120:                 [(oxGet) oxasir.ccc] extension  /err          set
1.5       takayama  121:                 [(oxGet) oxasir.ccc] extension  /httpd.result set
                    122:                 %% oxasir.ccc oxpopstring /httpd.result set
                    123:             } {
                    124:                 oxasir.ccc oxreset
                    125:                 oxasir.ccc ("computation is interrupted.";) oxexecutestring ;
                    126:                 oxasir.ccc oxpopstring
                    127:                 /httpd.result set
                    128:                 exit
                    129:             } ifelse
1.3       takayama  130:             (------------- result -------------) message
                    131:             httpd.result message
                    132:             (----------------------------------) message
                    133:             (  ) message
1.6     ! takayama  134:
        !           135:             err message
        !           136:             err [ ] eq  {
        !           137:               /httpd.history
        !           138:                 httpd.history
        !           139:                 [10 (string) dc
        !           140:                  (/**** ) httpd.serial toString ( ****/)
        !           141:                  10 (string) dc
        !           142:                   httpd.com
        !           143:                  ] cat
        !           144:                 append
        !           145:               def
        !           146:             } {
        !           147:               oxasir.ccc cleanErrors
        !           148:               [httpd.result 10 (string) dc err toString] cat
        !           149:               /httpd.result set
        !           150:             } ifelse
        !           151:
1.4       takayama  152:             [httpd.serial 0 eq { } {
                    153:                 (<title> asirweb </title> )
                    154:                 (<font color="blue"> Input-) httpd.serial toString
                    155:                  (: </font> )
                    156:                 (<pre> ) httpd.com (</pre>) (<br>)
                    157:               } ifelse
1.3       takayama  158:              (<font color="green"> Output-) httpd.serial toString
                    159:              (: </font> )
                    160:              (<pre>) httpd.result (</pre>)
                    161:             ] cat
                    162:             send-page-3  exit
1.5       takayama  163:           } { exit } ifelse  %% metaCommand
1.1       takayama  164:         } ifelse
                    165:   } loop
1.2       takayama  166:   ] pop
                    167:   popVariables
1.1       takayama  168: } def
                    169:
                    170:
1.3       takayama  171: /send-page-bye {
1.1       takayama  172:    (HTTP/0.9 200 OK) sendln
                    173: %%   (Date: Sun, 18 Mar 2001 02:54:50 GMT) sendln
                    174: %%   (Server: sm1/0.1 (Unix)) sendln
                    175: %%   (Last-Modified: Wed, 23 Aug 2000 11:19:27 GMT) sendln
                    176: %%   (ETag: "1f8f-5df-39a3b33f") sendln
                    177: %%   (Accept-Ranges: bytes) sendln
                    178: %%   (Content-Length: 10) sendln
                    179:    (Connection: close) sendln
1.3       takayama  180: %   (Content-Type: text/plain) sendln
                    181:    (Content-Type: text/html) sendln
1.1       takayama  182:    0 sendln
1.3       takayama  183:    (<html>) sendln
                    184:    (Shutdown the engine. <br>) sendln
                    185:    (See you! <a href="http://www.openxm.org"> asirweb </a>) sendln
                    186:    (</html>) sendln
1.1       takayama  187:    0 sendln
                    188:    [(flush)] extension
                    189: } def
                    190:
                    191: /send-page-2 {
                    192:    (HTTP/0.9 200 OK) sendln
                    193: %%   (Content-Length: 10) sendln
                    194:    (Connection: close) sendln
                    195:    (Content-Type: text/html) sendln
                    196:    0 sendln
                    197:    (<FORM NAME="myFORM">) sendln
                    198:    (<INPUT TYPE="TEXT" NAME="Num">) sendln
                    199:    (</FORM>) sendln
                    200:    0 sendln
                    201:    [(flush)] extension
                    202: } def
                    203:
                    204: /send-page-3 {
                    205:   /arg1 set
                    206:   [/in-send-page-3 /result] pushVariables
                    207:   [
                    208:    /result arg1 def
                    209:    (HTTP/0.9 200 OK) sendln
                    210:    (Connection: close) sendln
                    211:    (Content-Type: text/html) sendln
                    212:    0 sendln
                    213: %%   (<FORM NAME="myFORM" METHOD="POST">) sendln
                    214:    result sendln
                    215:    (<FORM NAME="myFORM">) sendln
                    216:    (<INPUT TYPE=submit VALUE="submit">) sendln
1.2       takayama  217:    (<textarea name=msg rows=10 cols="80" wrap="soft"></textarea>) sendln
1.1       takayama  218:    (</FORM>) sendln
1.3       takayama  219:    send-menu-1
1.1       takayama  220:    0 sendln
                    221:    [(flush)] extension
                    222:   ] pop
                    223:   popVariables
                    224: } def
                    225:
1.3       takayama  226: /httpd.asirman
                    227:  ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_toc.html")
                    228: def
                    229: /httpd.asirman.index
                    230:   ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_262.html#SEC262")
                    231: def
1.4       takayama  232: /httpd.asir.intro
                    233:    ("http://www.math.sci.kobe-u.ac.jp/~taka/asir-book-html/main")
                    234: def
1.3       takayama  235: /send-menu-1 {
                    236:
1.4       takayama  237:   (FILE:) sendln
1.3       takayama  238:   [$<a href="http://localhost:$ httpd.port toString
1.4       takayama  239:    $/?msg=httpdAsirMeta+quit"> Shutdown the asir server. </a>, $
1.3       takayama  240:   ] cat sendln
1.5       takayama  241: %%  [$<a href="http://localhost:$ httpd.port toString
                    242: %%   $/?msg=httpdAsirMeta+interrupt"> interrupt </a>, $
                    243: %%  ] cat sendln
                    244:   [$<a href="http://localhost:$ httpd.port toString
                    245:    $/?msg=httpdAsirMeta+save"> save. </a>, $
                    246:   ] cat sendln
1.4       takayama  247:   ( <spacer type=horizontal size=80> ) sendln
1.3       takayama  248:
1.4       takayama  249:   (HELP:) sendln
1.3       takayama  250:   [(<font color="red">
1.4       takayama  251:     <a href=) httpd.asirman ( > AsirManual (Ja) </a> </font>, )] cat sendln
1.3       takayama  252:   [(<font color="purple">
1.4       takayama  253:     <a href=) httpd.asirman.index ( > Index (Ja) </a> </font>, )] cat sendln
                    254:   [(<font color="blue">
                    255:     <a href=) httpd.asir.intro ( > Intro (Ja) </a> </font>, )] cat sendln
1.3       takayama  256: } def
1.1       takayama  257:
1.5       takayama  258: /send-page-save {
                    259:  [/in-send-page-save /i] pushVariables
                    260:  [
                    261:    (HTTP/0.9 200 OK) sendln
                    262:    (Connection: close) sendln
                    263:    (Content-Type: text/html) sendln
                    264:    0 sendln
                    265:    (<html> <body>) sendln
1.6     ! takayama  266:    (/* Saved the following to sm1out.txt */<br>) sendln
        !           267:    (/* Save the following by your browser as a text file. */<br>) sendln
1.5       takayama  268:
                    269:    (<pre>) sendln
                    270:    0 1 httpd.history length 1 sub {
                    271:      /i set
                    272:      httpd.history i get sendln
                    273:    } for
                    274:    (</pre>) sendln
                    275:    (</body> </html>) sendln
                    276:    0 sendln
                    277:    [(flush)] extension
                    278:    [(PrintDollar) 1] system_variable
                    279:    httpd.history output
                    280:    [(PrintDollar) 0] system_variable
                    281:  ] pop
                    282:  popVariables
                    283: } def
                    284:
                    285:
1.1       takayama  286: /stopclient {
                    287:   [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
1.6     ! takayama  288: } def
        !           289:
        !           290:
        !           291: /cleanErrors {
        !           292:   /arg1 set
        !           293:   [/in-cleanErrors /clientt /spp] pushVariables
        !           294:   [
        !           295:     /clientt arg1 def
        !           296:     clientt oxgetsp (integer) dc /spp set
        !           297:     clientt spp oxpops
        !           298:   ] pop
        !           299:   popVariables
1.1       takayama  300: } def
                    301:
                    302:
                    303: /fromHex {
                    304:   /arg1 set
                    305:   [/in-fromHex /s1 /s2 /c /c2] pushVariables
                    306:   [
                    307:     arg1 0 get /s1 set
                    308:     arg1 1 get /s2 set
                    309:
                    310:     48 s1 le  s1 57 le and {  % 0, ..., 9
                    311:       s1 48 sub /c set
                    312:     }{ } ifelse
                    313:     65 s1 le  s1 70 le and {  % A, ..., F
                    314:       s1 65 sub 10 add /c set
                    315:     }{ } ifelse
                    316:     97 s1 le  s1 102 le and {  % a, ..., f
                    317:       s1 97 sub 10 add /c set
                    318:     }{ } ifelse
                    319:     c 16 mul /c set
                    320:
                    321:     48 s2 le  s2 57 le and {  % 0, ..., 9
                    322:       s2 48 sub /c2 set
                    323:     }{ } ifelse
                    324:     65 s2 le  s2 70 le and {  % A, ..., F
                    325:       s2 65 sub 10 add /c2 set
                    326:     }{ } ifelse
                    327:     97 s2 le  s2 102 le and {  % a, ..., f
                    328:       s2 97 sub 10 add /c2 set
                    329:     }{ } ifelse
                    330:     c c2 add /arg1 set
                    331:   ] pop
                    332:   popVariables
                    333:   arg1
                    334: } def
                    335:
                    336: /removeGET {
                    337:   /arg1 set
                    338:   [/in-removeGET /s /s2 /i /j] pushVariables
                    339:   [
                    340:      /s arg1 def
                    341:      s 1 copy /s2 set
                    342:      s (array) dc /s set
                    343:      /j 0 def
                    344:      10 1 s length 1 sub {
                    345:        /i set
                    346:        s2 j << s i get (string) dc >> put
                    347:        j 1 add /j set
                    348:      } for
                    349:      /arg1 s2 def
                    350:   ] pop
                    351:   arg1
                    352: } def
                    353:
                    354: /webstringToAscii {
                    355:   /arg1 set
                    356:   [/in-webstringToAscii /s /i /j /c /n] pushVariables
                    357:   [
                    358:      /s arg1 def
                    359:      s (array) dc /s set
                    360:      /j 0 def /n s length def
                    361:      /i 0 def
                    362:      {
                    363:        s i get /c set
                    364:        c 32 eq { exit } { } ifelse
                    365:        c 37 eq {  % c == %
                    366:          [s i 1 add get s i 2 add get] fromHex /c set
                    367:          s j c put
                    368:          j 1 add /j set
                    369:          i 3 add /i set
                    370:        } {
                    371:          c 43 eq { % c == +
                    372:            s j 32 put
                    373:            j 1 add /j set
                    374:            i 1 add /i set
                    375:           } {
                    376:             c 13 eq { % c == 0xd
                    377:               i 1 add /i set
                    378:             } {
                    379:               s j c put
                    380:               j 1 add /j set
                    381:               i 1 add /i set
                    382:             } ifelse
                    383:          } ifelse
                    384:        } ifelse
                    385:        i n ge { exit } {  } ifelse
                    386:      } loop
                    387:      s j carN /s set
                    388:      s { (string) dc } map cat /arg1 set
                    389:   ] pop
                    390:   popVariables
                    391:   arg1
1.3       takayama  392: } def
                    393:
                    394: /metaCommand {
                    395:   /arg1 set
                    396:   [/in-metaCommand /msg /result] pushVariables
                    397:   [
                    398:     /msg arg1 def
                    399:     /result 1 def
                    400:     msg (httpdAsirMeta quit) eq {
                    401:        send-page-bye
                    402:        quit
1.5       takayama  403:        /result 0 def
                    404:     } { } ifelse
                    405:     msg (httpdAsirMeta save) eq {
                    406:        send-page-save
                    407:        /result 0 def
                    408:     } { } ifelse
                    409:     msg (httpdAsirMeta interrupt) eq {
                    410:        oxasir.ccc oxreset
                    411:        (Interrupted! <br>) send-page-3
1.3       takayama  412:        /result 0 def
                    413:     } { } ifelse
                    414:     /arg1 result def
                    415:   ] pop
                    416:   popVariables
                    417:   arg1
                    418: } def

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>