Patch title: Release 91 bulk changes
Abstract:
File: /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



submodule "/pliant/protocol/common/tcp_server.pli"
module "/pliant/protocol/common/misc.pli"
module "/pliant/protocol/common/mime.pli"
abstract
  [Pliant HTTP server implementation, according to RFC2616] 
  [This implementation also contains a very powerfull mecani



submodule "/pliant/protocol/common/tcp_server.pli"
module "/pliant/protocol/common/misc.pli"
module "/pliant/protocol/common/mime.pli"
module "/pliant/language/schedule/resourcesem.pli"
module "/pliant/fullpliant/user.pli"
module "/pliant/fullpliant/login.pli"
module "site.pli"


public
  type HttpServer
    tcp_server_fields "HTTP" 80
    # server configuration
    field CBool dynamic_auto_recompile <- true
    field Float dynamic_page_recheck_delay <- 5
    field Str log
    # HTTP protocol configuration
    if conservative
      field Float protocol_level <- 1.0 
    else
      field Float protocol_level <- 1.1 
    field CBool keep_alive_connections <- true
module "/pliant/fullpliant/user.pli"
module "/pliant/fullpliant/login.pli"
module "site.pli"


public
  type HttpServer
    tcp_server_fields "HTTP" 80
    # server configuration
    field CBool dynamic_auto_recompile <- true
    field Float dynamic_page_recheck_delay <- 5
    field Str log
    # HTTP protocol configuration
    if conservative
      field Float protocol_level <- 1.0 
    else
      field Float protocol_level <- 1.1 
    field CBool keep_alive_connections <- true
    field Float keep_alive_timeout <- 120
    field Float keep_alive_maxi_timeout <- 120
    field Float keep_alive_mini_timeout <- 2
    # security issues
    field CBool send_software_release_number <- true
    field Int maximal_header_length <- 2^20
    field Int maximal_form_length <- 2^20
    field Int maximal_file_length <- 2^30
    # statistics
    field Intn hits_count <- 0
    field Intn bytes_count <- 0
    field Sem hits_sem


public
  type HttpRequest
    field Link:Stream stream
    field Link:HttpServer server
    field Float protocol_level
    field CBool keep_alive_requested
    field CBool keep_alive_applied
    # security issues
    field CBool send_software_release_number <- true
    field Int maximal_header_length <- 2^20
    field Int maximal_form_length <- 2^20
    field Int maximal_file_length <- 2^30
    # statistics
    field Intn hits_count <- 0
    field Intn bytes_count <- 0
    field Sem hits_sem


public
  type HttpRequest
    field Link:Stream stream
    field Link:HttpServer server
    field Float protocol_level
    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 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


method page escape_html_page -> escape
  arg_rw HtmlPage page ; arg CBool escape
  escape := false
  var Pointer:HttpRequest request :> page http_request
  if database
    data_login request:user_name
    var Pointer:Str form :> request form
    var Int offset := 0
    while offset<form:len
      var Int stop := ((form offset form:len) search "&" for
      if((form offset stop-offset) parse any:(var Str name) 
        if (http_decode:name parse "data/" any:(var Str sign
    #
    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 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


method page escape_html_page -> escape
  arg_rw HtmlPage page ; arg CBool escape
  escape := false
  var Pointer:HttpRequest request :> page http_request
  if database
    data_login request:user_name
    var Pointer:Str form :> request form
    var Int offset := 0
    while offset<form:len
      var Int stop := ((form offset form:len) search "&" for
      if((form offset stop-offset) parse any:(var Str name) 
        if (http_decode:name parse "data/" any:(var Str sign
          path := "/"+(replace (replace path "(" "&#") ")" "
          path := "/"+(replace (replace (replace path "+" " ") "(" "&#") ")" ";")
          value := replace http_decode:(replace value "+" " 
          if (request check_signature path sign)=success
            var Data_ data := data_root search_path path fal
            data:base:sem request
            var Status status := data:interface set data add
            data:base:sem release
            page:http_request:log trace "database set " path
          else
            page:http_request:log trace "rejected database s
            # FIXME (page:env kmap "default data rejected" L
      offset := stop+1
  if request:form<>""
    if request:temp_files:first=null and (not (exists reques
      page reset_http_answer
      request send_redirect_answer request:encoded_path+"?"+
      return true


method server service http
  arg_rw HttpServer server ; arg_rw Stream http
  http line_limit := server maximal_header_length
  var HttpRequest request
  request server :> server
          value := replace http_decode:(replace value "+" " 
          if (request check_signature path sign)=success
            var Data_ data := data_root search_path path fal
            data:base:sem request
            var Status status := data:interface set data add
            data:base:sem release
            page:http_request:log trace "database set " path
          else
            page:http_request:log trace "rejected database s
            # FIXME (page:env kmap "default data rejected" L
      offset := stop+1
  if request:form<>""
    if request:temp_files:first=null and (not (exists reques
      page reset_http_answer
      request send_redirect_answer request:encoded_path+"?"+
      return true


method server service http
  arg_rw HttpServer server ; arg_rw Stream http
  http line_limit := server maximal_header_length
  var HttpRequest request
  request server :> server
  tcp_resource query (var Int current) (var Int maxi)
  request keep_alive_timeout := max server:keep_alive_maxi_timeout*(maxi-current)/maxi server:keep_alive_mini_timeout
  request:log bind http_trace
  var Str id := generate_id
  request:log trace "connection "+id+" start at " datetime "
  request stream :> http
  var CBool first := true
  part one_request
    if http=failure
      leave one_request
    var CBool ae
    part wait "wait for "+(shunt first "first" "next")+" HTT
      if first
        ae := http atend
      else
  request:log bind http_trace
  var Str id := generate_id
  request:log trace "connection "+id+" start at " datetime "
  request stream :> http
  var CBool first := true
  part one_request
    if http=failure
      leave one_request
    var CBool ae
    part wait "wait for "+(shunt first "first" "next")+" HTT
      if first
        ae := http atend
      else
        http safe_configure "timeout "+(string server:keep_a
        http safe_configure "timeout "+(string request:keep_alive_timeout)
        ae := http atend
        http safe_configure "timeout ?"
    if ae
      leave one_request
    if not first
      request:log trace "connection "+id+" restart at " date
    request parse_then_answer
    request:log flush
    if request:keep_alive_applied
      http flush async
        ae := http atend
        http safe_configure "timeout ?"
    if ae
      leave one_request
    if not first
      request:log trace "connection "+id+" restart at " date
    request parse_then_answer
    request:log flush
    if request:keep_alive_applied
      http flush async
      http safe_configure "timeout "+(string server:keep_ali
      http safe_configure "timeout "+(string request:keep_alive_timeout)
      while not request:query_stream:atend
        request:query_stream read_available (var Address adr
      first := false
      restart one_request
  request temporary_cleanup
  request:log trace "connection "+id+" stop at " datetime " 



method page execute_dynamic_page path -> status
  arg_rw HtmlPage page ; arg Str path ; arg ExtendedStatus s
  var Pointer:HttpRequest request :> page:http_request
  var Pointer:HttpServer server :> request:server
  var Str path2 filename
  if (path 0 1)<>"/" and (path search ":" -1)=(-1)
    path2 := (request:path 0 (request:path search_last "/" -
  else
    path2 := path
  if (path2 eparse "pliant:" any:(var Str remain))
    filename := remain
  eif (path2 search ":" -1)<>(-1)
    filename := path2
  else
    filename := request what_file path2
  var Str ext := filename (filename search_last "." filename
  if ext=".html"
    filename := (filename 0 (filename search_last "." filena
  var Link:DynamicPage dp :> server find_dynamic_page filena
  if not exists:dp
    var Str err := server compile_dynamic_page filename
    if err=""
      dp :> server find_dynamic_page filename
  var Str rpath := reverse path2
  var Str virtualpath := ""
  while not exists:dp and (rpath eparse any:(var Str rextra)
    virtualpath := "/"+reverse:rextra+virtualpath
    var Str filename := request what_file reverse:rbase+"/vi
    var Link:DynamicPage dp :> server find_dynamic_page file
    if not exists:dp
      if (server compile_dynamic_page filename)=""
        dp :> server find_dynamic_page filename
    rpath := rbase
  if not exists:dp or dp:function:nb_args<>1 or (dp:function
    return failure:err
      while not request:query_stream:atend
        request:query_stream read_available (var Address adr
      first := false
      restart one_request
  request temporary_cleanup
  request:log trace "connection "+id+" stop at " datetime " 



method page execute_dynamic_page path -> status
  arg_rw HtmlPage page ; arg Str path ; arg ExtendedStatus s
  var Pointer:HttpRequest request :> page:http_request
  var Pointer:HttpServer server :> request:server
  var Str path2 filename
  if (path 0 1)<>"/" and (path search ":" -1)=(-1)
    path2 := (request:path 0 (request:path search_last "/" -
  else
    path2 := path
  if (path2 eparse "pliant:" any:(var Str remain))
    filename := remain
  eif (path2 search ":" -1)<>(-1)
    filename := path2
  else
    filename := request what_file path2
  var Str ext := filename (filename search_last "." filename
  if ext=".html"
    filename := (filename 0 (filename search_last "." filena
  var Link:DynamicPage dp :> server find_dynamic_page filena
  if not exists:dp
    var Str err := server compile_dynamic_page filename
    if err=""
      dp :> server find_dynamic_page filename
  var Str rpath := reverse path2
  var Str virtualpath := ""
  while not exists:dp and (rpath eparse any:(var Str rextra)
    virtualpath := "/"+reverse:rextra+virtualpath
    var Str filename := request what_file reverse:rbase+"/vi
    var Link:DynamicPage dp :> server find_dynamic_page file
    if not exists:dp
      if (server compile_dynamic_page filename)=""
        dp :> server find_dynamic_page filename
    rpath := rbase
  if not exists:dp or dp:function:nb_args<>1 or (dp:function
    return failure:err
  var Str memo_path := request path ; request path := path
  # var Str memo_path := request path ; request path := path
  var Str memo_file_name := page file_name ; page file_name 
  var Str memo_virtual_path := page virtual_path ; page virt
  page execute_style_setup dp:function
  http_execute_dynamic_page page dp:function
  var Str memo_file_name := page file_name ; page file_name 
  var Str memo_virtual_path := page virtual_path ; page virt
  page execute_style_setup dp:function
  http_execute_dynamic_page page dp:function
  request path := memo_path
  # request path := memo_path
  page file_name := memo_file_name
  page virtual_path := memo_virtual_path
  status := success

export '. temporary_cleanup'
export '. send_static_file' '. execute_dynamic_page' '. do_c
export '. find_dynamic_page'
export '. forward'
  page file_name := memo_file_name
  page virtual_path := memo_virtual_path
  status := success

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