===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/httpd.sm1,v
retrieving revision 1.8
retrieving revision 1.13
diff -u -p -r1.8 -r1.13
--- OpenXM/src/kan96xx/Doc/httpd.sm1	2002/10/21 02:25:51	1.8
+++ OpenXM/src/kan96xx/Doc/httpd.sm1	2002/11/03 12:43:03	1.13
@@ -1,11 +1,22 @@
-%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.7 2002/10/21 01:59:15 takayama Exp $
+%% $OpenXM: OpenXM/src/kan96xx/Doc/httpd.sm1,v 1.12 2002/10/30 13:23:06 takayama Exp $
 %% common modules for httpd on sm1.
 /Oxserver_history_variable (Oxserver_history_variable_) def
 /httpd.image.type  
   [(getenv) (OpenXM_PSTOIMG_TYPE)] extension
 def
 
+[(getenv) (OXWEB_DEBUG)] extension tag 0 eq {
+   /httpd.debug 0 def
+} {  
+   /httpd.debug 1 def
+} ifelse
+[(getenv) (OXWEB_TAKE_LOG)] extension tag 0 eq {
+   /httpd.take.log  0 def
+} {  
+   /httpd.take.log 1 def
+} ifelse
 
+
 /httpd_startserver {
    [(sm1.socket) (open) [httpd.port (localhost)]] extension 
    /httpd.server.fdAndPort set
@@ -27,7 +38,7 @@ def
 
 /sendln {
  /arg1 set
- [/in-sendln /mmm] pushVariables
+ [/in-sendln /mmm /i] pushVariables
  [ arg1 /mmm set
   mmm tag 5 eq {
     [mmm 10 (string) dc] cat /mmm set
@@ -37,7 +48,8 @@ def
   [(sm1.socket) (select) [httpd.server.fd 0 get 0]] extension {
     (Warning (sendln): your peer closed the connection. Do not send the data.) message
   } {
-    [(sm1.socket) (write) [httpd.server.fd 0 get mmm]] extension message
+    [(sm1.socket) (write) [httpd.server.fd 0 get mmm]] extension /i set
+     httpd.debug { i message } { } ifelse
   } ifelse
  ] pop
  popVariables
@@ -74,6 +86,7 @@ def
     httpd_startserver ;
     httpd_action ;
     httpd_stopserver ;
+    httpd.take.log { (date) system  } { } ifelse
 %    (sleep 2) system 
     httpd.serial 1 add /httpd.serial set
   } loop    
@@ -288,7 +301,7 @@ def
         ss i (,) put
       } {  } ifelse
     } for
-    ss message
+    httpd.debug { ss message } {  } ifelse
     [ ss to_records pop] /arg1 set
   ] pop
   popVariables
@@ -326,36 +339,54 @@ def
 /removeGET {
   /arg1 set
   [/in-removeGET /s /s2 /i /j /i0
-   /tname  /nnn
+   /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 length 1 sub  >> -1
-          << tname length nnn sub >> {
+          << tname length nnn sub >> dup 0 ge { } { pop 0 } ifelse 
+          {
              /i set
              tname i get
           } for
-         ] reverse /tname set
+         ] reverse /tname set 
          (GET /?) (array) dc tname join /tname set
 
-         tname message
-         httpd.textarea.name.aaa message
+         httpd.debug { httpd.textarea.name.aaa message } {  } ifelse
          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
@@ -516,4 +547,103 @@ def
    ] pop
    popVariables
    arg1
+} def
+
+% This function will be written in C in a future.
+% [(httpd) (parseHTTP) string] extension
+% [(GET) key-value-pair-1 key-value-pair-2 ...]
+% [(POST) key-value-pair-1 key-value-pair-2 ...]
+% [(GET-file) file-1 file2 ...]
+% ex. (GET / HTT..) (GET /?rpc=1-2) 
+/httpd.parse {
+ /arg1 set 
+ [/in-httpd.parse /s /s2 /sta /i0
+  /ans /getKeyword /j /tname /tvalue
+ ] pushVariables
+ [
+     /s arg1 def
+     s 1 copy /s2 set
+     s (array) dc /s set
+
+     /sta 0 def
+     /getKeyword 0 def
+
+     s length 7 lt {
+        /ans [(GET-file)] def
+        /httpd.exit goto        
+     }{ } ifelse
+
+     /ans [(GET)] def
+     [s 0 get s 1 get s 2 get s 3 get s 4 get s 5 get] (GET /?) (array) dc eq {
+        /sta 6 def
+        /getKeyword 1 def
+     }{
+        [s 0 get s 1 get s 2 get s 3 get s 4 get] (GET /) (array) dc eq {
+            /sta 5 def
+        }{
+          [s 0 get s 1 get s 2 get s 3 get] (GET ) (array) dc eq {
+             /ans [(GET-file)] def 
+             /httpd.exit goto        
+          }  { /ans [ ] def /httpd.exit.goto } ifelse
+        } ifelse
+     }ifelse  
+
+     %% In case of POST, remove the HTTP header. cf. trouble for NS 6.0
+     [s 0 get s 1 get s 2 get s 3 get] (POST) (array) dc eq {
+          /ans [(POST) ] def
+          /getKeyword  1 def
+          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
+     (sta=) messagen sta message 
+
+     %% get file name
+     getKeyword not {
+       /tname  [  ] def
+       sta 1 << s length 1 sub >> {
+         /i0 set
+         s i0 get 32 le {  %% 32 is  " "
+           exit
+         } { } ifelse
+         tname s i0 get append /tname set
+       } for 
+       httpd.debug { (Filename is ) messagen tname {(string) dc } map message} {  } ifelse
+       /ans [(GET-file) tname { (string) dc } map cat ] def
+       /httpd.exit goto 
+     } { } ifelse
+
+     /tname  [  ] def
+     sta 1 << s length 1 sub >> {
+       /i0 set
+       s i0 get 61 eq {  %% 61 is = 
+         httpd.debug { tname message tname {(string) dc } map cat message} {  } ifelse
+         i0 1 add /i0 set
+         exit
+       } { } ifelse
+       tname s i0 get append /tname set
+     } for 
+
+     /j 0 def
+     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
+     ans [tname {(string) dc} map  cat
+           s2 webstringToAscii ] append
+     /ans set
+
+     /httpd.exit
+     /arg1 ans def
+ ] pop
+ popVariables
+ arg1
 } def
\ No newline at end of file