=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/httpd.sm1,v retrieving revision 1.1 retrieving revision 1.11 diff -u -p -r1.1 -r1.11 --- OpenXM/src/kan96xx/Doc/httpd.sm1 2001/08/23 00:16:55 1.1 +++ OpenXM/src/kan96xx/Doc/httpd.sm1 2002/10/29 07:29:23 1.11 @@ -1,5 +1,11 @@ -%% $OpenXM$ +%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.10 2002/10/23 13:38:50 takayama Exp $ %% common modules for httpd on sm1. +/Oxserver_history_variable (Oxserver_history_variable_) def +/httpd.image.type + [(getenv) (OpenXM_PSTOIMG_TYPE)] extension +def + + /httpd_startserver { [(sm1.socket) (open) [httpd.port (localhost)]] extension /httpd.server.fdAndPort set @@ -68,7 +74,7 @@ httpd_startserver ; httpd_action ; httpd_stopserver ; - (5 sleep) system +% (sleep 2) system httpd.serial 1 add /httpd.serial set } loop } def @@ -87,7 +93,7 @@ 0 sendln () sendln (Shutdown the engine.
) sendln - (See you! Web/sm1 ) sendln + (See you! Web/asir, Web/sm1 ) sendln () sendln 0 sendln [(flush)] extension @@ -121,7 +127,11 @@ %%( ) sendln %%test. It does not work always?! %%( Pretty format ) sendln %%test. It works. - (
) sendln + [(getenv) (OXWEB_POST)] extension tag 0 eq { + () sendln % use get + }{ + () sendln + } ifelse () sendln [()] cat sendln @@ -172,6 +182,17 @@ [(flush)] extension } def +/send-page-warning-image { + (HTTP/0.9 200 OK) sendln + (Connection: close) sendln + (Content-Type: text/html) sendln + 0 sendln + (Error: Image translation is not supported on this server
) sendln + ( Check the value of the environmental variable OpenXM_PSTOIMG_TYPE
) sendln + 0 sendln + [(flush)] extension +} def + /stopclient { [(sm1.socket) (close) [client.fdAndPort 0 get] ] extension message } def @@ -301,29 +322,59 @@ arg1 } def -%% remove GET /?msg= +%% remove GET /?msg= or msg= /removeGET { /arg1 set [/in-removeGET /s /s2 /i /j /i0 - /tname + /tname /nnn /sta ] pushVariables [ /s arg1 def - /httpd.textarea.valid 1 def + /httpd.textarea.valid 0 def s 1 copy /s2 set s (array) dc /s set + /sta 0 def + + %% In case of POST, remove the HTTP header. cf. trouble for NS 6.0 + s length 4 gt { + [s 0 get s 1 get s 2 get s 3 get] (POST) (array) dc eq { + 0 1 s length 4 sub { + /i0 set + /sta i0 def + [ s i0 get s i0 1 add get ] [ 10 10 ] eq + [ s i0 get s i0 1 add get s i0 2 add get s i0 3 add get] + [ 13 10 13 10] eq or + { exit } { } ifelse + } for + }{ } ifelse + } { } ifelse + (sta=) messagen sta message + /nnn httpd.textarea.name.aaa length 6 sub def + /tname [ ] def - 0 1 s length 1 sub { + sta 1 s length 1 sub { /i0 set s i0 get 61 eq { %% 61 is = i0 1 add /i0 set - tname message + + [ + << tname length 1 sub >> -1 + << tname length nnn sub >> dup 0 ge { } { pop 0 } ifelse + { + /i set + tname i get + } for + ] reverse /tname set + (GET /?) (array) dc tname join /tname set + httpd.textarea.name.aaa message tname httpd.textarea.name.aaa eq { /httpd.textarea.valid 1 def } { /httpd.textarea.valid 0 def + tname message + httpd.textarea.name.aaa { (string) dc } map cat message (Warning: got an invalid name for the text field.) message } ifelse exit @@ -335,6 +386,8 @@ i0 1 s length 1 sub { /i set s2 j << s i get (string) dc >> put + j s2 length 1 sub lt { s2 j 1 add ( ) put } { } ifelse + %% might cause a BUG. It should be improved. j 1 add /j set } for /arg1 s2 def @@ -407,4 +460,78 @@ ] pop popVariables arg1 -} def +} def + +/executeStringAndSelectInputFromBrowserAndOxserver { + /arg3 set + /arg2 set + /arg1 set + [/in-executeStringAndSelectInputFromBrowserAndOxserver + /oxserver.ccc + /command.to.oxserver + /sss.engine + /sss.web + /sss + /err + /httpd.result + /stringOrCmo + ] pushVariables +% Global var: httpd.server.fd + [ + /oxserver.ccc arg1 def + /command.to.oxserver arg2 def + /stringOrCmo arg3 def + oxserver.ccc + command.to.oxserver + oxexecutestring ; + + [(oxReq) oxserver.ccc SM_dupErrors ] extension pop + + [(oxReq) oxserver.ccc SM_popCMO ] extension pop + stringOrCmo (string) eq { + [(oxReq) oxserver.ccc SM_popString ] extension pop + }{ + [(oxReq) oxserver.ccc SM_popCMO ] extension pop + } ifelse + [(flush)] extension pop + %% Select inputs for interruption. + %% Wait by the spin lock. + { + [(oxMultiSelect) [oxserver.ccc] 1] extension 1 get 0 get + /sss.engine set + [(sm1.socket) (mselect) + [[httpd.server.fd 0 get] 1] + ] extension 0 get /sss.web set + /sss [sss.engine sss.web] def + sss.engine { exit } { } ifelse + sss.web { exit } { } ifelse + } loop + sss message + + sss 0 get { + [(oxGet) oxserver.ccc] extension /err set + [(oxGet) oxserver.ccc] extension /httpd.result set + } { + oxserver.ccc oxreset + oxserver.ccc ("computation is interrupted.";) oxexecutestring ; + oxserver.ccc oxpopstring + /httpd.result set + exit + } ifelse + (------------- result -------------) message + httpd.result message + (----------------------------------) message + ( ) message + + err message + err [ ] eq { + } { + oxserver.ccc cleanErrors + [httpd.result 10 (string) dc err toString] cat + /httpd.result set + } ifelse + /arg1 [err httpd.result] def + ] pop + popVariables + arg1 +} def \ No newline at end of file