Annotation of OpenXM/src/kan96xx/Doc/httpd-sm1.sm1, Revision 1.1
1.1 ! takayama 1: %% $OpenXM$
! 2: %% http server by sm1
! 3: %% You need to set IE (internet explorer) as follows:
! 4: %% (1) Visit the menu
! 5: %% tool / internet option / connection / LAN configuration
! 6: %% (2) Add localhost to the list of not using the proxy server.
! 7:
! 8:
! 9: /httpd.port 1200 def
! 10:
! 11: /httpd.initialization
! 12: %% Put initialization codes here.
! 13: [
! 14: ([$parse$ $cohom.sm1$ pushfile] extension
! 15: [$Web/sm1 version 0.80. $
! 16: $Kan/sm1 ox_sm1 version $ [$Version$] system_variable] cat)
! 17: ] cat
! 18: def
! 19:
! 20: [(parse) (ox-win.sm1) pushfile] extension
! 21: (ox_sm1.started) boundp {
! 22: } {
! 23: %% Initialize oxasir.
! 24: sm1connectr
! 25: ox.ccc oxmathcap
! 26: ox.ccc oxsetmathcap
! 27: } ifelse
! 28:
! 29: /websm1 {
! 30: [/rrr ] pushVariables
! 31: [
! 32: %% This procedure to generate port number might fail.
! 33: [(oxGenPass)] extension . (integer) dc /rrr set
! 34: rrr << rrr 20000 idiv 20000 mul >> sub /rrr set
! 35: /httpd.port 1200 rrr add def
! 36: httpd.port message
! 37:
! 38: [(sleep 3; start iexplore http://localhost:)
! 39: httpd.port toString
! 40: ( &)] cat system
! 41: httpd ;
! 42: ] pop
! 43: popVariables
! 44: } def
! 45:
! 46: /httpd_startserver {
! 47: [(sm1.socket) (open) [httpd.port (localhost)]] extension
! 48: /httpd.server.fdAndPort set
! 49: (sm1.socket.open returns ) messagen httpd.server.fdAndPort message
! 50: [(sm1.socket) (accept) [httpd.server.fdAndPort 0 get]] extension
! 51: /httpd.server.fd set
! 52: (connected.) message
! 53: (sm1.socket.accept returns ) messagen httpd.server.fd message
! 54: } def
! 55:
! 56: /httpd_stopserver {
! 57: [(sm1.socket) (close) httpd.server.fd ] extension message
! 58: } def
! 59:
! 60: /send_packet {
! 61: /arg1 set
! 62: [(sm1.socket) (write) [httpd.server.fd 0 get arg1]] extension message
! 63: } def
! 64:
! 65: /sendln {
! 66: /arg1 set
! 67: [/in-sendln /mmm] pushVariables
! 68: [ arg1 /mmm set
! 69: mmm tag 5 eq {
! 70: [mmm 10 (string) dc] cat /mmm set
! 71: }{
! 72: 10 (string) dc /mmm set
! 73: } ifelse
! 74: [(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension {
! 75: (Warning: your peer closed the connection. Do not send the data.) message
! 76: } {
! 77: [(sm1.socket) (write) [httpd.server.fd 0 get mmm]] extension message
! 78: } ifelse
! 79: ] pop
! 80: popVariables
! 81: } def
! 82:
! 83: /httpd {
! 84: /httpd.serial 0 def
! 85: /httpd.history [ ] def
! 86: {
! 87: httpd_startserver ;
! 88: httpd_action ;
! 89: httpd_stopserver ;
! 90: (5 sleep) system
! 91: httpd.serial 1 add /httpd.serial set
! 92: } loop
! 93: } def
! 94:
! 95: /httpd_action {
! 96: [/in-httpd /ff /httpd.com /httpd.result /sss
! 97: /sss.engine /sss.web /err
! 98: ] pushVariables
! 99: [
! 100: {
! 101: [(sm1.socket) (select) [httpd.server.fd 0 get -1]] extension
! 102: %% wait for ever
! 103: [(sm1.socket) (read) [httpd.server.fd 0 get ]] extension /ff set
! 104: ff length 0 eq {
! 105: (connection is closed.) message
! 106: }
! 107: {
! 108: (------------ start ----------------------) message
! 109: ff message
! 110: (-----------------------------------------) message
! 111: ff removeGET webstringToAscii /httpd.com set
! 112: httpd.com message
! 113: (------------ end ----------------------) message
! 114: ( ) message
! 115: httpd.serial 0 eq {
! 116: /httpd.com httpd.initialization def
! 117: } { } ifelse
! 118: httpd.com metaCommand {
! 119: httpd.textarea.valid {
! 120: ox.ccc
! 121: [ httpd.com ] cat
! 122: oxexecutestring ;
! 123: }{
! 124: send-page-warning exit
! 125: } ifelse
! 126: [(oxReq) ox.ccc SM_dupErrors ] extension pop
! 127:
! 128: [(oxReq) ox.ccc SM_popCMO ] extension pop
! 129: [(oxReq) ox.ccc SM_popString ] extension pop
! 130: [(flush)] extension pop
! 131: %% Select inputs for interruption.
! 132: %% Wait by the spin lock.
! 133: {
! 134: [(oxMultiSelect) [ox.ccc] 1] extension 1 get 0 get
! 135: /sss.engine set
! 136: [(sm1.socket) (mselect)
! 137: [[httpd.server.fd 0 get] 1]
! 138: ] extension 0 get /sss.web set
! 139: /sss [sss.engine sss.web] def
! 140: sss.engine { exit } { } ifelse
! 141: sss.web { exit } { } ifelse
! 142: } loop
! 143: sss message
! 144:
! 145: sss 0 get {
! 146: [(oxGet) ox.ccc] extension /err set
! 147: [(oxGet) ox.ccc] extension /httpd.result set
! 148: %% ox.ccc oxpopstring /httpd.result set
! 149: } {
! 150: ox.ccc oxreset
! 151: ox.ccc ("computation is interrupted.";) oxexecutestring ;
! 152: ox.ccc oxpopstring
! 153: /httpd.result set
! 154: exit
! 155: } ifelse
! 156: (------------- result -------------) message
! 157: httpd.result message
! 158: (----------------------------------) message
! 159: ( ) message
! 160:
! 161: err message
! 162: err [ ] eq {
! 163: /httpd.history
! 164: httpd.history
! 165: [10 (string) dc
! 166: 37 (string) dc httpd.serial toString
! 167: 10 (string) dc
! 168: httpd.com
! 169: ( ) %% add extra ;
! 170: ] cat
! 171: append
! 172: def
! 173: } {
! 174: ox.ccc cleanErrors
! 175: [httpd.result 10 (string) dc err toString] cat
! 176: /httpd.result set
! 177: } ifelse
! 178:
! 179: [httpd.serial 0 eq { } {
! 180: (<title> Web/sm1 </title> )
! 181: (<font color="blue"> Input-) httpd.serial toString
! 182: (: </font> )
! 183: httpd.com preformatHTML (<br>)
! 184: } ifelse
! 185: (<font color="green"> Output-) httpd.serial toString
! 186: (: </font> )
! 187: httpd.result preformatHTML
! 188: ] cat
! 189: send-page-3 exit
! 190: } { exit } ifelse %% metaCommand
! 191: } ifelse
! 192: } loop
! 193: ] pop
! 194: popVariables
! 195: } def
! 196:
! 197:
! 198: /send-page-bye {
! 199: (HTTP/0.9 200 OK) sendln
! 200: %% (Date: Sun, 18 Mar 2001 02:54:50 GMT) sendln
! 201: %% (Server: sm1/0.1 (Unix)) sendln
! 202: %% (Last-Modified: Wed, 23 Aug 2000 11:19:27 GMT) sendln
! 203: %% (ETag: "1f8f-5df-39a3b33f") sendln
! 204: %% (Accept-Ranges: bytes) sendln
! 205: %% (Content-Length: 10) sendln
! 206: (Connection: close) sendln
! 207: % (Content-Type: text/plain) sendln
! 208: (Content-Type: text/html) sendln
! 209: 0 sendln
! 210: (<html>) sendln
! 211: (Shutdown the engine. <br>) sendln
! 212: (See you! <a href="http://www.openxm.org"> Web/sm1 </a>) sendln
! 213: (</html>) sendln
! 214: 0 sendln
! 215: [(flush)] extension
! 216: } def
! 217:
! 218: /send-page-2 {
! 219: (HTTP/0.9 200 OK) sendln
! 220: %% (Content-Length: 10) sendln
! 221: (Connection: close) sendln
! 222: (Content-Type: text/html) sendln
! 223: 0 sendln
! 224: (<FORM NAME="myFORM">) sendln
! 225: (<INPUT TYPE="TEXT" NAME="Num">) sendln
! 226: (</FORM>) sendln
! 227: 0 sendln
! 228: [(flush)] extension
! 229: } def
! 230:
! 231: /send-page-3 {
! 232: /arg1 set
! 233: [/in-send-page-3 /result] pushVariables
! 234: [
! 235: /result arg1 def
! 236: (HTTP/0.9 200 OK) sendln
! 237: (Connection: close) sendln
! 238: (Content-Type: text/html) sendln
! 239: 0 sendln
! 240: %% (<FORM NAME="myFORM" METHOD="POST">) sendln
! 241: result sendln
! 242: (<FORM NAME="myFORM">) sendln
! 243: (<INPUT TYPE=submit VALUE="submit">) sendln
! 244: [(<textarea name=) httpd.textarea.name
! 245: ( rows=10 cols="80" wrap="soft"></textarea>)] cat sendln
! 246: (</FORM>) sendln
! 247: send-menu-1
! 248: 0 sendln
! 249: [(flush)] extension
! 250: ] pop
! 251: popVariables
! 252: } def
! 253:
! 254: /httpd.sm1man
! 255: ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_toc.html")
! 256: def
! 257: /httpd.sm1man.index
! 258: ("http://www.math.sci.kobe-u.ac.jp/OpenXM/1.1.3/doc/asir2000/html-jp/man_262.html#SEC262")
! 259: def
! 260: /httpd.asir.intro
! 261: ("http://www.math.sci.kobe-u.ac.jp/~taka/asir-book-html/main")
! 262: def
! 263: /send-menu-1 {
! 264:
! 265: (FILE:) sendln
! 266: [$<a href="http://localhost:$ httpd.port toString
! 267: $/?msg=httpdAsirMeta+quit"> Shutdown the sm1 server. </a>, $
! 268: ] cat sendln
! 269: %% [$<a href="http://localhost:$ httpd.port toString
! 270: %% $/?msg=httpdAsirMeta+interrupt"> interrupt </a>, $
! 271: %% ] cat sendln
! 272: [$<a href="http://localhost:$ httpd.port toString
! 273: $/?msg=httpdAsirMeta+save"> save. </a>, $
! 274: ] cat sendln
! 275: ( <spacer type=horizontal size=80> ) sendln
! 276:
! 277: (HELP:) sendln
! 278: [(<font color="red">
! 279: <a href=) httpd.sm1man ( > Sm1manual (Ja) </a> </font>, )] cat sendln
! 280: [(<font color="purple">
! 281: <a href=) httpd.sm1man.index ( > Index (Ja) </a> </font>, )] cat sendln
! 282: [(<font color="blue">
! 283: <a href=) httpd.asir.intro ( > Intro (Ja) </a> </font>, )] cat sendln
! 284: } def
! 285:
! 286: /send-page-save {
! 287: [/in-send-page-save /i] pushVariables
! 288: [
! 289: (HTTP/0.9 200 OK) sendln
! 290: (Connection: close) sendln
! 291: (Content-Type: text/plain) sendln
! 292: 0 sendln
! 293: [37 (string) dc ( Saved the following to sm1out.txt )] cat sendln
! 294: [37 (string) dc ( Save the following by your browser as a text file. )]
! 295: cat sendln
! 296:
! 297: 0 1 httpd.history length 1 sub {
! 298: /i set
! 299: httpd.history i get sendln
! 300: } for
! 301: ( ) sendln
! 302: 0 sendln
! 303: [(flush)] extension
! 304: [(PrintDollar) 1] system_variable
! 305: httpd.history output
! 306: [(PrintDollar) 0] system_variable
! 307: ] pop
! 308: popVariables
! 309: } def
! 310:
! 311: /send-page-warning {
! 312: (HTTP/0.9 200 OK) sendln
! 313: (Connection: close) sendln
! 314: (Content-Type: text/html) sendln
! 315: 0 sendln
! 316: (You cannot execute ox_sm1 without a session key! <br>) sendln
! 317: 0 sendln
! 318: [(flush)] extension
! 319: } def
! 320:
! 321: /stopclient {
! 322: [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
! 323: } def
! 324:
! 325:
! 326: /cleanErrors {
! 327: /arg1 set
! 328: [/in-cleanErrors /clientt /spp] pushVariables
! 329: [
! 330: /clientt arg1 def
! 331: clientt oxgetsp (integer) dc /spp set
! 332: clientt spp oxpops
! 333: ] pop
! 334: popVariables
! 335: } def
! 336:
! 337:
! 338: /fromHex {
! 339: /arg1 set
! 340: [/in-fromHex /s1 /s2 /c /c2] pushVariables
! 341: [
! 342: arg1 0 get /s1 set
! 343: arg1 1 get /s2 set
! 344:
! 345: 48 s1 le s1 57 le and { % 0, ..., 9
! 346: s1 48 sub /c set
! 347: }{ } ifelse
! 348: 65 s1 le s1 70 le and { % A, ..., F
! 349: s1 65 sub 10 add /c set
! 350: }{ } ifelse
! 351: 97 s1 le s1 102 le and { % a, ..., f
! 352: s1 97 sub 10 add /c set
! 353: }{ } ifelse
! 354: c 16 mul /c set
! 355:
! 356: 48 s2 le s2 57 le and { % 0, ..., 9
! 357: s2 48 sub /c2 set
! 358: }{ } ifelse
! 359: 65 s2 le s2 70 le and { % A, ..., F
! 360: s2 65 sub 10 add /c2 set
! 361: }{ } ifelse
! 362: 97 s2 le s2 102 le and { % a, ..., f
! 363: s2 97 sub 10 add /c2 set
! 364: }{ } ifelse
! 365: c c2 add /arg1 set
! 366: ] pop
! 367: popVariables
! 368: arg1
! 369: } def
! 370:
! 371: /randomName {
! 372: [/in-randomName /sss /rrr ] pushVariables
! 373: [
! 374: %% Seed name
! 375: /sss [ 97 97 97 97 97 97 97 97 97 97 ] def %% 97 == 'a'
! 376: %% This procedure to generate port number might fail.
! 377: sss {
! 378: [
! 379: [(oxGenPass)] extension .. /rrr set
! 380: [(tdiv_qr) rrr (26)..] mpzext 1 get /rrr set
! 381: ] pop
! 382: rrr (integer) dc add
! 383: } map
! 384: /sss set
! 385: sss {(string) dc} map cat /arg1 set
! 386: ] pop
! 387: popVariables
! 388: arg1
! 389: } def
! 390:
! 391: (httpd.textarea.name) boundp { }
! 392: {
! 393: /httpd.textarea.name randomName def
! 394: /httpd.textarea.name.aaa
! 395: [(GET /?) httpd.textarea.name] cat
! 396: (array) dc
! 397: def
! 398: } ifelse
! 399:
! 400: %% remove GET /?msg=
! 401: /removeGET {
! 402: /arg1 set
! 403: [/in-removeGET /s /s2 /i /j /i0
! 404: /tname
! 405: ] pushVariables
! 406: [
! 407: /s arg1 def
! 408: /httpd.textarea.valid 1 def
! 409: s 1 copy /s2 set
! 410: s (array) dc /s set
! 411:
! 412: /tname [ ] def
! 413: 0 1 s length 1 sub {
! 414: /i0 set
! 415: s i0 get 61 eq { %% 61 is =
! 416: i0 1 add /i0 set
! 417: tname message
! 418: httpd.textarea.name.aaa message
! 419: tname httpd.textarea.name.aaa eq {
! 420: /httpd.textarea.valid 1 def
! 421: } {
! 422: /httpd.textarea.valid 0 def
! 423: (Warning: got an invalid name for the text field.) message
! 424: } ifelse
! 425: exit
! 426: } { } ifelse
! 427: tname s i0 get append /tname set
! 428: } for
! 429:
! 430: /j 0 def
! 431: i0 1 s length 1 sub {
! 432: /i set
! 433: s2 j << s i get (string) dc >> put
! 434: j 1 add /j set
! 435: } for
! 436: /arg1 s2 def
! 437: ] pop
! 438: arg1
! 439: } def
! 440:
! 441: /webstringToAscii {
! 442: /arg1 set
! 443: [/in-webstringToAscii /s /i /j /c /n] pushVariables
! 444: [
! 445: /s arg1 def
! 446: s (array) dc /s set
! 447: /j 0 def /n s length def
! 448: /i 0 def
! 449: {
! 450: s i get /c set
! 451: c 32 eq { exit } { } ifelse
! 452: c 37 eq { % c == %
! 453: [s i 1 add get s i 2 add get] fromHex /c set
! 454: s j c put
! 455: j 1 add /j set
! 456: i 3 add /i set
! 457: } {
! 458: c 43 eq { % c == +
! 459: s j 32 put
! 460: j 1 add /j set
! 461: i 1 add /i set
! 462: } {
! 463: c 13 eq { % c == 0xd
! 464: i 1 add /i set
! 465: } {
! 466: s j c put
! 467: j 1 add /j set
! 468: i 1 add /i set
! 469: } ifelse
! 470: } ifelse
! 471: } ifelse
! 472: i n ge { exit } { } ifelse
! 473: } loop
! 474: s j carN /s set
! 475: s { (string) dc } map cat /arg1 set
! 476: ] pop
! 477: popVariables
! 478: arg1
! 479: } def
! 480:
! 481: /preformatHTML {
! 482: /arg1 set
! 483: [/in-preformatHTML /sss /c] pushVariables
! 484: [
! 485: /sss arg1 def
! 486: sss (array) dc /sss set
! 487: sss {
! 488: /c set
! 489: [
! 490: c 60 eq {
! 491: /c (<) def
! 492: } { } ifelse
! 493: c 62 eq {
! 494: /c (>) def
! 495: } { } ifelse
! 496: c 38 eq {
! 497: /c (&) def
! 498: } { } ifelse
! 499: ] pop
! 500: c (string) dc
! 501: } map cat /sss set
! 502: [(<pre> ) sss ( </pre> )] cat /arg1 set
! 503: ] pop
! 504: popVariables
! 505: arg1
! 506: } def
! 507:
! 508: /metaCommand {
! 509: /arg1 set
! 510: [/in-metaCommand /msg /result] pushVariables
! 511: [
! 512: /msg arg1 def
! 513: /result 1 def
! 514: msg (httpdAsirMeta quit) eq {
! 515: ox.ccc ( quit ) oxsubmit
! 516: ox.ccc oxshutdown
! 517: send-page-bye
! 518: quit
! 519: /result 0 def
! 520: } { } ifelse
! 521: msg (httpdAsirMeta save) eq {
! 522: send-page-save
! 523: /result 0 def
! 524: } { } ifelse
! 525: msg (httpdAsirMeta interrupt) eq {
! 526: ox.ccc oxreset
! 527: (Interrupted! <br>) send-page-3
! 528: /result 0 def
! 529: } { } ifelse
! 530: /arg1 result def
! 531: ] pop
! 532: popVariables
! 533: arg1
! 534: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to httpd-sm1.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc