Annotation of OpenXM/src/kan96xx/Doc/httpd-asir2.sm1, Revision 1.3
1.3 ! takayama 1: %% $OpenXM: OpenXM/src/kan96xx/Doc/httpd-asir2.sm1,v 1.2 2014/08/30 22:47:20 takayama Exp $
1.1 takayama 2: %% Asir server to be called from a cgi program.
3:
4: [(parse) (httpd-asir.sm1) pushfile] extension pop
5:
1.2 takayama 6: %% Default value of timer. Todo, not implemented.
7: %% /webasir.tlimit (120) def
8:
9: %% export CGI_ASIR_ALLOW="[(fctr) (quit)]"
10: %% export WEBASIR_TYPE="fctr"
1.3 ! takayama 11: %% export OX_ASIR_LOAD_FILE="/private/taka/abc.rr"
1.2 takayama 12: %% Start sm1 and webasir2, connect by asir-port/cgi/webasir2.c
1.1 takayama 13: %% Top level script
14: %% GET /?key=1%2B3%3B [two nl]
15: %% GET /?msg=httpdAsirMeta+quit HTTP/1.1 [two nl]
16: /httpd-asir2.quit 0 def
17: /webasir2 {
1.3 ! takayama 18: [/rrr /cmd /mypid /lockname /mytype /lofile] pushVariables
1.1 takayama 19: [
20: %% This procedure to generate port number might fail.
21: [(oxGenPass)] extension . (integer) dc /rrr set
22: rrr << rrr 20000 idiv 20000 mul >> sub /rrr set
23: /httpd.port 1200 rrr add def
24: httpd.port message
25:
1.2 takayama 26: [(getenv) (CGI_ASIR_ALLOW)] extension tag 0 eq { /mytype (all) def }
27: {oxasirSetSecureFlagFromEnv} ifelse
28: [(getenv) (WEBASIR_TYPE)] extension isString {
29: /mytype [(getenv) (WEBASIR_Type)] extension def
30: } { /mytype (none) def } ifelse
1.1 takayama 31: [(getpid)] extension (dollar) dc /mypid set
32: [(/tmp/webasir-) mytype (-) mypid (.txt)] cat /lockname set
33: [(PrintDollar) 0] system_variable
34: [(outputObjectToFile) lockname
35: [httpd.port nl httpd.textarea.name nl ] cat
36: ] extension
37: lockname message
38: [(cat ) lockname] cat (system) nl message
39: /httpd-asir2.quit 0 def
40: httpd ;
41: [(rm -f ) lockname] cat system
42: ] pop
43: popVariables
44: } def
45:
46: %% override httpd_action in httpd-asir.sm1
47: /httpd_action {
48: [/in-httpd /ff /httpd.com /httpd.result /sss
49: /sss.engine /sss.web /err
50: /oxserver.vname
51: ] pushVariables
52: [
53: {
54: [(sm1.socket) (select) [httpd.server.fd 0 get -1]] extension
55: %% wait for ever
56: [(sm1.socket) (readHTTP) [httpd.server.fd 0 get ]] extension /ff set
57: ff tag 0 eq {
58: (connection is closed.) message exit
59: }
60: {
61: (------------ start ----------------------) message
62: ff message
63: /httpd.sendFile null def
64: (-----------------------------------------) message
65: ff removeGET webstringToAscii /httpd.com set
66: [(httpd.com=) httpd.com] cat message
67: (httpd.sendFile=) messagen httpd.sendFile message
68: (------------ end ----------------------) message
69: ( ) message
70: httpd.serial 0 eq {
71: /httpd.com httpd.initialization def
72: /httpd.textarea.valid 1 def
73: } { } ifelse
74: httpd.com metaCommand {
75: httpd.textarea.valid {
76: /oxserver.vname
77: [Oxserver_history_variable httpd.serial toString] cat
78: def
79: oxasir.ccc
80: [(if (1) {) httpd.com (; };)] cat
81: oxexecutestring ;
82: }{
83: send-page-warning exit
84: } ifelse
85: [(oxReq) oxasir.ccc SM_dupErrors ] extension pop
86:
87: [(oxReq) oxasir.ccc SM_popCMO ] extension pop
88:
89: [(oxReq) oxasir.ccc SM_setName oxserver.vname] extension pop
90: oxasir.ccc [oxserver.vname (;)] cat oxexecutestring
91:
92: [(oxReq) oxasir.ccc SM_popString ] extension pop
93: [(flush)] extension pop
94: %% Select inputs for interruption.
95: %% Wait by the spin lock.
96: {
97: [(oxMultiSelect) [oxasir.ccc] 1] extension 1 get 0 get
98: /sss.engine set
99: [(sm1.socket) (mselect)
100: [[httpd.server.fd 0 get] 1]
101: ] extension 0 get /sss.web set
102: /sss [sss.engine sss.web] def
103: sss.engine { exit } { } ifelse
104: sss.web { exit } { } ifelse
105: } loop
106: sss message
107:
108: sss 0 get {
109: [(oxGet) oxasir.ccc] extension /err set
110: [(oxGet) oxasir.ccc] extension /httpd.result set
111: %% oxasir.ccc oxpopstring /httpd.result set
112: } {
113: oxasir.ccc oxreset
114: oxasir.ccc ("computation is interrupted.";) oxexecutestring ;
115: oxasir.ccc oxpopstring
116: /httpd.result set
117: exit
118: } ifelse
119: (------------- result -------------) message
120: httpd.result message
121: (----------------------------------) message
122: ( ) message
123:
124: err message
125: err [ ] eq {
126: /httpd.history
127: httpd.history
128: [10 (string) dc
129: (/**** ) httpd.serial toString ( ****/)
130: 10 (string) dc
131: httpd.com
132: (;) %% add extra ;
133: ] cat
134: append
135: def
136: } {
137: oxasir.ccc cleanErrors
138: [httpd.result 10 (string) dc err toString] cat
139: /httpd.result set
140: } ifelse
141:
142: httpd.result
143: sendln exit %% exit the loop LOOP-A
144: } { exit } ifelse %% metaCommand
145: } ifelse
146: } loop %% LOOP-A
147: ] pop
148: popVariables
149: } def
150:
151: %%overrides metaCommand in httpd-asir.sm1
152: /metaCommand {
153: /arg1 set
154: [/in-metaCommand /msg /result /msg2 /nn
155: /err /fn
156: ] pushVariables
157: [
158: /msg arg1 def
159: /result 1 def
160: msg 1 copy toTokensBySpace /msg2 set
161: msg (httpdAsirMeta quit) eq {
162: oxasir.ccc oxshutdown
163: (byebye) sendln
164: /httpd-asir2.quit 1 def
165: /result 0 def
166: } { } ifelse
167: msg (httpdAsirMeta save) eq {
168: send-page-save
169: /result 0 def
170: } { } ifelse
171: msg (httpdAsirMeta interrupt) eq {
172: oxasir.ccc oxreset
173: (Interrupted! <br>) send-page-3
174: /result 0 def
175: } { } ifelse
176: /arg1 result def
177: ] pop
178: popVariables
179: arg1
180: } def
181:
182: %%override httpd in httpd.sm1
183: /httpd {
184: /httpd.serial 1 def
185: /httpd.history [ ] def
186: /httpd.result.history [ 0 ] def
187: [(nobody)] extension pop
188: {
189: httpd_startserver ;
190: httpd_action ;
191: httpd_stopserver ;
192: httpd.take.log { (date) system } { } ifelse
193: % (sleep 2) system
194: httpd.serial 1 add /httpd.serial set
195: httpd-asir2.quit { exit } { } ifelse
196: } loop
197: } def
1.2 takayama 198:
199: % overrides or new for cgiasir.sm1
200: /oxasirSetSecureMode {
201: oxasir.ccc [ ] eq { ox_asirConnectMethod } { } ifelse
202: oxasir.ccc $ctrl("error_in_timer",1);$ oxsubmit
203: oxasir.ccc $set_secure_mode(1);$ oxsubmit
204: } def
205:
206: /oxasirSetSecureFlag {
207: /arg1 set
208: [/fff ] pushVariables
209: [
210: /fff arg1 def
211: oxasir.ccc [ ] eq { ox_asirConnectMethod } { } ifelse
212: oxasir.ccc [$set_secure_flag("$ fff toString $",1);$] cat oxsubmit
213: oxasir.ccc oxpopcmo
214: ] pop
215: popVariables
216: } def
217:
218: %%%
219: /oxasirSetSecureFlagFromEnv {
220: [(getenv) (CGI_ASIR_ALLOW)] extension isString {
221: [(getenv) (CGI_ASIR_ALLOW)] extension /cgiAsirAllow.s set
222: [(parse) cgiAsirAllow.s] extension pop /cgiAsirAllow.p set
223: cgiAsirAllow.p isArray {
224: cgiAsirAllow.p /cgiAsirAllow set
225: } { } ifelse
226: } { } ifelse
227: cgiAsirAllow {oxasirSetSecureFlag} map
228: oxasirSetSecureMode
229: } def
230:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>