Patch title: Release 85 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



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/data/string_cast.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"
abstract
  [Pliant HTTP server implementation, according to RFC2616] 
  [This implementation also contains a very powerfull mecani



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/data/string_cast.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 DynamicPage
  field Str filename position
  field DateTime datetime
  field DateTime checkedat
  field CBool changed
  field Link:Function function
  field Link:Type type
type DynamicPage
  field Str filename position
  field DateTime datetime
  field DateTime checkedat
  field CBool changed
  field Link:Function function
  field Link:Type type

private
# dynamic pages issues
gvar Dictionary dynamic_pages
gvar Sem dynamic_pages_sem



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
# dynamic pages issues
gvar Dictionary dynamic_pages
gvar Sem dynamic_pages_sem



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
    field Str protocol_level <- "1.0"
    field Float protocol_level <- 1.1
    field CBool keep_alive_connections <- true
    field Float keep_alive_timeout <- 120
    # 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
    # configuration issues
    field CBool configure <- false
    field Str admin_user
    field Str admin_password
    field Str simulate
    # 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_applyed
    #
    field Str url_path
    field Str url_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 area_mode
    field Str style_name
    field Str style_options
    field Str forward
    field Dictionary rights
    #
    field CBool keep_alive_connections <- true
    field Float keep_alive_timeout <- 120
    # 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
    # configuration issues
    field CBool configure <- false
    field Str admin_user
    field Str admin_password
    field Str simulate
    # 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_applyed
    #
    field Str url_path
    field Str url_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 area_mode
    field Str style_name
    field Str style_options
    field Str forward
    field Dictionary rights
    #
    field Str query_first_line
    field List query_log
    field CBool answered
    field Str answer_status           # status message that 
    field Str answer_mime_type
    field Str answer_encoding
    field Int answer_size
    field DateTime answer_datetime
    field CBool answer_is_dynamic
    field List answer_extra
    field List temp_files
    field List query_log
    field CBool answered
    field Str answer_status           # status message that 
    field Str answer_mime_type
    field Str answer_encoding
    field Int answer_size
    field DateTime answer_datetime
    field CBool answer_is_dynamic
    field List answer_extra
    field List temp_files
    field Str put_file
    field Str command
    field TraceSession log
    field Address log_mark


public
  type HtmlPage
    field Link:Stream http_stream
    field TraceSession log
    field Address log_mark


public
  type HtmlPage
    field Link:Stream http_stream
    field Dictionary tags
    field Link:Function text_hook
    field Link:Function html_hook
    field Pointer:HttpRequest http_request
    # styling
    field HtmlStack html_stack
    field Dictionary environment
    field Link:Function html_hook text_hook begin_hook end_hook
    # informations from the HTTP request
    field Str file_name
    field Str virtual_path
    field Str options                 # decoded options
    field Str file_name
    field Str virtual_path
    field Str options                 # decoded options
    field Dictionary styles
    # http protocol related informations
    field Pointer:HttpRequest http_request
    field CBool read_only_mode <- false
    # fields reserved for styles
    field Int do_not_use_Int <- 0
    field Arrow do_not_use_Arrow
    field Int you_can_use_Int <- undefined
    field Arrow you_can_use_Arrow
    field Dictionary env              # you can store applic



method request assign_user
  arg_rw HttpRequest request
  var Str ruser := request:stream safe_query "remote_user"
  var Str ip := request:stream query "remote_ip_address"
  if ruser<>""
    request user_name := ruser
    request user_auth_level := 3
    if compression and (request:stream safe_query "encoding"
      request supported_encoding := ""
  request rights := var Dictionary empty_dictionary
  var Str rights
  if request:user_is_admin
    rights := " administrator"
  else
    rights := ""
    for (var Int lap) (shunt request:user_name<>"" 1 0) 0 st
      var Data:User u :> user (shunt lap=0 "anonymous" reque
      if u:style_options<>""



method request assign_user
  arg_rw HttpRequest request
  var Str ruser := request:stream safe_query "remote_user"
  var Str ip := request:stream query "remote_ip_address"
  if ruser<>""
    request user_name := ruser
    request user_auth_level := 3
    if compression and (request:stream safe_query "encoding"
      request supported_encoding := ""
  request rights := var Dictionary empty_dictionary
  var Str rights
  if request:user_is_admin
    rights := " administrator"
  else
    rights := ""
    for (var Int lap) (shunt request:user_name<>"" 1 0) 0 st
      var Data:User u :> user (shunt lap=0 "anonymous" reque
      if u:style_options<>""
        request style_options += " "+u:style_options
        request style_options += "[lf]"+u:style_options
      each r u:right
        if (string request:user_auth_level)>=r:auth and (ip 
          request:rights kmap r:right CBool := true
          if r:right="administrator"
            request user_is_admin := true
          rights += " "+r:right
  request:log trace "user " request:user_name " " request:us
  if request:user_name<>""
    if not (login_record request:user_name ip (shunt request
      request user_name := ""
      request user_auth_level := 0
      request rights := var Dictionary empty_dictionary  
  plugin assign_user

method request try_site site simulate -> status
  arg_rw HttpRequest request ; arg Data:Site site ; arg CBoo
  if not exists:site
    return failure
  if not simulate
    if site:computer<>computer_fullname and site:computer<>"
      return failure
    var Str ip := request:stream query "local_ip_address"
    if ip<>"" and site:ip<>ip and site:ip<>""
      return failure
    if ((request:stream query "local_ip_port") parse (var In
      return failure
  if site:protocol<>"" and site:protocol<>"HTTP"
    return failure
      each r u:right
        if (string request:user_auth_level)>=r:auth and (ip 
          request:rights kmap r:right CBool := true
          if r:right="administrator"
            request user_is_admin := true
          rights += " "+r:right
  request:log trace "user " request:user_name " " request:us
  if request:user_name<>""
    if not (login_record request:user_name ip (shunt request
      request user_name := ""
      request user_auth_level := 0
      request rights := var Dictionary empty_dictionary  
  plugin assign_user

method request try_site site simulate -> status
  arg_rw HttpRequest request ; arg Data:Site site ; arg CBoo
  if not exists:site
    return failure
  if not simulate
    if site:computer<>computer_fullname and site:computer<>"
      return failure
    var Str ip := request:stream query "local_ip_address"
    if ip<>"" and site:ip<>ip and site:ip<>""
      return failure
    if ((request:stream query "local_ip_port") parse (var In
      return failure
  if site:protocol<>"" and site:protocol<>"HTTP"
    return failure
  if site:from_ip<>"" and not ((request:stream query "remote_ip_address") is_inside_ip_domain site:from_ip)
    return failure
  var Str url_path := request url_path
  if url_path:len>0 and (url_path url_path:len-1)="/"
    url_path += "index.html"
  var Str ext := url_path
  ext := ext (ext search_last "/" -1)+1 ext:len
  ext := ext (ext search_last "." ext:len) ext:len
  request:log trace "site is " keyof:site
  if not (url_path parse "/common/" any)
    request area_path := "/"
    request area_root := site root
  if site:style<>"/pliant/protocol/http/style/default.style"
    request style_name := site style
  request forward := site forward
  var Int longuest := 0
  var Data:SiteArea area
  each a site:area
    var Str p := a path ; var Str e := a extension
    if (url_path 0 p:len)=p and (e=ext or e="")
      var Int l := p:len+(shunt e=ext 10^9 0)
      if l>longuest
        area :> a
        longuest := l
      eif l=longuest
        area :> var Data:SiteArea nonexisting_area
  request area_mode := area mode
  if (request allowed area:read)
    request:rights kmap "read" Bool := true
  if (request allowed area:write)
    request:rights kmap "write" Bool := true
  if area:root<>""
    p := area path
    p := p 0 (p search_last "/" p:len)+1
    request area_path := p
    request area_root := area root
  if area:style<>""
    request style_name := area style
  if area:style_options<>""
  var Str url_path := request url_path
  if url_path:len>0 and (url_path url_path:len-1)="/"
    url_path += "index.html"
  var Str ext := url_path
  ext := ext (ext search_last "/" -1)+1 ext:len
  ext := ext (ext search_last "." ext:len) ext:len
  request:log trace "site is " keyof:site
  if not (url_path parse "/common/" any)
    request area_path := "/"
    request area_root := site root
  if site:style<>"/pliant/protocol/http/style/default.style"
    request style_name := site style
  request forward := site forward
  var Int longuest := 0
  var Data:SiteArea area
  each a site:area
    var Str p := a path ; var Str e := a extension
    if (url_path 0 p:len)=p and (e=ext or e="")
      var Int l := p:len+(shunt e=ext 10^9 0)
      if l>longuest
        area :> a
        longuest := l
      eif l=longuest
        area :> var Data:SiteArea nonexisting_area
  request area_mode := area mode
  if (request allowed area:read)
    request:rights kmap "read" Bool := true
  if (request allowed area:write)
    request:rights kmap "write" Bool := true
  if area:root<>""
    p := area path
    p := p 0 (p search_last "/" p:len)+1
    request area_path := p
    request area_root := area root
  if area:style<>""
    request style_name := area style
  if area:style_options<>""
    request style_options += " "+area:style_options 
    request style_options := area:style_options+"[lf]"+request:style_options
  if site:style_options<>""
  if site:style_options<>""
    request style_options += " "+site:style_options
    request style_options := site:style_options+"[lf]"+request:style_options
  if area:forward<>""
    request forward := area forward
  status := success

method request assign_site
  arg_rw HttpRequest request
  if (request:url_path parse "/common/" any)
    request area_path := "/common/"
    request area_root := "/pliant/protocol/http/common/"
  else
    request area_path := "/"
    request area_root := "/"
  part assign
    request area_mode := ""
    request style_name := ""
    request style_options := ""
    var Str lsite := request:stream safe_query "local_site"
    if lsite<>""
      request site_name := lsite
    var CBool simulate := false
    if request:site_name="localhost"
      if request:server:configure
        leave assign
      if request:server:simulate<>""
        request site_name := request:server:simulate
        simulate := true
    if request:site_name<>""
      var Data:Site rsite :> site request:site_name
      if (request try_site rsite simulate)=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
  if area:forward<>""
    request forward := area forward
  status := success

method request assign_site
  arg_rw HttpRequest request
  if (request:url_path parse "/common/" any)
    request area_path := "/common/"
    request area_root := "/pliant/protocol/http/common/"
  else
    request area_path := "/"
    request area_root := "/"
  part assign
    request area_mode := ""
    request style_name := ""
    request style_options := ""
    var Str lsite := request:stream safe_query "local_site"
    if lsite<>""
      request site_name := lsite
    var CBool simulate := false
    if request:site_name="localhost"
      if request:server:configure
        leave assign
      if request:server:simulate<>""
        request site_name := request:server:simulate
        simulate := true
    if request:site_name<>""
      var Data:Site rsite :> site request:site_name
      if (request try_site rsite simulate)=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:stream query "remote_ip_address") is_inside_ip_domain rsite:from_ip)
        if rsite:public_key<>""
          request forward := "zchannel://"+request:site_name+"/site/80/"+computer_fullname
        else
          request forward := "tcp://"+request:site_name+"/client/80"
        leave assign
      var Str all := request site_name
      while (all eparse any "." any:(var Str domain))
        if site:domain:protocol="proxy" and ((request:stream query "remote_ip_address") is_inside_ip_domain site:domain:from_ip)
          request forward := "tcp://"+request:site_name+"/client/80"
          leave assign
        all := domain
    each s site
      if s:ip<>"" and (request try_site s false)=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 false)=succe
      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
  


    each s site
      if s:ip<>"" and (request try_site s false)=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 false)=succe
      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
  


method p html_hook_prototype html fun
  arg_rw HtmlPage p ; arg Str html ; arg Function fun
  indirect


method p default_text_handler text html_encoded
  arg_rw HtmlPage p ; arg Str text ; arg CBool html_encoded
  var Str t
  if html_encoded
    t set text:characters text:len false # same a t := text
  else
    t := html_encode text true
  if (p:do_not_use_Int .and. 1)<>0
    t := replace t " " "&nbsp;"
  p:http_stream writechars t
method p text_hook_prototype text fun
  arg_rw HtmlPage p ; arg Str text ; arg Function fun
  indirect
  # the text must be HTML encoded


method p text_hook_prototype text html_encoded fun
  arg_rw HtmlPage p ; arg Str text ; arg CBool html_encoded 
method p begin_end_hook_prototype fun
  arg_rw HtmlPage p ; arg Function fun
  indirect

  indirect

method p text text

method p default_html_hook text
  arg_rw HtmlPage p ; arg Str text
  arg_rw HtmlPage p ; arg Str text
  p text_hook_prototype text false p:text_hook
  p:http_stream writechars text



method p default_html_handler text
method p default_text_hook text
  arg_rw HtmlPage p ; arg Str text
  p:http_stream writechars text

  arg_rw HtmlPage p ; arg Str text
  p:http_stream writechars text

method p html_hook_prototype text fun
  arg_rw HtmlPage p ; arg Str text ; arg Function fun
  indirect
method p default_begin_end_hook
  arg_rw HtmlPage p



#---------------------------------------------------------------------------


method p html html
  arg_rw HtmlPage p ; arg Str html
  p html_hook_prototype html p:html_hook

method p html html
  arg_rw HtmlPage p ; arg Str html
  p html_hook_prototype html p:html_hook

export '. text' '. html'
method p text text
  arg_rw HtmlPage p ; arg Str text
  p text_hook_prototype (html_encode text true) p:text_hook


export '. html' '. text'



method p html_encoded_text text
  arg_rw HtmlPage p ; arg Str text
method p html_encoded_text text
  arg_rw HtmlPage p ; arg Str text
  p text_hook_prototype text true p:text_hook
  p text_hook_prototype text p:text_hook




method p execute_style_setup_prototype options fun
  arg_rw HtmlPage p ; arg Str options ; arg Function fun
method p execute_style_bloc_prototype fun
  arg_rw HtmlPage p ; arg Function fun
  indirect

  indirect

method p execute_style_setup_prototype fun
  arg_rw HtmlPage p ; arg Function fun
  indirect

method p execute_style_setup name -> status
  arg_rw HtmlPage p ; arg Str name ; arg Status status
  html_styles_sem rd_request
  var Pointer:Arrow c :> html_styles first name
  if c=null
    # console "no " name " style" eol
    html_styles_sem rd_release
    return failure
  # console "execute " name " style" eol
  var Link:Function f :> c map Function
  html_styles_sem rd_release
method p execute_style_setup name -> status
  arg_rw HtmlPage p ; arg Str name ; arg Status status
  html_styles_sem rd_request
  var Pointer:Arrow c :> html_styles first name
  if c=null
    # console "no " name " style" eol
    html_styles_sem rd_release
    return failure
  # console "execute " name " style" eol
  var Link:Function f :> c map Function
  html_styles_sem rd_release
  p execute_style_setup_prototype p:http_request:style_optio
  p:html_stack initialize
  p execute_style_setup_prototype f
  status := success

method p execute_style_setup fun -> status
  arg_rw HtmlPage p; arg Function fun; arg Status status
  status := success
  var Pointer:Arrow c:> fun:properties first "style"
  while c<>null
  status := success

method p execute_style_setup fun -> status
  arg_rw HtmlPage p; arg Function fun; arg Status status
  status := success
  var Pointer:Arrow c:> fun:properties first "style"
  while c<>null
    if entry_type:c=Str
    if entry_type:c=Function
      p execute_style_bloc_prototype (c map Function)
    eif entry_type:c=Str
      if (p execute_style_setup (c map Str))=failure
        status := failure
    c :> fun:properties next "style" c


      if (p execute_style_setup (c map Str))=failure
        status := failure
    c :> fun:properties next "style" c


method s search_from start pattern ifnotfound -> pos
  arg Str s ; arg Int start ; arg Str pattern ; arg Int ifno
  pos := ((s start s:len) search pattern ifnotfound.-.start)

method p dynamic_tag_prototype options fun
  arg_rw HtmlPage p ; arg Str options ; arg Function fun
  indirect

method p tag id options
  arg_rw HtmlPage p ; arg Str id options
  var Pointer:Arrow c :> p:tags first id
  if c=null
    p:http_stream writechars "<"+id+">[lf]"
    return
  if entry_type:c=Str
    var Str value := c map Str
    part substitute
      var Int i1 := value search character:251 -1
      if i1>=0
        var Int i2 := value search_from i1+1 character:252 -
        if i2>=0
          var Int i3 := value search_from i2+1 character:253
          if i3>=0
            var Int i4 := value search_from i3+1 character:2
            if i4>=0
              var Int i5 := value search_from i4+1 character
              if i5>=0
                if (value i2+1 i3-i2-1)=character:250
                  var CBool flag := options option (value i1
                  value := (value 0 i1)+(shunt flag (value i
                else
                  var Str param := options option (value i1+
                  if param<>""
                    value := (value 0 i1)+(value i2+1 i3-i2-
                  else
                    value := (value 0 i1)+(value i4+1 i5-i4-
                restart substitute              
    p:http_stream writechars value
  eif entry_type:c=Function
    p dynamic_tag_prototype options (c map Function)

method p tag_style id style
  arg_rw HtmlPage p ; arg Str id style
  p:tags insert id true addressof:(new Str style)

function tag_option id pre post default -> s
  arg Str id pre post default ; arg Str s
  s := character:251+id+character:252+pre+character:253+post

function tag_flag id yes no -> s
  arg Str id yes no ; arg Str s
  s := character:251+id+character:252+character:250+characte


function 'record style setup code' fun name
  arg Function fun ; arg Str name
  html_styles_sem request
  html_styles insert name true addressof:fun
  html_styles_sem release

named_expression style_setup_prototype
function 'record style setup code' fun name
  arg Function fun ; arg Str name
  html_styles_sem request
  html_styles insert name true addressof:fun
  html_styles_sem release

named_expression style_setup_prototype
  method page style_setup_code options
    arg_rw HtmlPage page ; arg Str options
  method page style_setup_code
    arg_rw HtmlPage page
    implicit page
      body
    implicit page
      body
  'record style setup code' (the_function '. style_setup_cod
  'record style setup code' (the_function '. style_setup_code' HtmlPage) name

meta style_setup e
  if e:size<>1
    return
  var Link:Module m :> e module
  if (exists m:external)
    m :> m external
  var Link:Expression ee :> expression duplicate style_setup
  e compile_as ee
  var Link:Expression f :> null map Expression
  var Bool ok := track_expression style_setup_prototype "bod
  check ok
  copy_properties f e:0

meta style_setup e
  if e:size<>1
    return
  var Link:Module m :> e module
  if (exists m:external)
    m :> m external
  var Link:Expression ee :> expression duplicate style_setup
  e compile_as ee
  var Link:Expression f :> null map Expression
  var Bool ok := track_expression style_setup_prototype "bod
  check ok
  copy_properties f e:0

  
  
named_expression style_bloc_prototype
  method page 'pliant style bloc'
    arg_rw HtmlPage page
    body

meta style e

meta style e
  if e:size<>1 or (e:0 constant Str)=null
    return
  var Link:Str name :> new Str ((e:0 constant Str) map Str)
  if (name 0 1)<>"/"
    name := (e:module:name 0 (e:module:name search_last "/" 
  e:module:properties insert "style" false addressof:name
  e compile_as (expression immediat module:name substitute n
  if e:size=1 and e:0:ident="{}"
    var Link:Expression ee :> expression duplicate style_bloc_prototype substitute body e:0 near e:0
    ee compile
    var Link:Function f :> (pliant_general_dictionary first ". pliant style bloc") map Function
    if exists:f
      e:module:properties insert "style" false addressof:f
      pliant_general_dictionary remove ". pliant style bloc" addressof:f
      e set_void_result
  eif e:size=1 and (e:0 constant Str)<>null
    var Link:Str name :> new Str ((e:0 constant Str) map Str)
    if (name 0 1)<>"/"
      name := (e:module:name 0 (e:module:name search_last "/" -1)+1)+name    
    e:module:properties insert "style" false addressof:name
    e compile_as (expression immediat module:name substitute name e:0)


export '. tag' '. tag_style' tag_option tag_flag style_setup
export style '. execute_style_setup'
export style_setup 'record style setup code'
export style



method request http_answer line
  arg_rw HttpRequest request ; arg Str line
  request:stream writeline line
  if line:len<>0
    request:log trace "answer " line
  
method request send_header
  arg_rw HttpRequest request
  request log_mark := request:log:mark
  if request:protocol_level<1
    return



method request http_answer line
  arg_rw HttpRequest request ; arg Str line
  request:stream writeline line
  if line:len<>0
    request:log trace "answer " line
  
method request send_header
  arg_rw HttpRequest request
  request log_mark := request:log:mark
  if request:protocol_level<1
    return
  request http_answer "HTTP/"+request:server:protocol_level+
  request http_answer "HTTP/"+(string request:protocol_level)+" "+(shunt request:answer_status<>"" request:answer_status "200 OK")
  if request:server:send_software_release_number
    request http_answer "Server: Pliant/"+string:pliant_rele
  else
    request http_answer "Server: Pliant"
  if request:answer_is_dynamic
    if request:browser_model="mozilla"
      request http_answer "Pragma: no-cache" # not supported
    else
      request http_answer "Expires: 0" # not recommended in 
  eif request:answer_datetime=defined
    request http_answer "Last-Modified: "+(rfc1123_date requ
  if request:answer_size=defined
    request http_answer "Content-Length: "+(string request:a
  if request:answer_mime_type<>""
    request http_answer "Content-Type: "+request:answer_mime
  if compression and request:answer_encoding<>""
    request http_answer "Content-Encoding: "+request:answer_
  request keep_alive_applyed := request:keep_alive_requested
  if request:keep_alive_applyed 
    request http_answer "Connection: Keep-Alive"
  var Pointer:Arrow c :> request:answer_extra first
  while c<>null
    request http_answer (c map Str)
    c :> request:answer_extra next c
  request http_answer ""
  request:server:hits_sem request
  request:server hits_count += 1
  if request:answer_size=defined
    request:server bytes_count += request answer_size
  request:server:hits_sem release


method p bind r
  arg_rw HtmlPage p ; arg_rw HttpRequest r
  p http_request :> r
  p http_stream :> r stream
  if request:server:send_software_release_number
    request http_answer "Server: Pliant/"+string:pliant_rele
  else
    request http_answer "Server: Pliant"
  if request:answer_is_dynamic
    if request:browser_model="mozilla"
      request http_answer "Pragma: no-cache" # not supported
    else
      request http_answer "Expires: 0" # not recommended in 
  eif request:answer_datetime=defined
    request http_answer "Last-Modified: "+(rfc1123_date requ
  if request:answer_size=defined
    request http_answer "Content-Length: "+(string request:a
  if request:answer_mime_type<>""
    request http_answer "Content-Type: "+request:answer_mime
  if compression and request:answer_encoding<>""
    request http_answer "Content-Encoding: "+request:answer_
  request keep_alive_applyed := request:keep_alive_requested
  if request:keep_alive_applyed 
    request http_answer "Connection: Keep-Alive"
  var Pointer:Arrow c :> request:answer_extra first
  while c<>null
    request http_answer (c map Str)
    c :> request:answer_extra next c
  request http_answer ""
  request:server:hits_sem request
  request:server hits_count += 1
  if request:answer_size=defined
    request:server bytes_count += request answer_size
  request:server:hits_sem release


method p bind r
  arg_rw HtmlPage p ; arg_rw HttpRequest r
  p http_request :> r
  p http_stream :> r stream
  p tags := var Dictionary empty_dictionary
  p text_hook :> the_function '. default_text_handler' HtmlP
  p html_hook :> the_function '. default_html_handler' HtmlP
  p options := http_decode r:url_options
  p html_hook :> the_function '. default_html_hook' HtmlPage Str
  p text_hook :> the_function '. default_text_hook' HtmlPage Str
  p begin_hook :> the_function '. default_begin_end_hook' HtmlPage
  p end_hook :> the_function '. default_begin_end_hook' HtmlPage
  p:html_stack mark
  p execute_style_setup "/pliant/protocol/http/style/default
  p execute_style_setup r:style_name
  if compression and r:answer_encoding<>""
    p http_stream :> new Stream
    p:http_stream open r:answer_encoding+":" "" out+safe pli
  p execute_style_setup "/pliant/protocol/http/style/default
  p execute_style_setup r:style_name
  if compression and r:answer_encoding<>""
    p http_stream :> new Stream
    p:http_stream open r:answer_encoding+":" "" out+safe pli
  p:html_stack initialize


method p unbind r
  arg_rw HtmlPage p ; arg_rw HttpRequest r
  p:html_stack rewind


type NullStreamDriver
  void

StreamDriver maybe NullStreamDriver

method drv write buf mini maxi -> written
  oarg_rw NullStreamDriver drv ; arg Address buf ; arg Int mini maxi written
  written := maxi


method p reset_http_answer
  arg_rw HtmlPage p
  var Pointer:HttpRequest r :> p http_request
method p reset_http_answer
  arg_rw HtmlPage p
  var Pointer:HttpRequest r :> p http_request
  if (addressof p:http_stream)<>(addressof r:stream)
    var Link:StreamDriver drv :> r:stream stream_driver
    r:stream stream_driver :> new NullStreamDriver
    p http_stream :> r stream
    r:stream stream_driver :> drv
  r answer_encoding := ""
  r answer_encoding := ""
  p http_stream :> r stream
  r:stream stream_write_cur := r:stream stream_write_buf
  r:log rewind r:log_mark



method request send_empty_answer status
  arg_rw HttpRequest request ; arg Str status
  if request:protocol_level>=1
  r:stream stream_write_cur := r:stream stream_write_buf
  r:log rewind r:log_mark



method request send_empty_answer status
  arg_rw HttpRequest request ; arg Str status
  if request:protocol_level>=1
    request http_answer "HTTP/"+request:server:protocol_leve
    request http_answer "HTTP/"+(string request:protocol_level)+" "+status
    request http_answer ""

method request send_simple_page title header_message text_me
  arg_rw HttpRequest request ; arg Str title header_message 
  request answer_status := status
  request answer_mime_type := "text/html"
  request send_header
  (var HtmlPage page) bind request
  page html "<!DOCTYPE HTML PUBLIC [dq]-//W3C//DTD HTML 3.2 
  page html "<html>[lf]"
  page html "<head>[lf]"
  if title<>""
    page html "<title>"+html_encode:title+"</title>[lf]"
  if header_message<>""
    page html header_message
  page html "</head>[lf]"
  page html "<body>[lf]"
  if text_message<>""
    request http_answer ""

method request send_simple_page title header_message text_me
  arg_rw HttpRequest request ; arg Str title header_message 
  request answer_status := status
  request answer_mime_type := "text/html"
  request send_header
  (var HtmlPage page) bind request
  page html "<!DOCTYPE HTML PUBLIC [dq]-//W3C//DTD HTML 3.2 
  page html "<html>[lf]"
  page html "<head>[lf]"
  if title<>""
    page html "<title>"+html_encode:title+"</title>[lf]"
  if header_message<>""
    page html header_message
  page html "</head>[lf]"
  page html "<body>[lf]"
  if text_message<>""
    page html html_encode:text_message
    page text text_message
  if html_message<>""
    page html html_message
  page html "</body>[lf]"
  page html "</html>[lf]"
  request send_footer
  if html_message<>""
    page html html_message
  page html "</body>[lf]"
  page html "</html>[lf]"
  request send_footer
  page unbind request


export '. send_empty_answer' '. send_simple_page' '. send_re


export '. send_empty_answer' '. send_simple_page' '. send_re
export '. send_header' '. send_footer' '. bind' '. reset_htt
export '. send_header' '. send_footer' '. bind' '. unbind' '. reset_http_answer'
export '. modified_since'



method server do_compile_dynamic_page pagename physical name
  arg_rw HttpServer server ; arg Str pagename physical name 
  pliant_compiler_semaphore request
  http_trace trace "compiling page " name
  http_current_pagename := pagename
  http_current_filename := physical
  http_current_datetime := (file_query physical standard) da
  var Link:List program :> new List
  var Pointer:Str eod :> lines first ; var Int linenum := 0
  var Pointer:Str l :> lines first ; var Int n := 0 ; var CB
  while exists:l
    if (l parse word:"style" (var Str modname)) and ( (l 0 5
      eod :> lines next l ; linenum := n+1
    eif (l parse word:"module" (var Str modname)) and ( (l 0
      eod :> lines next l ; linenum := n+1
    if (l 0 3)="if "
      within_if := true
    eif (l 0 2)<>"  "
      within_if := false
    l :> lines next l ; n += 1
  var Pointer:Str l :> lines first
  while addressof:l<>addressof:eod
    program append addressof:(new Str l)
    l :> lines next l
  program append addressof:(new Str "function '"+name+"' pag
  program append addressof:(new Str "  arg_rw HtmlPage page"
  program append addressof:(new Str "  implicit page")
  program append addressof:(new Str "    [0]left_zero_is_at 
  while exists:l
    program append addressof:(new Str "    "+l)
    l :> lines next l
  var Link:Module module :> new Module
  module name := name
  if exists:count
    module:properties kmap "pliant style standard button cou
  plugin standard_modules
    module include the_module:"/pliant/language/basic/safe.p
    module include the_module:"/pliant/language/parser/posit
    module include the_module:"/pliant/protocol/http/server.
    pliant_load_module "/pliant/protocol/http/style/default.
    module include the_module:"/pliant/protocol/http/style/d
  plugin extra_modules
  error_push_record (var ErrorRecord e) error_filter_all
  compile_text program module
  if e:id=error_id_noerror
    function :> (pliant_general_dictionary first name) map F
    check exists:function
    pliant_general_dictionary remove name addressof:function
    err := ""
    var Pointer:Arrow c :> module:properties first "style"
    while c<>null
      function:properties insert "style" false c
      c :> module:properties next "style" c
export '. modified_since'



method server do_compile_dynamic_page pagename physical name
  arg_rw HttpServer server ; arg Str pagename physical name 
  pliant_compiler_semaphore request
  http_trace trace "compiling page " name
  http_current_pagename := pagename
  http_current_filename := physical
  http_current_datetime := (file_query physical standard) da
  var Link:List program :> new List
  var Pointer:Str eod :> lines first ; var Int linenum := 0
  var Pointer:Str l :> lines first ; var Int n := 0 ; var CB
  while exists:l
    if (l parse word:"style" (var Str modname)) and ( (l 0 5
      eod :> lines next l ; linenum := n+1
    eif (l parse word:"module" (var Str modname)) and ( (l 0
      eod :> lines next l ; linenum := n+1
    if (l 0 3)="if "
      within_if := true
    eif (l 0 2)<>"  "
      within_if := false
    l :> lines next l ; n += 1
  var Pointer:Str l :> lines first
  while addressof:l<>addressof:eod
    program append addressof:(new Str l)
    l :> lines next l
  program append addressof:(new Str "function '"+name+"' pag
  program append addressof:(new Str "  arg_rw HtmlPage page"
  program append addressof:(new Str "  implicit page")
  program append addressof:(new Str "    [0]left_zero_is_at 
  while exists:l
    program append addressof:(new Str "    "+l)
    l :> lines next l
  var Link:Module module :> new Module
  module name := name
  if exists:count
    module:properties kmap "pliant style standard button cou
  plugin standard_modules
    module include the_module:"/pliant/language/basic/safe.p
    module include the_module:"/pliant/language/parser/posit
    module include the_module:"/pliant/protocol/http/server.
    pliant_load_module "/pliant/protocol/http/style/default.
    module include the_module:"/pliant/protocol/http/style/d
  plugin extra_modules
  error_push_record (var ErrorRecord e) error_filter_all
  compile_text program module
  if e:id=error_id_noerror
    function :> (pliant_general_dictionary first name) map F
    check exists:function
    pliant_general_dictionary remove name addressof:function
    err := ""
    var Pointer:Arrow c :> module:properties first "style"
    while c<>null
      function:properties insert "style" false c
      c :> module:properties next "style" c
    function:properties insert "module" true addressof:module  
  else
    function :> null map Function
    err := e message
    e id := error_id_noerror
  error_pull_record e
  if exists:count
    count := module:properties kmap "pliant style standard b
  module :> null map Module
  pliant_compiler_semaphore release


method request send_static_file filename options -> status
  arg_rw HttpRequest request ; arg Str filename options ; ar
  var Str ext
  if (options parse "filter_" any:ext _ any)
    void
  eif (options parse "filter_" any:ext)
    void
  else
    ext := filename (filename search_last "." filename:len) 
  var FileInfo info := file_query filename standard
  if info=undefined or info:is_directory
    return failure
  if not (request modified_since info:datetime)
    request answer_status := "304 Not modified"
    request answer_is_dynamic := false
    request send_header
    request send_footer
    return success
  var Stream data ; data open filename in+safe
  if data=failure
    return failure
  else
    function :> null map Function
    err := e message
    e id := error_id_noerror
  error_pull_record e
  if exists:count
    count := module:properties kmap "pliant style standard b
  module :> null map Module
  pliant_compiler_semaphore release


method request send_static_file filename options -> status
  arg_rw HttpRequest request ; arg Str filename options ; ar
  var Str ext
  if (options parse "filter_" any:ext _ any)
    void
  eif (options parse "filter_" any:ext)
    void
  else
    ext := filename (filename search_last "." filename:len) 
  var FileInfo info := file_query filename standard
  if info=undefined or info:is_directory
    return failure
  if not (request modified_since info:datetime)
    request answer_status := "304 Not modified"
    request answer_is_dynamic := false
    request send_header
    request send_footer
    return success
  var Stream data ; data open filename in+safe
  if data=failure
    return failure
  var Str opt := options
  var Str opt := options+" name "+string:filename
  var Link:Function filter :> query_mime_static_filter ext
  if exists:filter
    var Str tempname := file_temporary
    var Stream temp ; temp open tempname out+safe
    if temp=failure
      return failure
    mime_filter data temp opt filter
    data close ; temp close
    info size := (file_query tempname standard) size
    data open tempname in+safe
    if data=failure
      file_delete tempname
      return failure
  var Str mime := opt option "mime" Str
  if mime=""
    mime := query_mime_type ext
  if mime=""
    mime := "binary/*"
  request answer_mime_type := mime
  request answer_size := info size
  request answer_datetime := info datetime
  request answer_is_dynamic := false
  request answer_encoding := ""
  request send_header
  part send "send static file content"
    var Int remain := info size
    while remain>0 and { var Int step := raw_copy data reque
      remain -= step
    request:stream flush anytime
  data close
  if exists:filter
    file_delete tempname
  if remain<>0
    request keep_alive_applyed := false
  request send_footer
  status := success
  


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 path
          path := replace (replace path "(" "&#") ")" ";"
          value := replace http_decode:value "[cr][lf]" "[lf
          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
  var Link:Function filter :> query_mime_static_filter ext
  if exists:filter
    var Str tempname := file_temporary
    var Stream temp ; temp open tempname out+safe
    if temp=failure
      return failure
    mime_filter data temp opt filter
    data close ; temp close
    info size := (file_query tempname standard) size
    data open tempname in+safe
    if data=failure
      file_delete tempname
      return failure
  var Str mime := opt option "mime" Str
  if mime=""
    mime := query_mime_type ext
  if mime=""
    mime := "binary/*"
  request answer_mime_type := mime
  request answer_size := info size
  request answer_datetime := info datetime
  request answer_is_dynamic := false
  request answer_encoding := ""
  request send_header
  part send "send static file content"
    var Int remain := info size
    while remain>0 and { var Int step := raw_copy data reque
      remain -= step
    request:stream flush anytime
  data close
  if exists:filter
    file_delete tempname
  if remain<>0
    request keep_alive_applyed := false
  request send_footer
  status := success
  


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 path
          path := replace (replace path "(" "&#") ")" ";"
          value := replace http_decode:value "[cr][lf]" "[lf
          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
            (page:env kmap "default data rejected" List) app
            # FIXME (page:env kmap "default data rejected" List) append addressof:(new Str path)
      offset := stop+1
  if request:form<>""
      offset := stop+1
  if request:form<>""
    if request:put_file="" and request:temp_files:first=null
    if request:temp_files:first=null and (not (exists request:context_type) or (request:context_type:properties first "http stay")=null)
      page reset_http_answer
      request send_redirect_answer request:url_path+"?"+requ
      return true

      page reset_http_answer
      request send_redirect_answer request:url_path+"?"+requ
      return true

method page begin_html_page
  arg_rw HtmlPage page
  page tag "doctype" ""
  page tag "html" ""
  page tag "head" ""
  page tag "stylesheet" ""
  page tag "script" ""
  page tag "/head" ""
  page tag "body" "url "+(string page:http_request:url_path)
  page tag "page_top" ""

method page end_html_page
  arg_rw HtmlPage page
  if not page:http_request:answered
    page tag "page_bottom" ""
    page tag "/body" ""
    page tag "/html" ""

export '. begin_html_page' '. end_html_page'


function http_execute_dynamic_page page f
  arg_rw HtmlPage page ; arg Function f
  indirect


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
    return failure
  var Link:DynamicPage dp ; var Str context
  if ("&"+request:form+"&"+request:url_options+"=" eparse an
    button := http_decode button
    var Str context := request uncipher http_decode:scontext
    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 url_options := ""
      var Str filename2 := request what_file "/misc/signatur
      request send_file filename2 ""
      return success # wrong signature
    dp :> request:server find_dynamic_page http_decode:butto
    if not exists:dp and (button parse any:(var Str modulena
      if modulename:len>4 and (modulename modulename:len-4 4
        pliant_compiler_semaphore request
        pliant_load_module modulename the_module:"/pliant/la
        pliant_compiler_semaphore release
        dp :> request:server find_dynamic_page http_decode:b
    if not exists:dp
      request form := "" ; request url_options := ""
      var Str filename2 := request what_file "/misc/obsolete
      request send_file filename2 ""
      return success # there is no such button
  else
    dp :> sp
    context := ""
  request answer_mime_type := "text/html"
  request answer_datetime := dp datetime
  if compression
    request answer_encoding := request supported_encoding
  request send_header
  (var HtmlPage page) bind request
function http_execute_dynamic_page page f
  arg_rw HtmlPage page ; arg Function f
  indirect


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
    return failure
  var Link:DynamicPage dp ; var Str context
  if ("&"+request:form+"&"+request:url_options+"=" eparse an
    button := http_decode button
    var Str context := request uncipher http_decode:scontext
    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 url_options := ""
      var Str filename2 := request what_file "/misc/signatur
      request send_file filename2 ""
      return success # wrong signature
    dp :> request:server find_dynamic_page http_decode:butto
    if not exists:dp and (button parse any:(var Str modulena
      if modulename:len>4 and (modulename modulename:len-4 4
        pliant_compiler_semaphore request
        pliant_load_module modulename the_module:"/pliant/la
        pliant_compiler_semaphore release
        dp :> request:server find_dynamic_page http_decode:b
    if not exists:dp
      request form := "" ; request url_options := ""
      var Str filename2 := request what_file "/misc/obsolete
      request send_file filename2 ""
      return success # there is no such button
  else
    dp :> sp
    context := ""
  request answer_mime_type := "text/html"
  request answer_datetime := dp datetime
  if compression
    request answer_encoding := request supported_encoding
  request send_header
  (var HtmlPage page) bind request
  page options := http_decode request:url_options
  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 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_html_page
        page begin_end_hook_prototype page:begin_hook
        http_execute_dynamic_page page dp:function
        http_execute_dynamic_page page dp:function
        page end_html_page
        page begin_end_hook_prototype page:end_hook
    status := success
  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 
        pc += "&"+tf:name+"="+value
        value := replace http_decode:value "[cr][lf]" "[lf]"
        from_string (buf translate Byte tf:offset) tf:type v
      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
          value := replace http_decode:value "[cr][lf]" "[lf
          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
    status := success
  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 
        pc += "&"+tf:name+"="+value
        value := replace http_decode:value "[cr][lf]" "[lf]"
        from_string (buf translate Byte tf:offset) tf:type v
      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
          value := replace http_decode:value "[cr][lf]" "[lf
          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_html_page
        page begin_end_hook_prototype page:begin_hook
        http_execute_dynamic_sub_page buf dp:function
        http_execute_dynamic_sub_page buf dp:function
        page end_html_page
        page begin_end_hook_prototype page:end_hook
    t destroy_instance buf
    memory_free buf
    status := success
  else
    status := failure
  request send_footer
    t destroy_instance buf
    memory_free buf
    status := success
  else
    status := failure
  request send_footer
  page unbind request



method request browser_walkaround
  arg_rw HttpRequest request
  if request:browser_model="opera" or request:browser_model=
    if request:supported_encoding="deflate"
      request supported_encoding := "gzip"
  plugin browser_walkaround
  



method request browser_walkaround
  arg_rw HttpRequest request
  if request:browser_model="opera" or request:browser_model=
    if request:supported_encoding="deflate"
      request supported_encoding := "gzip"
  plugin browser_walkaround
  
method request forward cmd
  arg_rw HttpRequest request ; arg Str cmd
method request forward target extra
  arg_rw HttpRequest request ; arg Str target extra
  plugin forward_begin
  var Link:Stream s :> request stream
  var Link:Stream d :> new Stream
  plugin forward_begin
  var Link:Stream s :> request stream
  var Link:Stream d :> new Stream
  d open request:forward in+out+safe
  d open target in+out+cr+lf+safe
  if d=failure
    return
  if d=failure
    return
  d writeline cmd
  d writeline request:query_first_line
  var Pointer:Arrow c :> request:query_log first
  while c<>null
    d writeline (c map Str)
    c :> request:query_log next c
  var Pointer:Arrow c :> request:query_log first
  while c<>null
    d writeline (c map Str)
    c :> request:query_log next c
  d writeline "Origin-IP: "+(s safe_query "remote_ip_address
  if extra:len>0
    d writeline extra
  d writeline ""
  d flush anytime
  var Sem sem ; sem request
  thread
    while { d read_available (var Address adr2) (var Int siz
      s raw_write adr2 size2
      s flush anytime
    s safe_configure "shutdown"
    share:sem release
  while { s read_available (var Address adr1) (var Int size1
    d raw_write adr1 size1
    d flush anytime
  d safe_configure "shutdown"
  sem request ; sem release
  plugin forward_end
     


  d writeline ""
  d flush anytime
  var Sem sem ; sem request
  thread
    while { d read_available (var Address adr2) (var Int siz
      s raw_write adr2 size2
      s flush anytime
    s safe_configure "shutdown"
    share:sem release
  while { s read_available (var Address adr1) (var Int size1
    d raw_write adr1 size1
    d flush anytime
  d safe_configure "shutdown"
  sem request ; sem release
  plugin forward_end
     


function unhexa s -> i
  arg Str s ; arg Int i
  i := 0
  for (var Int j) 0 s:len-1
    var Int c := s:j number
    if c>="0":0:number and c<="9":0:number
      i := i*16+(c-"0":0:number)
    eif c>="A":0:number and c<="F":0:number
      i := i*16+(c-"A":0:number+10)
    eif c>="a":0:number and c<="f":0:number
      i := i*16+(c-"a":0:number+10)
    eif c=" ":number
      void
    else
      return undefined


method request read_data_string limit datas -> status
  arg_rw HttpRequest request ; arg Int limit ; arg_w Str datas ; arg Status status
  implicit request
    var CBool continue := false
    var Int length := undefined
    var CBool chunked := false
    var Pointer:Arrow c :> query_log first
    while c<>null
      var Pointer:Str s :> c map Str
      if (s parse acword:"expect" ":" acword:"100-continue" any)
        continue := true
      eif (s parse acword:"content-length" ":" (var Int i))
        length := i
      eif (s parse acword:"transfer-encoding" ":" acword:"chunked" any)
        chunked := true
      c :> query_log next c
    datas := ""
    status := failure
    if length=undefined and not chunked
      return
    part read
      if protocol_level>=1.1 and continue
        send_empty_answer "100 Continue"
      if chunked
        datas := ""        
        part read_chunk
          var Str csize := stream readline
          var Int step := unhexa csize
          if step<0
            send_empty_answer "400 Incorrect chunk size" ; leave read
          if limit=defined and datas:len+step>limit
            send_empty_answer "500 Overflow" ; leave read
          datas resize datas:len+step
          stream raw_read (datas:characters translate Char datas:len-step) step
          var Str eoc := stream readline
          if step<>0
            restart read_chunk
      else
        datas set (memory_allocate length addressof:datas) length true
        stream raw_read datas:characters datas:len
      status := success
    if status=failure
      stream error "Failed read HTTP client datas"

method request read_data_file limit filename -> status
  arg_rw HttpRequest request ; arg Int limit ; arg Str filename ; arg Status status
  implicit request
    var CBool continue := false
    var Int length := undefined
    var CBool chunked := false
    var Pointer:Arrow c :> query_log first
    var DateTime dt := undefined
    while c<>null
      var Pointer:Str s :> c map Str
      if (s parse acword:"expect" ":" acword:"100-continue" any)
        continue := true
      eif (s parse acword:"content-length" ":" (var Int i))
        length := i
      eif (s parse acword:"transfer-encoding" ":" acword:"chunked" any)
        chunked := true
      eif (s parse acword:"last-modified" ":" any:(var Str value))
        dt := rfc1123_date value
      c :> query_log next c
    status := failure
    if length=undefined and not chunked
      return
    part read
      (var Stream data) open filename out+safe
      if data=failure
        send_empty_answer "500 Internal Server Error" ; leave read
      if protocol_level>=1.1 and continue
        send_empty_answer "100 Continue"
      if chunked
        length := 0
        part read_chunk
          var Str csize := stream readline
          var Int step := unhexa csize
          if step<0
            send_empty_answer "400 Incorrect chunk size" ; leave read
          if limit=defined and length+step>limit
            send_empty_answer "500 Overflow" ; leave read
          if (raw_copy stream data step step)<>step
            send_empty_answer "400 Broken connection" ; leave read
          length += step
          var Str eoc := stream readline
          if step<>0
            restart read_chunk
      else
        if limit=defined and length>limit
          send_empty_answer "500 Overflow" ; leave read
        if (raw_copy stream data length length)<>length
          send_empty_answer "400 Broken connection" ; leave read
      if data:close=failure
        send_empty_answer "500 Internal Server Error" ; leave read
      if dt=defined
        file_configure filename "datetime "+string:dt
      status := success
    if status=failure
      data close
      file_delete filename
      stream error "Failed read HTTP client datas"
     

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_applyed := false
    query_log := var List empty_list
    answered := false
    answer_extra := var List empty_list
    answer_status := ""
    answer_mime_type := ""
    answer_size := undefined
    answer_datetime := undefined
    answer_is_dynamic := true
    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
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_applyed := false
    query_log := var List empty_list
    answered := false
    answer_extra := var List empty_list
    answer_status := ""
    answer_mime_type := ""
    answer_size := undefined
    answer_datetime := undefined
    answer_is_dynamic := true
    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
    request:log trace "query " cmd
    var Str command protocol
    if (cmd parse any:command _ (any request:url_path) _ any
    if (cmd parse any:command _ (any request:url_path) _ any:(var Str protocol))
      if (request:url_path eparse "http://" any "/" any:(var
        request url_path := "/"+remain
      if not (protocol parse word:"HTTP" "/" request:protoco
        request send_empty_answer "400 Bad Request"
        return
      if (request:url_path eparse "http://" any "/" any:(var
        request url_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 request:server:protocol_level
    eif (cmd parse any:command "_" (any request:url_path))
      request protocol_level := 0.9
    eif cmd:len<=1
      request keep_alive_applyed := true
      return
    else
      request send_empty_answer "400 Bad Request"
      return
    eif (cmd parse any:command "_" (any request:url_path))
      request protocol_level := 0.9
    eif cmd:len<=1
      request keep_alive_applyed := true
      return
    else
      request send_empty_answer "400 Bad Request"
      return
    if request:server:protocol_level<>"1.0" and request:prot
    if request:protocol_level>=1.1
      request keep_alive_requested := true
    else
      request keep_alive_requested := false
    if (request:url_path parse any:(var Str base) "?" (any r
      request url_path := base
    else
      request url_options := ""
      request keep_alive_requested := true
    else
      request keep_alive_requested := false
    if (request:url_path parse any:(var Str base) "?" (any r
      request url_path := base
    else
      request url_options := ""
    var Int length := undefined ; var Str tag value
    request command := command
    var Int length := undefined
    var CBool multipart := false
    var CBool continue := false
    var CBool multipart := false
    var CBool continue := false
    var DateTime dt := undefined
    var Int header_length := 0
    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
        else
          header_length := request:server:maximal_header_len
        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="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
          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:(var Str user) ":" any:(var
                var Data:UserSecret u :> user_secret_databas
                if request:server:configure and user=request
                  request user_name := user
                  request user_auth_level := 1
                  request user_is_admin := true
                eif 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
    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
        else
          header_length := request:server:maximal_header_len
        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="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
          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:(var Str user) ":" any:(var
                var Data:UserSecret u :> user_secret_databas
                if request:server:configure and user=request
                  request user_name := user
                  request user_auth_level := 1
                  request user_is_admin := true
                eif 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
          eif tag="last-modified"
            dt := rfc1123_date value
  request browser_walkaround
  request assign_user ## section "parse_then_answer user" ; 
  request assign_site ## how "" section "method assign_site"
  plugin answer_begin
  part answer "site '"+request:site_name+"' user '"+request:
    if request:style_name<>""
      compile_style request:style_name
    if request:forward<>""
  request browser_walkaround
  request assign_user ## section "parse_then_answer user" ; 
  request assign_site ## how "" section "method assign_site"
  plugin answer_begin
  part answer "site '"+request:site_name+"' user '"+request:
    if request:style_name<>""
      compile_style request:style_name
    if request:forward<>""
      request forward cmd
      request forward request:forward "Origin-IP: "+(request:stream query "remote_ip_address")
    eif command="GET"
      request answer
    eif command="POST" ## section "parse_then_answer POST"
      if length=undefined or length<0
        request send_empty_answer "411 Length Required" ; le
      eif length>(shunt multipart request:server:maximal_fil
        request send_empty_answer "413 Request Entity Too La
      if request:protocol_level>=1.1 and continue
        request send_empty_answer "100 Continue"
      if not multipart
        part read_form "read HTTP form"
          var Address buffer := null ; var Int done := 0
          while done<length and not http:atend
            http read_available (var Address buf) (var Int s
            buffer := memory_resize buffer done+step null
            memory_copy buf (buffer translate Byte done) ste
            done += step
          if done=length
            request:form set buffer length true
      else
        var Str form_temp := file_temporary
        part read_multipart_form "read HTTP multipart form"
          (var Stream form) open form_temp out+safe
          var Int done := 0
          while done<length and not http:atend
            http read_available (var Address buf) (var Int s
            form raw_write buf step
            done += step
          form close
        part parse_multipart_form "parse HTTP multipart form
          form open form_temp in+safe
          request form := ""
          var Int avail := request:server:maximal_form_lengt
          var Int avail2 := request:server:maximal_file_leng
          part multi
            while not form:atend
              var Str value
              var Str label := "" ; var Str filename := ""
              while { var Str line := form readline ; reques
                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 form:at
                  if cache:len=0
                    var Address a := memory_search form:stre
                    if a=null
                      a := form stream_read_stop
                    var Int step := (cast a Int).-.(cast for
                    data raw_write form:stream_read_cur step
                    form stream_read_cur := a
                  form raw_read addressof:(var Char ch) 1 ; 
                  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 form:atend and cache:len<boundary:
                  if cache:len=0
                    var Address a := memory_search form:stre
                    if a=null
                      a := form stream_read_stop
                    var Int step := (cast a Int).-.(cast for
                    (var Str temp) set form:stream_read_cur 
                    value += temp ; avail -= step
                    form stream_read_cur := a
                  form raw_read addressof:(var Char ch) 1 ; 
                  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
              form raw_read addressof:(var Char ch) 1
              form readline
              if ch="-"
                leave multi
          form close
        file_delete form_temp
      request:log trace "form " request:form
      request answer
    eif command="GET"
      request answer
    eif command="POST" ## section "parse_then_answer POST"
      if length=undefined or length<0
        request send_empty_answer "411 Length Required" ; le
      eif length>(shunt multipart request:server:maximal_fil
        request send_empty_answer "413 Request Entity Too La
      if request:protocol_level>=1.1 and continue
        request send_empty_answer "100 Continue"
      if not multipart
        part read_form "read HTTP form"
          var Address buffer := null ; var Int done := 0
          while done<length and not http:atend
            http read_available (var Address buf) (var Int s
            buffer := memory_resize buffer done+step null
            memory_copy buf (buffer translate Byte done) ste
            done += step
          if done=length
            request:form set buffer length true
      else
        var Str form_temp := file_temporary
        part read_multipart_form "read HTTP multipart form"
          (var Stream form) open form_temp out+safe
          var Int done := 0
          while done<length and not http:atend
            http read_available (var Address buf) (var Int s
            form raw_write buf step
            done += step
          form close
        part parse_multipart_form "parse HTTP multipart form
          form open form_temp in+safe
          request form := ""
          var Int avail := request:server:maximal_form_lengt
          var Int avail2 := request:server:maximal_file_leng
          part multi
            while not form:atend
              var Str value
              var Str label := "" ; var Str filename := ""
              while { var Str line := form readline ; reques
                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 form:at
                  if cache:len=0
                    var Address a := memory_search form:stre
                    if a=null
                      a := form stream_read_stop
                    var Int step := (cast a Int).-.(cast for
                    data raw_write form:stream_read_cur step
                    form stream_read_cur := a
                  form raw_read addressof:(var Char ch) 1 ; 
                  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 form:atend and cache:len<boundary:
                  if cache:len=0
                    var Address a := memory_search form:stre
                    if a=null
                      a := form stream_read_stop
                    var Int step := (cast a Int).-.(cast for
                    (var Str temp) set form:stream_read_cur 
                    value += temp ; avail -= step
                    form stream_read_cur := a
                  form raw_read addressof:(var Char ch) 1 ; 
                  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
              form raw_read addressof:(var Char ch) 1
              form readline
              if ch="-"
                leave multi
          form close
        file_delete form_temp
      request:log trace "form " request:form
      request answer
    eif command="PUT" or command="DELETE"
      if command="PUT"
        if length=defined and length<0
          request send_empty_answer "400 Bad Request" ; leav
        if request:put_file=""
          request:put_file := file_temporary
        (var Stream data) open request:put_file out+mkdir+sa
        if data=failure
          request send_empty_answer "500 Internal Server Err
        if request:protocol_level>=1.1 and continue
          request send_empty_answer "100 Continue"
        if length=defined
          while length>0 and { var Int step := raw_copy http
            length -= step
        else
          while not http:atend
            http read_available (var Address adr) (var Int s
            data raw_write adr step
        data flush anytime
        if data=failure or (length=defined and length<>0)
          request send_empty_answer "500 Internal Server Err
        data close
        if dt=defined
          file_configure request:put_file "datetime "+string
      if (request allowed "write")
        var Str virtualpage := reverse request:url_path
        var Str virtualpath := ""
        while (virtualpage parse any:(var Str extra) "/" any
          virtualpath := "/"+reverse:extra+virtualpath
          var Str virtualfile := request what_file reverse:b
          if (request send_file virtualfile virtualpath)=suc
            leave answer
          virtualpage := base
      var Str filename2 := request what_file "/misc/not_allo
      request send_file filename2 ""
    else    
    else
      var Str virtualpage := reverse request:url_path
      var Str virtualpath := ""
      while (virtualpage parse any:(var Str extra) "/" any:(var Str base))
        virtualpath := "/"+reverse:extra+virtualpath
        var Str virtualfile := request what_file reverse:base+"/virtual_tree.html"
        if (request send_file virtualfile virtualpath)=success
          leave answer
        virtualpage := base
      request send_empty_answer "501 Not Implemented"
  plugin answer_end


method request temporary_cleanup
  arg_rw HttpRequest request
  var Pointer:Arrow c :> request:temp_files first
  while c<>null
    file_delete (c map Str)
    c :> request:temp_files remove c
      request send_empty_answer "501 Not Implemented"
  plugin answer_end


method request temporary_cleanup
  arg_rw HttpRequest request
  var Pointer:Arrow c :> request:temp_files first
  while c<>null
    file_delete (c map Str)
    c :> request:temp_files remove c
  if request:put_file<>""
    file_delete request:put_file
    request:put_file := ""


method server start_checkup -> status
  arg_rw HttpServer server ; arg Status status


method server start_checkup -> status
  arg_rw HttpServer server ; arg Status status
  if server:protocol_level<>"1.0" and not server:keep_alive_
    error "If you want to desable keep alive connections, th
    return failure
  if server:configure
    server admin_user := keyboard_input "Please enter admini
    server admin_password := keyboard_input_password "And no
  else
    var CBool ok := false
    each s site
      ok := true
    each u user
      ok := true
    each h name_database:data:host
      ok := true
    if not ok
      console "The HTTP server is not configured yet, so you
      console "The right command might be:" eol
      console "pliant module /pliant/protocol/http/server.pl
      return failure
  status := success
  plugin server_start



export '. temporary_cleanup'
export '. send_static_file' '. execute_dynamic_page' '. do_c
  if server:configure
    server admin_user := keyboard_input "Please enter admini
    server admin_password := keyboard_input_password "And no
  else
    var CBool ok := false
    each s site
      ok := true
    each u user
      ok := true
    each h name_database:data:host
      ok := true
    if not ok
      console "The HTTP server is not configured yet, so you
      console "The right command might be:" eol
      console "pliant module /pliant/protocol/http/server.pl
      return failure
  status := success
  plugin server_start



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