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