Annotation of OpenXM/src/kan96xx/Doc/httpd.sm1, Revision 1.1
1.1 ! takayama 1: %% $OpenXM$
! 2: %% common modules for httpd on sm1.
! 3: /httpd_startserver {
! 4: [(sm1.socket) (open) [httpd.port (localhost)]] extension
! 5: /httpd.server.fdAndPort set
! 6: (sm1.socket.open returns ) messagen httpd.server.fdAndPort message
! 7: [(sm1.socket) (accept) [httpd.server.fdAndPort 0 get]] extension
! 8: /httpd.server.fd set
! 9: (connected.) message
! 10: (sm1.socket.accept returns ) messagen httpd.server.fd message
! 11: } def
! 12:
! 13: /httpd_stopserver {
! 14: [(sm1.socket) (close) httpd.server.fd ] extension message
! 15: } def
! 16:
! 17: /send_packet {
! 18: /arg1 set
! 19: [(sm1.socket) (write) [httpd.server.fd 0 get arg1]] extension message
! 20: } def
! 21:
! 22: /sendln {
! 23: /arg1 set
! 24: [/in-sendln /mmm] pushVariables
! 25: [ arg1 /mmm set
! 26: mmm tag 5 eq {
! 27: [mmm 10 (string) dc] cat /mmm set
! 28: }{
! 29: 10 (string) dc /mmm set
! 30: } ifelse
! 31: [(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension {
! 32: (Warning (sendln): your peer closed the connection. Do not send the data.) message
! 33: } {
! 34: [(sm1.socket) (write) [httpd.server.fd 0 get mmm]] extension message
! 35: } ifelse
! 36: ] pop
! 37: popVariables
! 38: } def
! 39:
! 40: /sendBinaryFile {
! 41: /arg1 set
! 42: [/in-sendln /fname /fd /c /cdata] pushVariables
! 43: [ arg1 /fname set
! 44: [(sendBinaryFile: sending data) ] cat message
! 45: [(fp2openForRead) fname] extension /fd set fd message
! 46: fd 0 lt {
! 47: [(Error: sendBinaryFile: file ) fname ( is not found.)] cat message
! 48: /aaaa goto
! 49: } { } ifelse
! 50: [(fp2pushfile) fname] extension /cdata set
! 51: [(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension {
! 52: (Warning (sendBinaryFile): your peer closed the connection. Do not send the data.)
! 53: message
! 54: exit
! 55: } {
! 56: [(sm1.socket) (writeByte) [httpd.server.fd 0 get cdata]] extension pop
! 57: } ifelse
! 58: /aaaa
! 59: ] pop
! 60: popVariables
! 61: } def
! 62:
! 63: /httpd {
! 64: /httpd.serial 0 def
! 65: /httpd.history [ ] def
! 66: /httpd.result.history [ 0 ] def
! 67: {
! 68: httpd_startserver ;
! 69: httpd_action ;
! 70: httpd_stopserver ;
! 71: (5 sleep) system
! 72: httpd.serial 1 add /httpd.serial set
! 73: } loop
! 74: } def
! 75:
! 76: /send-page-bye {
! 77: (HTTP/0.9 200 OK) sendln
! 78: %% (Date: Sun, 18 Mar 2001 02:54:50 GMT) sendln
! 79: %% (Server: sm1/0.1 (Unix)) sendln
! 80: %% (Last-Modified: Wed, 23 Aug 2000 11:19:27 GMT) sendln
! 81: %% (ETag: "1f8f-5df-39a3b33f") sendln
! 82: %% (Accept-Ranges: bytes) sendln
! 83: %% (Content-Length: 10) sendln
! 84: (Connection: close) sendln
! 85: % (Content-Type: text/plain) sendln
! 86: (Content-Type: text/html) sendln
! 87: 0 sendln
! 88: (<html>) sendln
! 89: (Shutdown the engine. <br>) sendln
! 90: (See you! <a href="http://www.openxm.org"> Web/sm1 </a>) sendln
! 91: (</html>) sendln
! 92: 0 sendln
! 93: [(flush)] extension
! 94: } def
! 95:
! 96: /send-page-2 {
! 97: (HTTP/0.9 200 OK) sendln
! 98: %% (Content-Length: 10) sendln
! 99: (Connection: close) sendln
! 100: (Content-Type: text/html) sendln
! 101: 0 sendln
! 102: (<FORM NAME="myFORM">) sendln
! 103: (<INPUT TYPE="TEXT" NAME="Num">) sendln
! 104: (</FORM>) sendln
! 105: 0 sendln
! 106: [(flush)] extension
! 107: } def
! 108:
! 109: /send-page-3 {
! 110: /arg1 set
! 111: [/in-send-page-3 /result] pushVariables
! 112: [
! 113: /result arg1 def
! 114: (HTTP/0.9 200 OK) sendln
! 115: (Connection: close) sendln
! 116: (Content-Type: text/html) sendln
! 117: 0 sendln
! 118: %% (<FORM NAME="myFORM" METHOD="POST">) sendln
! 119: result sendln
! 120:
! 121: %%(<img src="hoge.jpeg"> <img>) sendln %%test. It does not work always?!
! 122: %%(<a href="hoge.jpeg"> Pretty format </a>) sendln %%test. It works.
! 123:
! 124: (<FORM NAME="myFORM">) sendln
! 125: (<INPUT TYPE=submit VALUE="submit">) sendln
! 126: [(<textarea name=) httpd.textarea.name
! 127: ( rows=10 cols="80" wrap="soft"></textarea>)] cat sendln
! 128: (</FORM>) sendln
! 129: send-menu-1
! 130: 0 sendln
! 131: [(flush)] extension
! 132: ] pop
! 133: popVariables
! 134: } def
! 135:
! 136: /send-image {
! 137: /arg2 set
! 138: /arg1 set
! 139: [/in-send-jpeg /fname /imagetype /ff /fsize] pushVariables
! 140: [
! 141: /fname arg1 def % set the jpeg file name.
! 142: /imagetype arg2 def % jpeg or gif
! 143: [(stat) fname] extension 0 get tag 0 eq {
! 144: (Warning (send-image): the file ) messagen fname messagen ( is not found.) message
! 145: /notFound goto
! 146: }{ }ifelse
! 147: [(stat) fname] extension 1 get 0 get toString /fsize set
! 148: (HTTP/1.1 200 OK) dup message sendln
! 149: (Server: httpd_sm1) dup message sendln
! 150: %% (ETag: "2197-bf6c-3b2d6541") sendln ???
! 151: (Accept-Ranges: bytes) dup message sendln
! 152: [(Content-Length: ) fsize] cat dup message sendln
! 153: (Connection: close) dup message sendln
! 154: [(Content-Type: image/) imagetype] cat dup message sendln
! 155: [(flush)] extension
! 156: 0 sendln
! 157: fname sendBinaryFile
! 158: 0 sendln
! 159: [(flush)] extension
! 160: /notFound
! 161: ] pop
! 162: popVariables
! 163: } def
! 164:
! 165: /send-page-warning {
! 166: (HTTP/0.9 200 OK) sendln
! 167: (Connection: close) sendln
! 168: (Content-Type: text/html) sendln
! 169: 0 sendln
! 170: (You cannot execute ox servers without a session key! <br>) sendln
! 171: 0 sendln
! 172: [(flush)] extension
! 173: } def
! 174:
! 175: /stopclient {
! 176: [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message
! 177: } def
! 178:
! 179:
! 180: /cleanErrors {
! 181: /arg1 set
! 182: [/in-cleanErrors /clientt /spp] pushVariables
! 183: [
! 184: /clientt arg1 def
! 185: clientt oxgetsp (integer) dc /spp set
! 186: clientt spp oxpops
! 187: ] pop
! 188: popVariables
! 189: } def
! 190:
! 191:
! 192: /fromHex {
! 193: /arg1 set
! 194: [/in-fromHex /s1 /s2 /c /c2] pushVariables
! 195: [
! 196: arg1 0 get /s1 set
! 197: arg1 1 get /s2 set
! 198:
! 199: 48 s1 le s1 57 le and { % 0, ..., 9
! 200: s1 48 sub /c set
! 201: }{ } ifelse
! 202: 65 s1 le s1 70 le and { % A, ..., F
! 203: s1 65 sub 10 add /c set
! 204: }{ } ifelse
! 205: 97 s1 le s1 102 le and { % a, ..., f
! 206: s1 97 sub 10 add /c set
! 207: }{ } ifelse
! 208: c 16 mul /c set
! 209:
! 210: 48 s2 le s2 57 le and { % 0, ..., 9
! 211: s2 48 sub /c2 set
! 212: }{ } ifelse
! 213: 65 s2 le s2 70 le and { % A, ..., F
! 214: s2 65 sub 10 add /c2 set
! 215: }{ } ifelse
! 216: 97 s2 le s2 102 le and { % a, ..., f
! 217: s2 97 sub 10 add /c2 set
! 218: }{ } ifelse
! 219: c c2 add /arg1 set
! 220: ] pop
! 221: popVariables
! 222: arg1
! 223: } def
! 224:
! 225: /randomName {
! 226: [/in-randomName /sss /rrr ] pushVariables
! 227: [
! 228: %% Seed name
! 229: /sss [ 97 97 97 97 97 97 97 97 97 97 ] def %% 97 == 'a'
! 230: %% This procedure to generate port number might fail.
! 231: sss {
! 232: [
! 233: [(oxGenPass)] extension .. /rrr set
! 234: [(tdiv_qr) rrr (26)..] mpzext 1 get /rrr set
! 235: ] pop
! 236: rrr (integer) dc add
! 237: } map
! 238: /sss set
! 239: sss {(string) dc} map cat /arg1 set
! 240: ] pop
! 241: popVariables
! 242: arg1
! 243: } def
! 244:
! 245: (httpd.textarea.name) boundp { }
! 246: {
! 247: /httpd.textarea.name randomName def
! 248: /httpd.textarea.name.aaa
! 249: [(GET /?) httpd.textarea.name] cat
! 250: (array) dc
! 251: def
! 252: } ifelse
! 253:
! 254:
! 255: %% Decompose into tokens separated by a space.
! 256: %% (GET /hoge.jpeg ???) ---> [(GET) (/hoge.jpeg) (???)]
! 257: /toTokensBySpace {
! 258: /arg1 set
! 259: [/in-toTokesBySpace /ss /ss2 /i] pushVariables
! 260: [
! 261: /ss arg1 def
! 262: ss 1 copy /ss set
! 263: ss (array) dc /ss2 set
! 264: 0 1 ss2 length 1 sub {
! 265: /i set
! 266: ss2 i get 32 eq { %% equal to space
! 267: ss i (,) put
! 268: } { } ifelse
! 269: } for
! 270: ss message
! 271: [ ss to_records pop] /arg1 set
! 272: ] pop
! 273: popVariables
! 274: arg1
! 275: } def
! 276:
! 277: /askToSendFile {
! 278: /arg1 set
! 279: [/in-askToSendFile /ss /fname] pushVariables
! 280: [
! 281: /ss arg1 def
! 282: /fname null def
! 283: ss toTokensBySpace /ss set
! 284: ss 0 get (GET) eq {
! 285: ss 1 get length 1 gt {
! 286: ss 1 get (array) dc 1 get 63 eq { %% See if /?
! 287: /fname null def
! 288: }{
! 289: /fname ss 1 get def % set the file name.
! 290: fname (array) dc rest /fname set % remove /
! 291: fname { (string) dc } map cat /fname set
! 292: } ifelse
! 293: }{ /fname null def } ifelse
! 294: }{
! 295: /fname null def
! 296: } ifelse
! 297: (::::) messagen ss message fname message
! 298: /arg1 fname def
! 299: ] pop
! 300: popVariables
! 301: arg1
! 302: } def
! 303:
! 304: %% remove GET /?msg=
! 305: /removeGET {
! 306: /arg1 set
! 307: [/in-removeGET /s /s2 /i /j /i0
! 308: /tname
! 309: ] pushVariables
! 310: [
! 311: /s arg1 def
! 312: /httpd.textarea.valid 1 def
! 313: s 1 copy /s2 set
! 314: s (array) dc /s set
! 315:
! 316: /tname [ ] def
! 317: 0 1 s length 1 sub {
! 318: /i0 set
! 319: s i0 get 61 eq { %% 61 is =
! 320: i0 1 add /i0 set
! 321: tname message
! 322: httpd.textarea.name.aaa message
! 323: tname httpd.textarea.name.aaa eq {
! 324: /httpd.textarea.valid 1 def
! 325: } {
! 326: /httpd.textarea.valid 0 def
! 327: (Warning: got an invalid name for the text field.) message
! 328: } ifelse
! 329: exit
! 330: } { } ifelse
! 331: tname s i0 get append /tname set
! 332: } for
! 333:
! 334: /j 0 def
! 335: i0 1 s length 1 sub {
! 336: /i set
! 337: s2 j << s i get (string) dc >> put
! 338: j 1 add /j set
! 339: } for
! 340: /arg1 s2 def
! 341: ] pop
! 342: arg1
! 343: } def
! 344:
! 345: /webstringToAscii {
! 346: /arg1 set
! 347: [/in-webstringToAscii /s /i /j /c /n] pushVariables
! 348: [
! 349: /s arg1 def
! 350: s (array) dc /s set
! 351: /j 0 def /n s length def
! 352: /i 0 def
! 353: {
! 354: s i get /c set
! 355: c 32 eq { exit } { } ifelse
! 356: c 37 eq { % c == %
! 357: [s i 1 add get s i 2 add get] fromHex /c set
! 358: s j c put
! 359: j 1 add /j set
! 360: i 3 add /i set
! 361: } {
! 362: c 43 eq { % c == +
! 363: s j 32 put
! 364: j 1 add /j set
! 365: i 1 add /i set
! 366: } {
! 367: c 13 eq { % c == 0xd
! 368: i 1 add /i set
! 369: } {
! 370: s j c put
! 371: j 1 add /j set
! 372: i 1 add /i set
! 373: } ifelse
! 374: } ifelse
! 375: } ifelse
! 376: i n ge { exit } { } ifelse
! 377: } loop
! 378: s j carN /s set
! 379: s { (string) dc } map cat /arg1 set
! 380: ] pop
! 381: popVariables
! 382: arg1
! 383: } def
! 384:
! 385: /preformatHTML {
! 386: /arg1 set
! 387: [/in-preformatHTML /sss /c] pushVariables
! 388: [
! 389: /sss arg1 def
! 390: sss (array) dc /sss set
! 391: sss {
! 392: /c set
! 393: [
! 394: c 60 eq {
! 395: /c (<) def
! 396: } { } ifelse
! 397: c 62 eq {
! 398: /c (>) def
! 399: } { } ifelse
! 400: c 38 eq {
! 401: /c (&) def
! 402: } { } ifelse
! 403: ] pop
! 404: c (string) dc
! 405: } map cat /sss set
! 406: [(<pre> ) sss ( </pre> )] cat /arg1 set
! 407: ] pop
! 408: popVariables
! 409: arg1
! 410: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to httpd.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc