Patch title: Release 94 bulk changes
Abstract:
File: /pliant/protocol/http/server.pli
Key:
    Removed line
    Added line
   
abstract
  [Pliant HTTP server implementation, according to RFC2616] 
  [This implementation also contains a very powerfull mecani



abstract
  [Pliant HTTP server implementation, according to RFC2616] 
  [This implementation also contains a very powerfull mecani



module "/pliant/install/minimal.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/stream/openmode.pli"
module "/pliant/language/stream/filesystembase.pli"
module "/pliant/language/stream/count.pli"
module "chunked.pli"
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/optimizer.pli"
module "/pliant/language/context.pli"
module "/pliant/language/os.pli"
module "/pliant/admin/file.pli"


submodule "/pliant/util/encoding/http.pli"
submodule "/pliant/util/encoding/html.pli"
module "/pliant/util/encoding/date.pli"
module "/pliant/util/encoding/base64.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/stream/openmode.pli"
module "/pliant/language/stream/filesystembase.pli"
module "/pliant/language/stream/count.pli"
module "chunked.pli"
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/optimizer.pli"
module "/pliant/language/context.pli"
module "/pliant/language/os.pli"
module "/pliant/admin/file.pli"


submodule "/pliant/util/encoding/http.pli"
submodule "/pliant/util/encoding/html.pli"
module "/pliant/util/encoding/date.pli"
module "/pliant/util/encoding/base64.pli"
module "/pliant/language/type/text/str8.pli"
module "/pliant/language/type/text/language.pli"
module "/pliant/language/data/string_cast.pli"
module "/pliant/language/data/string_cast.pli"
module "/pliant/language/schedule/threads_engine.pli"
module "/pliant/admin/md5.pli"
module "/pliant/util/crypto/random.pli"
module "/pliant/util/crypto/cipher.pli"
module "/pliant/language/ui/ansi_terminal.pli"
module "/pliant/protocol/dns/name.pli"
module "stack.pli"
module "/pliant/graphic/color/rgb888.pli"


public
  type HttpRequest
    field Link:Stream stream
    field Link:HttpServer server
    field Float protocol_level
    field Str remote_ip_address
    field CBool keep_alive_requested
    field CBool keep_alive_applied
    field Float keep_alive_timeout
    #
    field Str command
    field Str encoded_path path
    field Str encoded_options options
    field Str context
    field Link:Type context_type
    field Str form
    field Str user_name
    field Int user_auth_level <- 0
    field CBool user_is_admin <- false
    field Str user_shaker
    field Str browser
    field Str browser_model ; field Float browser_release
    field Str supported_encoding
module "/pliant/admin/md5.pli"
module "/pliant/util/crypto/random.pli"
module "/pliant/util/crypto/cipher.pli"
module "/pliant/language/ui/ansi_terminal.pli"
module "/pliant/protocol/dns/name.pli"
module "stack.pli"
module "/pliant/graphic/color/rgb888.pli"


public
  type HttpRequest
    field Link:Stream stream
    field Link:HttpServer server
    field Float protocol_level
    field Str remote_ip_address
    field CBool keep_alive_requested
    field CBool keep_alive_applied
    field Float keep_alive_timeout
    #
    field Str command
    field Str encoded_path path
    field Str encoded_options options
    field Str context
    field Link:Type context_type
    field Str form
    field Str user_name
    field Int user_auth_level <- 0
    field CBool user_is_admin <- false
    field Str user_shaker
    field Str browser
    field Str browser_model ; field Float browser_release
    field Str supported_encoding
    field Str lang
    field Str language
    field Str site_name
    field Str area_path area_root
    field Str site_default
    field Str style_name
    field Str style_options
    field Str forward
    field Dictionary rights
    #
    field Str query_first_line
    field List query_log
    field Link:Stream query_stream
    field CBool answer_header_sent answer_footer_sent
    field Str answer_status           # status message that 
    field DateTime answer_datetime
    field CBool answer_is_dynamic
    field Str answer_mime_type
    field Int answer_size
    field Str answer_encoding
    field CBool answer_chunked
    field List answer_extra
    field Link:Stream answer_stream
    field List temp_files
    field TraceSession log
    field Address log_mark


implicit site_secret_database
    field Str site_name
    field Str area_path area_root
    field Str site_default
    field Str style_name
    field Str style_options
    field Str forward
    field Dictionary rights
    #
    field Str query_first_line
    field List query_log
    field Link:Stream query_stream
    field CBool answer_header_sent answer_footer_sent
    field Str answer_status           # status message that 
    field DateTime answer_datetime
    field CBool answer_is_dynamic
    field Str answer_mime_type
    field Int answer_size
    field Str answer_encoding
    field CBool answer_chunked
    field List answer_extra
    field Link:Stream answer_stream
    field List temp_files
    field TraceSession log
    field Address log_mark


implicit site_secret_database
  if data:sign_secret=""
    data sign_secret := random_string http_sign_secret_bits\
  if data:sign_secret:len=0
    data sign_secret := straight_to_Str8 (random_string http_sign_secret_bits\8) # a 256 bit secret should be enough since the MD5 signature is 128 bits
    store
    store
  if data:cipher_secret=""
    data cipher_secret := random_string http_cipher_secret_b
  if data:cipher_secret:len=0
    data cipher_secret := straight_to_Str8 (random_string http_cipher_secret_bits\8)
    store
    store
  if data:sign_secret2=""
    data sign_secret2 := random_string http_sign_secret_bits
  if data:sign_secret2:len=0
    data sign_secret2 := straight_to_Str8 (random_string http_sign_secret_bits\8)
    store
    store
  if data:cipher_secret2=""
    data cipher_secret2 := random_string http_cipher_secret_
  if data:cipher_secret2:len=0
    data cipher_secret2 := straight_to_Str8 (random_string http_cipher_secret_bits\8)
    store

method request generate_signature data -> sign
  arg HttpRequest request ; arg Str data sign
  if site_secret_database:data:sign_secret<>""
    store

method request generate_signature data -> sign
  arg HttpRequest request ; arg Str data sign
  if site_secret_database:data:sign_secret<>""
    sign := base64_alt_encode (string_md5_binary_signature d
    sign := base64_alt_encode (string_md5_binary_signature data+" "+request:user_name+" "+request:user_shaker+" "+(straight_to_Str site_secret_database:data:sign_secret))
  else
    sign := ""
 
method request check_signature data sign -> status
  arg_rw HttpRequest request ; arg Str data sign ; arg Statu
  if sign=(request generate_signature data)
    status := success
  else
    sign := ""
 
method request check_signature data sign -> status
  arg_rw HttpRequest request ; arg Str data sign ; arg Statu
  if sign=(request generate_signature data)
    status := success
  eif site_secret_database:data:sign_secret2<>"" and sign=ba
  eif site_secret_database:data:sign_secret2<>"" and sign=base64_alt_encode:(string_md5_binary_signature data+" "+request:user_name+" "+request:user_shaker+" "+(straight_to_Str site_secret_database:data:sign_secret2))
    status := success
    status := success
  eif request:user_name<>"" and sign=base64_alt_encode:(stri
  eif request:user_name<>"" and sign=base64_alt_encode:(string_md5_binary_signature data+"   "+(straight_to_Str site_secret_database:data:sign_secret))
    status := success
  else
    request:log trace "invalid signature"
    status := failure


method request cipher clear -> ciphered
  arg HttpRequest request ; arg Str clear ciphered
    status := success
  else
    request:log trace "invalid signature"
    status := failure


method request cipher clear -> ciphered
  arg HttpRequest request ; arg Str clear ciphered
  ciphered := base64_alt_encode (cipher clear site_secret_da
  ciphered := base64_alt_encode (cipher clear (straight_to_Str site_secret_database:data:cipher_secret) http_seed_bits http_rc4_laps)

method request uncipher ciphered alternate -> clear
  arg HttpRequest request ; arg Str clear ciphered ; arg CBo

method request uncipher ciphered alternate -> clear
  arg HttpRequest request ; arg Str clear ciphered ; arg CBo
  clear := uncipher base64_alt_decode:ciphered (shunt altern
  clear := uncipher base64_alt_decode:ciphered straight_to_Str:(shunt alternate site_secret_database:data:cipher_secret2 site_secret_database:data:cipher_secret) http_seed_bits http_rc4_laps


method request assign_rights uname ip rights
  arg_rw HttpRequest request ; arg Str uname ip ; arg_rw Str
  var Data:User u :> user uname
  if u:style_options<>""
    request style_options += "[lf]"+u:style_options


method request assign_rights uname ip rights
  arg_rw HttpRequest request ; arg Str uname ip ; arg_rw Str
  var Data:User u :> user uname
  if u:style_options<>""
    request style_options += "[lf]"+u:style_options
  if u:language<>""
    request language := u language
    var Int index := language_index u:language
    if index<>undefined
      current_thread_header language_index := index
  each r u:right
    if (string request:user_auth_level)>=r:auth and (ip is_i
      request:rights kmap r:right CBool := true
      if r:right="administrator"
        request user_is_admin := true
      rights += " "+r:right


method request assign_site
  arg_rw HttpRequest request
  request site_default := "/pliant/protocol/http/default.htm
  request area_path := "/"
  request area_root := "/"
  part assign
  each r u:right
    if (string request:user_auth_level)>=r:auth and (ip is_i
      request:rights kmap r:right CBool := true
      if r:right="administrator"
        request user_is_admin := true
      rights += " "+r:right


method request assign_site
  arg_rw HttpRequest request
  request site_default := "/pliant/protocol/http/default.htm
  request area_path := "/"
  request area_root := "/"
  part assign
    request style_name := ""
    request style_options := ""
    var Str lsite := request:stream safe_query "local_site"
    if lsite<>"" and (request:stream safe_query "remote_user
      request site_name := lsite
    if request:site_name<>""
      var Data:Site rsite :> site request:site_name
      if (request try_site rsite)=success
        leave assign
      var Data:NameHost logical :> name_database:data:host r
      if exists:logical and logical:physical=computer_fullna
        request forward := "tcp://127.0.0.1/client/"+(string
        leave assign
      # try proxy
      if rsite:protocol="proxy" and (request:remote_ip_addre
        if rsite:public_key<>""
          request forward := "zchannel://"+request:site_name
        else
          request forward := "tcp://"+request:site_name+"/cl
        leave assign
      var Str all := request site_name
      while (all eparse any "." any:(var Str domain))
        if site:domain:protocol="proxy" and (request:remote_
          request forward := "tcp://"+request:site_name+"/cl
          leave assign
        all := domain
    each s site
      if s:ip<>"" and (request try_site s)=success
        leave assign
    var Str site_name := request site_name
    if (exists name_database:data:host:site_name) and name_d
      request forward := "tcp://127.0.0.1/client/"+(string n
    # the name was wrong, so fallback to the default site
    if (request try_site site:computer_fullname)=success
      request site_name := computer_fullname
      leave assign
    # no site is matching, so remove all granted rights
    request rights := var Dictionary empty_dictionary
    if request:site_name=computer_fullname or request:site_n
      void
    eif http_proxy_running and (request:stream query "remote
      # secured proxy
      var Pointer:Int port :> http_proxy_ports first request
      if http_proxy_user<>"" and exists:port
        request forward := "zchannel://"+request:site_name+"
        console "+"
      else
        request forward := "tcp://"+request:site_name+"/clie
        console "-"
    else
      request:log trace "no matching site"
      request user_is_admin := false  
  plugin assign_site
  


if database
    var Str lsite := request:stream safe_query "local_site"
    if lsite<>"" and (request:stream safe_query "remote_user
      request site_name := lsite
    if request:site_name<>""
      var Data:Site rsite :> site request:site_name
      if (request try_site rsite)=success
        leave assign
      var Data:NameHost logical :> name_database:data:host r
      if exists:logical and logical:physical=computer_fullna
        request forward := "tcp://127.0.0.1/client/"+(string
        leave assign
      # try proxy
      if rsite:protocol="proxy" and (request:remote_ip_addre
        if rsite:public_key<>""
          request forward := "zchannel://"+request:site_name
        else
          request forward := "tcp://"+request:site_name+"/cl
        leave assign
      var Str all := request site_name
      while (all eparse any "." any:(var Str domain))
        if site:domain:protocol="proxy" and (request:remote_
          request forward := "tcp://"+request:site_name+"/cl
          leave assign
        all := domain
    each s site
      if s:ip<>"" and (request try_site s)=success
        leave assign
    var Str site_name := request site_name
    if (exists name_database:data:host:site_name) and name_d
      request forward := "tcp://127.0.0.1/client/"+(string n
    # the name was wrong, so fallback to the default site
    if (request try_site site:computer_fullname)=success
      request site_name := computer_fullname
      leave assign
    # no site is matching, so remove all granted rights
    request rights := var Dictionary empty_dictionary
    if request:site_name=computer_fullname or request:site_n
      void
    eif http_proxy_running and (request:stream query "remote
      # secured proxy
      var Pointer:Int port :> http_proxy_ports first request
      if http_proxy_user<>"" and exists:port
        request forward := "zchannel://"+request:site_name+"
        console "+"
      else
        request forward := "tcp://"+request:site_name+"/clie
        console "-"
    else
      request:log trace "no matching site"
      request user_is_admin := false  
  plugin assign_site
  


if database
  module "/pliant/appli/database.pli"
  module "/pliant/storage/database.pli"
  module "/pliant/language/data/string_cast.pli"



method request send_dynamic_file filename virtualpath -> sta
  arg_rw HttpRequest request ; arg Str filename virtualpath 
  var Link:DynamicPage sp :> request:server find_dynamic_pag
  if not exists:sp
    var Str err := request:server compile_dynamic_page filen
    if err<>""
      request send_simple_page "Bug in page "+request:path "
      return success
    sp :> request:server find_dynamic_page filename
  if not exists:sp
    return failure
  var Link:DynamicPage dp ; var Str context
  if ("&"+request:form+"&"+request:encoded_options+"=" epars
    button := http_decode button
    context := request uncipher http_decode:scontext false
    signature := http_decode signature
    if (request check_signature button+" "+context signature
      void
    eif { context := request uncipher http_decode:scontext t
      void
    else
      request form := "" ; request encoded_options := ""
      request send_misc_answer "signature"
      return success # wrong signature
    dp :> request:server find_dynamic_page http_decode:butto
    if not exists:dp and (button parse any:(var Str modulena
      pliant_compiler_semaphore request
      pliant_load_module modulename+".pli" the_module:"/plia
      pliant_compiler_semaphore release
      dp :> request:server find_dynamic_page http_decode:but
    if not exists:dp and (button parse any:(var Str modulena
      request:server compile_dynamic_page modulename+".page"
      dp :> request:server find_dynamic_page http_decode:but
    if not exists:dp
      request form := "" ; request encoded_options := ""
      request send_misc_answer "obsolete"
      return success # there is no such button
  else
    dp :> sp
    context := ""
  module "/pliant/language/data/string_cast.pli"



method request send_dynamic_file filename virtualpath -> sta
  arg_rw HttpRequest request ; arg Str filename virtualpath 
  var Link:DynamicPage sp :> request:server find_dynamic_pag
  if not exists:sp
    var Str err := request:server compile_dynamic_page filen
    if err<>""
      request send_simple_page "Bug in page "+request:path "
      return success
    sp :> request:server find_dynamic_page filename
  if not exists:sp
    return failure
  var Link:DynamicPage dp ; var Str context
  if ("&"+request:form+"&"+request:encoded_options+"=" epars
    button := http_decode button
    context := request uncipher http_decode:scontext false
    signature := http_decode signature
    if (request check_signature button+" "+context signature
      void
    eif { context := request uncipher http_decode:scontext t
      void
    else
      request form := "" ; request encoded_options := ""
      request send_misc_answer "signature"
      return success # wrong signature
    dp :> request:server find_dynamic_page http_decode:butto
    if not exists:dp and (button parse any:(var Str modulena
      pliant_compiler_semaphore request
      pliant_load_module modulename+".pli" the_module:"/plia
      pliant_compiler_semaphore release
      dp :> request:server find_dynamic_page http_decode:but
    if not exists:dp and (button parse any:(var Str modulena
      request:server compile_dynamic_page modulename+".page"
      dp :> request:server find_dynamic_page http_decode:but
    if not exists:dp
      request form := "" ; request encoded_options := ""
      request send_misc_answer "obsolete"
      return success # there is no such button
  else
    dp :> sp
    context := ""
  request send_header "mime [dq]text/html; charset=iso-8859-
  if default_charset_is_utf8
    request send_header "mime [dq]text/html; charset=UTF8[dq] datetime "+(string dp:datetime)+" compressed chunked"
  else
    request send_header "mime [dq]text/html; charset=iso-8859-1[dq] datetime "+(string dp:datetime)+" compressed chunked"
  (var HtmlPage page) bind request
  page file_name := dp filename
  page virtual_path := virtualpath
  check dp:function:nb_args=1
  if (dp:function arg 0):type=HtmlPage
    if not page:escape_html_page
      part execute "execute dynamic page "+filename
        page execute_style_setup sp:function
        page begin_end_hook_prototype page:begin_hook
        http_execute_dynamic_page page dp:function
        page begin_end_hook_prototype page:end_hook
    status := shunt request:answer_header_sent success failu
  eif { var Pointer:Type t :> unpointerto (dp:function arg 0
    var Str pc := "" ## section "copy context"
    var Address buf ; buf := memory_allocate t:size null
    t build_instance buf
    for (var Int i) 0 t:nb_fields-1
      var Pointer:TypeField tf :> t field i
      if tf:name="page"
        (buf translate Byte tf:offset) map Address := addres
      eif (tf:properties first "pliant editable")<>null and 
        value := replace (replace value "+" " ") "%0D%0A" "%
        var Str all := "&"+remain
        while (all eparse any (pattern "&"+tf:name+"=") any:
          value += "%%0A"+(replace (replace extra "+" " ") "
          all := "&"+remain
        pc += "&"+tf:name+"="+value
        from_string (buf translate Byte tf:offset) tf:type h
      eif ("&"+context+"&" eparse any (pattern "&"+tf:name+"
        pc += "&"+tf:name+"="+value
        if database and tf:type:is_data
          (buf translate Byte tf:offset) map Data_ := data_r
        else
          from_string (buf translate Byte tf:offset) tf:type
    var Str id := button
    request context_type :> t
    var Int pos_x := 0 ; var Int pos_y := 0
    var Str all := "&"+request:form+"&"
    while (all parse any "&_" any:(var Str variable) "=" any
      if variable="pliant_x"
        value parse pos_x
      eif variable="pliant_y"
        value parse pos_y
      else
        pc += "&_"+variable+"="+value
      all := "&"+remain
    request context := "button*"+string:pos_x+"*"+string:pos
    if not page:escape_html_page
      request:log trace "execute "+dp:position
      part execute "execute dynamic page "+dp:position
        page execute_style_setup sp:function
        page begin_end_hook_prototype page:begin_hook
        http_execute_dynamic_sub_page buf dp:function
        page begin_end_hook_prototype page:end_hook
    t destroy_instance buf
    memory_free buf
    status := shunt request:answer_header_sent success failu
  else
    status := failure
  page unbind
  if status=success and not request:answer_footer_sent
    request send_footer



method request parse_then_answer
  arg_rw HttpRequest request
  implicit request
    user_name := ""
    user_auth_level := 0
    user_shaker := ""
    user_is_admin := false
    site_name := ""
    form := ""
    context := ""
    context_type :> null map Type
    keep_alive_applied := false
    query_log := var List empty_list
    answer_header_sent := false
    answer_footer_sent := false
    answer_extra := var List empty_list
    answer_status := ""
    answer_mime_type := ""
    answer_datetime := undefined
    answer_is_dynamic := true
    answer_size := undefined
    answer_encoding := ""
    answer_chunked := false
    answer_stream :> request stream
    log_mark := request:log mark
  var Pointer:Stream http :> request stream
  part parse "parse HTTP request"
    var Str cmd := http readline ## section "parse_then_answ
    request query_first_line := cmd
    request:log trace "query " cmd
    var Str command protocol
    if (cmd eparse any:command _ (any request:encoded_path) 
      if (request:encoded_path eparse "http://" any "/" any:
        request encoded_path := "/"+remain
      if not (protocol parse word:"HTTP" "/" request:protoco
        request send_empty_answer "400 Bad Request"
        return
      request protocol_level := min request:protocol_level r
    eif (cmd eparse any:command "_" (any request:encoded_pat
      request protocol_level := 0.9
    else
      request send_empty_answer "400 Bad Request"
      return
    request keep_alive_requested := request:protocol_level>=
    if (request:encoded_path parse any:(var Str base) "?" (a
      request encoded_path := base
    else
      request encoded_options := ""
    request command := command
    request path := http_decode request:encoded_path
    request options := http_decode request:encoded_options
    var Int length := undefined
    var CBool chunked := false
    var CBool multipart := false
    var CBool continue := false
    var Int header_length := 0
    var Str tag value
    if request:protocol_level>=1
      while { var Str param := http readline ; param<>"" }
        header_length += param:len+16
        if header_length<request:server:maximal_header_lengt
          request:query_log append addressof:(new Str param)
          request:log trace "option " param
        if (param parse any:tag ":" any:value)
          tag := lower tag
          if tag="host"
            request site_name := value 0 (value search ":" v
          eif tag="content-length"
            if not (value parse length)
              request send_empty_answer "400 Bad Request" ; 
          eif tag="transfer-encoding" and (value parse acwor
            chunked := true
          eif tag="content-type"
            if (value parse acword:"multipart" any acword:"b
              multipart := true ; boundary := "[cr][lf]--"+b
          eif tag="expect"
            if (value parse acword:"100-continue" any)
              continue := true
          eif tag="connection"
            if (value parse any acword:"keep-alive" any)
              if request:server:keep_alive_connections
                request keep_alive_requested := true
            eif (value parse any acword:"close" any)
              request keep_alive_requested := false
          eif tag="user-agent"
            request browser := value
            find_browser_identity request:browser request:br
          eif tag="accept-language"
  (var HtmlPage page) bind request
  page file_name := dp filename
  page virtual_path := virtualpath
  check dp:function:nb_args=1
  if (dp:function arg 0):type=HtmlPage
    if not page:escape_html_page
      part execute "execute dynamic page "+filename
        page execute_style_setup sp:function
        page begin_end_hook_prototype page:begin_hook
        http_execute_dynamic_page page dp:function
        page begin_end_hook_prototype page:end_hook
    status := shunt request:answer_header_sent success failu
  eif { var Pointer:Type t :> unpointerto (dp:function arg 0
    var Str pc := "" ## section "copy context"
    var Address buf ; buf := memory_allocate t:size null
    t build_instance buf
    for (var Int i) 0 t:nb_fields-1
      var Pointer:TypeField tf :> t field i
      if tf:name="page"
        (buf translate Byte tf:offset) map Address := addres
      eif (tf:properties first "pliant editable")<>null and 
        value := replace (replace value "+" " ") "%0D%0A" "%
        var Str all := "&"+remain
        while (all eparse any (pattern "&"+tf:name+"=") any:
          value += "%%0A"+(replace (replace extra "+" " ") "
          all := "&"+remain
        pc += "&"+tf:name+"="+value
        from_string (buf translate Byte tf:offset) tf:type h
      eif ("&"+context+"&" eparse any (pattern "&"+tf:name+"
        pc += "&"+tf:name+"="+value
        if database and tf:type:is_data
          (buf translate Byte tf:offset) map Data_ := data_r
        else
          from_string (buf translate Byte tf:offset) tf:type
    var Str id := button
    request context_type :> t
    var Int pos_x := 0 ; var Int pos_y := 0
    var Str all := "&"+request:form+"&"
    while (all parse any "&_" any:(var Str variable) "=" any
      if variable="pliant_x"
        value parse pos_x
      eif variable="pliant_y"
        value parse pos_y
      else
        pc += "&_"+variable+"="+value
      all := "&"+remain
    request context := "button*"+string:pos_x+"*"+string:pos
    if not page:escape_html_page
      request:log trace "execute "+dp:position
      part execute "execute dynamic page "+dp:position
        page execute_style_setup sp:function
        page begin_end_hook_prototype page:begin_hook
        http_execute_dynamic_sub_page buf dp:function
        page begin_end_hook_prototype page:end_hook
    t destroy_instance buf
    memory_free buf
    status := shunt request:answer_header_sent success failu
  else
    status := failure
  page unbind
  if status=success and not request:answer_footer_sent
    request send_footer



method request parse_then_answer
  arg_rw HttpRequest request
  implicit request
    user_name := ""
    user_auth_level := 0
    user_shaker := ""
    user_is_admin := false
    site_name := ""
    form := ""
    context := ""
    context_type :> null map Type
    keep_alive_applied := false
    query_log := var List empty_list
    answer_header_sent := false
    answer_footer_sent := false
    answer_extra := var List empty_list
    answer_status := ""
    answer_mime_type := ""
    answer_datetime := undefined
    answer_is_dynamic := true
    answer_size := undefined
    answer_encoding := ""
    answer_chunked := false
    answer_stream :> request stream
    log_mark := request:log mark
  var Pointer:Stream http :> request stream
  part parse "parse HTTP request"
    var Str cmd := http readline ## section "parse_then_answ
    request query_first_line := cmd
    request:log trace "query " cmd
    var Str command protocol
    if (cmd eparse any:command _ (any request:encoded_path) 
      if (request:encoded_path eparse "http://" any "/" any:
        request encoded_path := "/"+remain
      if not (protocol parse word:"HTTP" "/" request:protoco
        request send_empty_answer "400 Bad Request"
        return
      request protocol_level := min request:protocol_level r
    eif (cmd eparse any:command "_" (any request:encoded_pat
      request protocol_level := 0.9
    else
      request send_empty_answer "400 Bad Request"
      return
    request keep_alive_requested := request:protocol_level>=
    if (request:encoded_path parse any:(var Str base) "?" (a
      request encoded_path := base
    else
      request encoded_options := ""
    request command := command
    request path := http_decode request:encoded_path
    request options := http_decode request:encoded_options
    var Int length := undefined
    var CBool chunked := false
    var CBool multipart := false
    var CBool continue := false
    var Int header_length := 0
    var Str tag value
    if request:protocol_level>=1
      while { var Str param := http readline ; param<>"" }
        header_length += param:len+16
        if header_length<request:server:maximal_header_lengt
          request:query_log append addressof:(new Str param)
          request:log trace "option " param
        if (param parse any:tag ":" any:value)
          tag := lower tag
          if tag="host"
            request site_name := value 0 (value search ":" v
          eif tag="content-length"
            if not (value parse length)
              request send_empty_answer "400 Bad Request" ; 
          eif tag="transfer-encoding" and (value parse acwor
            chunked := true
          eif tag="content-type"
            if (value parse acword:"multipart" any acword:"b
              multipart := true ; boundary := "[cr][lf]--"+b
          eif tag="expect"
            if (value parse acword:"100-continue" any)
              continue := true
          eif tag="connection"
            if (value parse any acword:"keep-alive" any)
              if request:server:keep_alive_connections
                request keep_alive_requested := true
            eif (value parse any acword:"close" any)
              request keep_alive_requested := false
          eif tag="user-agent"
            request browser := value
            find_browser_identity request:browser request:br
          eif tag="accept-language"
            request lang := value
            value := value 0 (value search "," value:len)
            value := value 0 (value search ";" value:len)
            request language := value
            var Int index := language_index value
            if index<>undefined
              current_thread_header language_index := index
          eif compression and tag="accept-encoding"
            request supported_encoding := shunt (value parse
          eif tag="authorization"
            if (value parse acword:"basic" any:(var Str enco
              var Str auth := base64_decode encoded
              if (auth parse any "\" any:(var Str user) ":" 
                var Data:UserSecret u :> user_secret_databas
                if u:password_md5=string_md5_hexa_signature:
                  request user_name := user
                  request user_auth_level := 1
                  request user_shaker := u shaker
                else
                  sleep 1
            eif false # (value parse acword:"digest" any)
              var Str user := value option "username=" Str
              console "user is: " user eol
              var Str password := "b"
              var Str realm := value option "realm=" Str
              console "realm is: " realm eol
              var Str nonce := value option "nonce=" Str
              console "nonce is: " nonce eol
              var Str uri := value option "uri=" Str
              var Str A1 := user+":"+realm+":"+password
              var Str A2 := "GET:"+uri
              var Str answer := digest digest:A1+":"+nonce+"
              console "signature for "+user+" is: " answer e
              var Str response := value option "response=" S
              if response=answer
                console "YES !" eol
  request browser_walkaround
  request adjust_remote_ip_address
          eif compression and tag="accept-encoding"
            request supported_encoding := shunt (value parse
          eif tag="authorization"
            if (value parse acword:"basic" any:(var Str enco
              var Str auth := base64_decode encoded
              if (auth parse any "\" any:(var Str user) ":" 
                var Data:UserSecret u :> user_secret_databas
                if u:password_md5=string_md5_hexa_signature:
                  request user_name := user
                  request user_auth_level := 1
                  request user_shaker := u shaker
                else
                  sleep 1
            eif false # (value parse acword:"digest" any)
              var Str user := value option "username=" Str
              console "user is: " user eol
              var Str password := "b"
              var Str realm := value option "realm=" Str
              console "realm is: " realm eol
              var Str nonce := value option "nonce=" Str
              console "nonce is: " nonce eol
              var Str uri := value option "uri=" Str
              var Str A1 := user+":"+realm+":"+password
              var Str A2 := "GET:"+uri
              var Str answer := digest digest:A1+":"+nonce+"
              console "signature for "+user+" is: " answer e
              var Str response := value option "response=" S
              if response=answer
                console "YES !" eol
  request browser_walkaround
  request adjust_remote_ip_address
  request style_name := ""
  request style_options := ""
  request assign_user ## section "parse_then_answer user" ; 
  request assign_site ## how "" section "method assign_site"
  if request:forward<>""
    request forward request:forward "Origin-IP: "+(request:s
    return
  if continue
    request send_empty_answer "100 Continue"
  request:query_stream :> new Stream
  if length<>undefined
    request:query_stream open "count:" "size "+string:length
  eif chunked
    request:query_stream open "chunked:" "" in+safe pliant_d
  else
    request:query_stream open "count:" "size 0" in+safe plia
  if database
    data_login request:user_name
  plugin answer_begin
  part answer "site '"+request:site_name+"' user '"+request:
    if not (request allowed "read") and not (report_load_sta
      if request:user_name=""
        request send_authentification_request
      else
        request send_misc_answer "not_allowed"
        request:log trace "requested a not allowed page " re
      leave answer
    if request:style_name<>""
      compile_style request:style_name
    if command="GET"
      if query_mime_type:(request:path (request:path search_
        if (request send_static_file (request what_file requ
          leave answer
      if (request send_dynamic_answer request:path)=success
        leave answer
      if (request:path request:path:len-1)<>"/"
        var FileInfo info := file_query (request what_file r
        if info=defined and info:is_directory and request:pr
          request send_redirect_answer "http://"+(shunt requ
          leave answer
      var Str filename := request site_default
      filename := (filename 0 (filename search_last "." file
      if (request send_dynamic_file filename request:path)=f
        request:log trace "requested an unknown page " reque
        request send_simple_page "Not found" "" "The request
    eif command="POST" ## section "parse_then_answer POST"
      if not multipart
        part read_form "read HTTP form"
          var Address buffer := null ; var Int done := 0
          while not request:query_stream:atend and done<requ
            request:query_stream read_available (var Address
            buffer := memory_resize buffer done+size null
            memory_copy adr (buffer translate Byte done) siz
            done += size
          request:form set buffer done true
      else
        part parse_multipart_form "parse HTTP multipart form
          request form := ""
          var Int avail := request:server:maximal_form_lengt
          var Int avail2 := request:server:maximal_file_leng
          part multi
            while not request:query_stream:atend
              var Str value
              var Str label := "" ; var Str filename := ""
              while { var Str line := request:query_stream r
                if not (line parse any word:"name" "=" "[dq]
                  line parse any word:"name" "=" "[dq]" any:
                  line parse any word:"filename" "=" "[dq]" 
              if (label parse word:"file" _ word:"upload" _ 
                label := label2
                var Str temp := file_temporary
                var Str name := replace filename "\" "/"
                name := name (name search_last "/" -1)+1 nam
                value := string:temp+" remote_path "+string:
                request:temp_files append addressof:(new Str
                (var Stream data) open value out+safe
                var Str cache := "[cr][lf]" ; var Int drop :
                while cache:len<boundary:len and not request
                  if cache:len=0
                    var Address a := memory_search request:q
                    if a=null
                      a := request:query_stream stream_read_
                    var Int step := (cast a Int).-.(cast req
                    data raw_write request:query_stream:stre
                    request:query_stream stream_read_cur := 
                  request:query_stream raw_read addressof:(v
                  while cache<>(boundary 0 cache:len)
                    if drop=0
                      data raw_write cache:characters 1 ; av
                    else
                      drop -= 1
                    cache := cache 1 cache:len
                  if avail2<0
                    request send_empty_answer "413 Request E
                data close
                request:log trace "file upload " value " -> 
              else
                value := ""
                var Str cache := ""
                while not request:query_stream:atend and cac
                  if cache:len=0
                    var Address a := memory_search request:q
                    if a=null
                      a := request:query_stream stream_read_
                    var Int step := (cast a Int).-.(cast req
                    (var Str temp) set request:query_stream:
                    value += temp ; avail -= step
                    request:query_stream stream_read_cur := 
                  request:query_stream raw_read addressof:(v
                  while cache<>(boundary 0 cache:len)
                    (var Str temp) set cache:characters 1 fa
                    value += temp ; avail -= 1
                    cache := cache 1 cache:len
                  if avail<0
                    request send_empty_answer "413 Request E
              request form += "&"+http_encode:label+"="+http
              request:query_stream raw_read addressof:(var C
              request:query_stream readline
              if ch="-"
                leave multi
      request:log trace "form " request:form
      request send_dynamic_answer request:path
    eif report_load_statistics and command="REPORT_LOAD_STAT
      var Str all := request path
      var Str answer := ""
      while all<>""
        if (all parse "cpu" (var Float seconds) any:(var Str
          answer += " cpu "+string:seconds+" "+(string cpu_s
        eif (all parse "interrupts" (var Float seconds) any:
          answer += " interrupts "+string:seconds+" "+(strin
        eif (all parse "net" (var Str device) (var Float sec
          net_statistics device seconds (var Float in_bps) (
          answer += " net "+string:device+" "+string:seconds
        eif (all parse "disk" (var Str device) (var Float se
          disk_statistics device seconds (var Float read_bps
          answer += " disk "+string:device+" "+string:second
  request assign_user ## section "parse_then_answer user" ; 
  request assign_site ## how "" section "method assign_site"
  if request:forward<>""
    request forward request:forward "Origin-IP: "+(request:s
    return
  if continue
    request send_empty_answer "100 Continue"
  request:query_stream :> new Stream
  if length<>undefined
    request:query_stream open "count:" "size "+string:length
  eif chunked
    request:query_stream open "chunked:" "" in+safe pliant_d
  else
    request:query_stream open "count:" "size 0" in+safe plia
  if database
    data_login request:user_name
  plugin answer_begin
  part answer "site '"+request:site_name+"' user '"+request:
    if not (request allowed "read") and not (report_load_sta
      if request:user_name=""
        request send_authentification_request
      else
        request send_misc_answer "not_allowed"
        request:log trace "requested a not allowed page " re
      leave answer
    if request:style_name<>""
      compile_style request:style_name
    if command="GET"
      if query_mime_type:(request:path (request:path search_
        if (request send_static_file (request what_file requ
          leave answer
      if (request send_dynamic_answer request:path)=success
        leave answer
      if (request:path request:path:len-1)<>"/"
        var FileInfo info := file_query (request what_file r
        if info=defined and info:is_directory and request:pr
          request send_redirect_answer "http://"+(shunt requ
          leave answer
      var Str filename := request site_default
      filename := (filename 0 (filename search_last "." file
      if (request send_dynamic_file filename request:path)=f
        request:log trace "requested an unknown page " reque
        request send_simple_page "Not found" "" "The request
    eif command="POST" ## section "parse_then_answer POST"
      if not multipart
        part read_form "read HTTP form"
          var Address buffer := null ; var Int done := 0
          while not request:query_stream:atend and done<requ
            request:query_stream read_available (var Address
            buffer := memory_resize buffer done+size null
            memory_copy adr (buffer translate Byte done) siz
            done += size
          request:form set buffer done true
      else
        part parse_multipart_form "parse HTTP multipart form
          request form := ""
          var Int avail := request:server:maximal_form_lengt
          var Int avail2 := request:server:maximal_file_leng
          part multi
            while not request:query_stream:atend
              var Str value
              var Str label := "" ; var Str filename := ""
              while { var Str line := request:query_stream r
                if not (line parse any word:"name" "=" "[dq]
                  line parse any word:"name" "=" "[dq]" any:
                  line parse any word:"filename" "=" "[dq]" 
              if (label parse word:"file" _ word:"upload" _ 
                label := label2
                var Str temp := file_temporary
                var Str name := replace filename "\" "/"
                name := name (name search_last "/" -1)+1 nam
                value := string:temp+" remote_path "+string:
                request:temp_files append addressof:(new Str
                (var Stream data) open value out+safe
                var Str cache := "[cr][lf]" ; var Int drop :
                while cache:len<boundary:len and not request
                  if cache:len=0
                    var Address a := memory_search request:q
                    if a=null
                      a := request:query_stream stream_read_
                    var Int step := (cast a Int).-.(cast req
                    data raw_write request:query_stream:stre
                    request:query_stream stream_read_cur := 
                  request:query_stream raw_read addressof:(v
                  while cache<>(boundary 0 cache:len)
                    if drop=0
                      data raw_write cache:characters 1 ; av
                    else
                      drop -= 1
                    cache := cache 1 cache:len
                  if avail2<0
                    request send_empty_answer "413 Request E
                data close
                request:log trace "file upload " value " -> 
              else
                value := ""
                var Str cache := ""
                while not request:query_stream:atend and cac
                  if cache:len=0
                    var Address a := memory_search request:q
                    if a=null
                      a := request:query_stream stream_read_
                    var Int step := (cast a Int).-.(cast req
                    (var Str temp) set request:query_stream:
                    value += temp ; avail -= step
                    request:query_stream stream_read_cur := 
                  request:query_stream raw_read addressof:(v
                  while cache<>(boundary 0 cache:len)
                    (var Str temp) set cache:characters 1 fa
                    value += temp ; avail -= 1
                    cache := cache 1 cache:len
                  if avail<0
                    request send_empty_answer "413 Request E
              request form += "&"+http_encode:label+"="+http
              request:query_stream raw_read addressof:(var C
              request:query_stream readline
              if ch="-"
                leave multi
      request:log trace "form " request:form
      request send_dynamic_answer request:path
    eif report_load_statistics and command="REPORT_LOAD_STAT
      var Str all := request path
      var Str answer := ""
      while all<>""
        if (all parse "cpu" (var Float seconds) any:(var Str
          answer += " cpu "+string:seconds+" "+(string cpu_s
        eif (all parse "interrupts" (var Float seconds) any:
          answer += " interrupts "+string:seconds+" "+(strin
        eif (all parse "net" (var Str device) (var Float sec
          net_statistics device seconds (var Float in_bps) (
          answer += " net "+string:device+" "+string:seconds
        eif (all parse "disk" (var Str device) (var Float se
          disk_statistics device seconds (var Float read_bps
          answer += " disk "+string:device+" "+string:second
        eif (all parse "trouble" any:(var Str remain))
          var CBool raid_alarm := false
          (var Stream proc) open "file:/proc/mdstat" in+safe
          while not proc:atend
            var Str l := proc readline
            if (reverse:l parse any "[rb]" any:(var Str disks) "[lb]" "[rb]" any "/" any "[lb]" any)
              if disks<>(repeat disks:len "U")
                raid_alarm := true
          var CBool filesystem_alarm := false
          (var Stream proc) open "file:/proc/mounts" in+safe
          while not proc:atend
            var Str l := proc readline
            if (l parse any _ any _ any:(var Str fs) _ any:(var Str mode) _ any)
              if (","+mode+"," search ",ro," -1)<>(-1) and (fs parse "ext" any)
                filesystem_alarm := true
          proc close
          answer += " trouble "+string:(shunt filesystem_alarm "Disk alarm" raid_alarm "RAID alarm" "")
        else
          remain := ""
        all := remain
      request send_empty_answer "200"+answer
    else
      var Str virtualpage := reverse request:path
      var Str virtualpath := ""
      while (virtualpage eparse any:(var Str extra) "/" any:
        virtualpath := "/"+reverse:extra+virtualpath
        var Str virtualfile := request what_file reverse:bas
        if (request send_dynamic_file virtualfile virtualpat
          leave answer
        virtualpage := base
      request send_empty_answer "501 Not Implemented"
  if database
    data_logout
  plugin answer_end



export '. temporary_cleanup'
export '. send_static_file' '. execute_dynamic_page' '. do_c
export '. find_dynamic_page'
export '. forward'
        else
          remain := ""
        all := remain
      request send_empty_answer "200"+answer
    else
      var Str virtualpage := reverse request:path
      var Str virtualpath := ""
      while (virtualpage eparse any:(var Str extra) "/" any:
        virtualpath := "/"+reverse:extra+virtualpath
        var Str virtualfile := request what_file reverse:bas
        if (request send_dynamic_file virtualfile virtualpat
          leave answer
        virtualpage := base
      request send_empty_answer "501 Not Implemented"
  if database
    data_logout
  plugin answer_end



export '. temporary_cleanup'
export '. send_static_file' '. execute_dynamic_page' '. do_c
export '. find_dynamic_page'
export '. forward'