Annotation of OpenXM/src/kan96xx/Doc/httpd-asir.sm1, Revision 1.1
1.1 ! takayama 1: %% $OpenXM$
! 2: %% http server by sm1
! 3: [(parse) (oxasir.sm1) pushfile] extension
! 4: (oxasir.started) boundp {
! 5: } {
! 6: [(x^2-1) (x)] fctr pop
! 7: } ifelse
! 8:
! 9: /startserver {
! 10: [(sm1.socket) (open) [1200 (localhost)]] extension /server.fdAndPort set
! 11: (sm1.socket.open returns ) messagen server.fdAndPort message
! 12: [(sm1.socket) (accept) [server.fdAndPort 0 get]] extension
! 13: /server.fd set
! 14: (connected.) message
! 15: (sm1.socket.accept returns ) messagen server.fd message
! 16: } def
! 17:
! 18: /stopserver {
! 19: [(sm1.socket) (close) server.fd ] extension message
! 20: } def
! 21:
! 22: /send {
! 23: /arg1 set
! 24: [(sm1.socket) (write) [server.fd 0 get arg1]] extension message
! 25: } def
! 26:
! 27: /sendln {
! 28: /mmm set
! 29: mmm tag 5 eq {
! 30: [mmm 10 (string) dc] cat /mmm set
! 31: }{
! 32: 10 (string) dc /mmm set
! 33: } ifelse
! 34: [(sm1.socket) (write) [server.fd 0 get mmm]] extension message
! 35: } def
! 36:
! 37: /httpd {
! 38: {
! 39: startserver ;
! 40: action ;
! 41: stopserver ;
! 42: (5 sleep) system
! 43: } loop
! 44: } def
! 45:
! 46: /action {
! 47: {
! 48: /httpd.com.old ( ) def
! 49: [(sm1.socket) (select) [server.fd 0 get -1]] extension
! 50: %% wait for ever
! 51: {
! 52: [(sm1.socket) (read) [server.fd 0 get ]] extension /ff set
! 53: ff length 0 eq {
! 54: (connection is closed.) message
! 55: }
! 56: ff (quit) eq
! 57: { (We exit the function httpd) message exit }
! 58: { %% [(SigIgn) 0] system_variable
! 59: (------------ start ----------------------) message
! 60: ff message
! 61: (-----------------------------------------) message
! 62: ff removeGET webstringToAscii /httpd.com set
! 63: httpd.com message
! 64: (------------ end ----------------------) message
! 65: ( ) message
! 66: oxasir.ccc
! 67: [(if (1) {) httpd.com (};)] cat
! 68: oxexecutestring ;
! 69: oxasir.ccc oxpopstring /httpd.result set
! 70: /httpd.com.old httpd.com def
! 71: (------------- result -------------) message
! 72: httpd.result message
! 73: (----------------------------------) message
! 74: ( ) message
! 75: [(Input:) (<pre> ) httpd.com (</pre>) (<br>)
! 76: (Output:) (<pre>)
! 77: httpd.result
! 78: (</pre>)
! 79: ] cat
! 80: send-page-3 exit
! 81: %% [(SigIgn) 1] system_variable
! 82: } ifelse
! 83: }
! 84: { } ifelse
! 85: } loop
! 86: } def
! 87:
! 88:
! 89: /send-page-1 {
! 90: (HTTP/0.9 200 OK) sendln
! 91: %% (Date: Sun, 18 Mar 2001 02:54:50 GMT) sendln
! 92: %% (Server: sm1/0.1 (Unix)) sendln
! 93: %% (Last-Modified: Wed, 23 Aug 2000 11:19:27 GMT) sendln
! 94: %% (ETag: "1f8f-5df-39a3b33f") sendln
! 95: %% (Accept-Ranges: bytes) sendln
! 96: %% (Content-Length: 10) sendln
! 97: (Connection: close) sendln
! 98: (Content-Type: text/plain) sendln
! 99: 0 sendln
! 100: (HOGE HOGE!) sendln
! 101: 0 sendln
! 102: [(flush)] extension
! 103: } def
! 104:
! 105: /send-page-2 {
! 106: (HTTP/0.9 200 OK) sendln
! 107: %% (Content-Length: 10) sendln
! 108: (Connection: close) sendln
! 109: (Content-Type: text/html) sendln
! 110: 0 sendln
! 111: (<FORM NAME="myFORM">) sendln
! 112: (<INPUT TYPE="TEXT" NAME="Num">) sendln
! 113: (</FORM>) sendln
! 114: 0 sendln
! 115: [(flush)] extension
! 116: } def
! 117:
! 118: /send-page-3 {
! 119: /arg1 set
! 120: [/in-send-page-3 /result] pushVariables
! 121: [
! 122: /result arg1 def
! 123: (HTTP/0.9 200 OK) sendln
! 124: (Connection: close) sendln
! 125: (Content-Type: text/html) sendln
! 126: 0 sendln
! 127: %% (<FORM NAME="myFORM" METHOD="POST">) sendln
! 128: result sendln
! 129: (<FORM NAME="myFORM">) sendln
! 130: (<INPUT TYPE=submit VALUE="submit">) sendln
! 131: (<textarea name=msg rows=10 cols="62" wrap="soft"></textarea>) sendln
! 132: (</FORM>) sendln
! 133: 0 sendln
! 134: [(flush)] extension
! 135: ] pop
! 136: popVariables
! 137: } def
! 138:
! 139:
! 140: /stopclient {
! 141: [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
! 142: } def
! 143:
! 144:
! 145: /fromHex {
! 146: /arg1 set
! 147: [/in-fromHex /s1 /s2 /c /c2] pushVariables
! 148: [
! 149: arg1 0 get /s1 set
! 150: arg1 1 get /s2 set
! 151:
! 152: 48 s1 le s1 57 le and { % 0, ..., 9
! 153: s1 48 sub /c set
! 154: }{ } ifelse
! 155: 65 s1 le s1 70 le and { % A, ..., F
! 156: s1 65 sub 10 add /c set
! 157: }{ } ifelse
! 158: 97 s1 le s1 102 le and { % a, ..., f
! 159: s1 97 sub 10 add /c set
! 160: }{ } ifelse
! 161: c 16 mul /c set
! 162:
! 163: 48 s2 le s2 57 le and { % 0, ..., 9
! 164: s2 48 sub /c2 set
! 165: }{ } ifelse
! 166: 65 s2 le s2 70 le and { % A, ..., F
! 167: s2 65 sub 10 add /c2 set
! 168: }{ } ifelse
! 169: 97 s2 le s2 102 le and { % a, ..., f
! 170: s2 97 sub 10 add /c2 set
! 171: }{ } ifelse
! 172: c c2 add /arg1 set
! 173: ] pop
! 174: popVariables
! 175: arg1
! 176: } def
! 177:
! 178: /removeGET {
! 179: /arg1 set
! 180: [/in-removeGET /s /s2 /i /j] pushVariables
! 181: [
! 182: /s arg1 def
! 183: s 1 copy /s2 set
! 184: s (array) dc /s set
! 185: /j 0 def
! 186: 10 1 s length 1 sub {
! 187: /i set
! 188: s2 j << s i get (string) dc >> put
! 189: j 1 add /j set
! 190: } for
! 191: /arg1 s2 def
! 192: ] pop
! 193: arg1
! 194: } def
! 195:
! 196: /webstringToAscii {
! 197: /arg1 set
! 198: [/in-webstringToAscii /s /i /j /c /n] pushVariables
! 199: [
! 200: /s arg1 def
! 201: s (array) dc /s set
! 202: /j 0 def /n s length def
! 203: /i 0 def
! 204: {
! 205: s i get /c set
! 206: c 32 eq { exit } { } ifelse
! 207: c 37 eq { % c == %
! 208: [s i 1 add get s i 2 add get] fromHex /c set
! 209: s j c put
! 210: j 1 add /j set
! 211: i 3 add /i set
! 212: } {
! 213: c 43 eq { % c == +
! 214: s j 32 put
! 215: j 1 add /j set
! 216: i 1 add /i set
! 217: } {
! 218: c 13 eq { % c == 0xd
! 219: i 1 add /i set
! 220: } {
! 221: s j c put
! 222: j 1 add /j set
! 223: i 1 add /i set
! 224: } ifelse
! 225: } ifelse
! 226: } ifelse
! 227: i n ge { exit } { } ifelse
! 228: } loop
! 229: s j carN /s set
! 230: s { (string) dc } map cat /arg1 set
! 231: ] pop
! 232: popVariables
! 233: arg1
! 234: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>