Patch title: Release 87 bulk changes
Abstract:
File: /pliant/protocol/http/site.page
Key:
    Removed line
    Added line
module "/pliant/util/crypto/rsa.pli"
module "/pliant/util/crypto/legal.pli"
module "/pliant/admin/file.pli"
module "/pliant/language/context.pli"
module "/pliant/fullpliant/this_computer.pli"
module "/pliant/fullpliant/user.pli"
module "/pliant/protocol/dns/name.pli"
module "site.pli"
module "/pliant/language/stream.pli"
module "/pliant/util/network/ping.pli"
module "/pliant/util/encoding/base64.pli"

requires "browse_configuration"

title "Sites administration"

para
  note "HTTP and FTP global settings for this computer"
    read_only not allowed:"administrator"
    title "This computer HTTP and FTP settings"
    header "HTTP settings"
      table columns 3 border 0
        cell [HTTP service:]
        cell
          fixed [Yes]
        cell [We always run the HTTP server because we need it to remote configure the server.]
        cell [Secured connections:]
        cell
          fixed [Yes]
        cell [We always listen for secured connections on TCP port 580 because it's unsafe to remote configure using a clear text connection.]
        cell [Log file:]
        cell
          var Str log := this_computer "pliant" "http" "log"
          input "" log length 30 noeol
        cell [If not empty, all dialogs with HTTP clients connecting to this HTTP server will be logged in the specifyed file.]
        cell [TCP port:]
        cell
          var Str port := this_computer "pliant" "http" "port"
          input "" port length 4 noeol
        cell [The default TCP port for the HTTP server is 80, but you can force it.]
    header "FTP settings"
      table columns 3 border 0
        cell [FTP service:]
        cell
          var Str ftp := this_computer "pliant" "ftp" "service"
          select "" ftp
            option "Yes" "true"
            option "No" "false"
        cell [Should we run the FTP service on this server ?]
    if allowed:"administrator"
      button "Update"
        this_computer "pliant" "http" "log" := log
        this_computer "pliant" "http" "port" := port
        this_computer "pliant" "ftp" "service" := ftp
        goto_backward
     

table columns 4
  cell header
    [Site name]
  cell header
    [Status]
  cell header
    [Abstract]
  cell
    void
  each s site
    var Str id := keyof s
    if (s:computer="" or s:computer=computer_fullname) and s:area:size>0
      cell color (color hsl 120 25 80)
        link id "http://"+id+"/"
        if (id search ":" -1)<>(-1)
          eol ; highlight "you should not specify "+(id (id search ":" id:len) id:len)
    eif s:computer="" or s:computer=computer_fullname 
      cell color (color hsl 120 10 80)
        link id "http://"+id+"/"
        if (id search ":" -1)<>(-1)
          eol ; highlight "you should not specify "+(id (id search ":" id:len) id:len)
    else
      cell
        link id "http://"+id+"/"
        if (id search ":" -1)<>(-1)
          eol ; highlight "you should not specify "+(id (id search ":" id:len) id:len)
    cell
      small
        text s:root
        if s:computer<>""
          text "[lf]on "+s:computer
        var Int bits := rsa_nbbits s:public_key
        if bits=defined
          if site_secret_database:data:site:id:private_key<>""
            bold
              text "[lf]"+string:bits+" bits"
            if (site_secret_database:data:site:id:private_key parse word:"rsa" _ any:(var Str part1a) _ any) and (s:public_key parse word:"rsa" _ any:(var Str part1b) _ any) and part1a<>part1b
              fixed [  ] ; highlight "key is corrupted !"
          else
            font color (color hsl 0 0 50)
              text "[lf]"+string:bits+" bits"
    cell
      text s:abstract
      if s:docurl<>""
        small
          eol ; link "Site extensive technical documentation" s:docurl
    cell
      page button "Edit"
        read_only not allowed:"administrator"
        title "Site '"+id+"'"
        table columns 3 border 0
          cell
            [Site name:]
          cell
            fixed text:id
          cell
            [The site name is the name a client on the internet will use to connect to the site: an example can be] ; fixed [ art.pliant.cx ] ; eol
          cell
            [Serveur name:]
          cell
            input "" s:computer
          cell
            [The full name (including the domain) of the server running the site. An example could be] ; fixed [ server1.pliant.cx] ; eol
            [If you leave this field blank, it means that the site runs on all your servers.] ; eol
          cell
            [IP and port:]
          cell
            input "" s:ip length 15 noeol ; input " " s:port length 5
          cell
            [The IP address and the port the site serveur is using.] ; eol
            [Most of you can leave this field blank.] ; eol
            note "more details"
              title "IP and port fields"
              para
                [When a client connects to an HTTP server, it should provide a 'Host' information in the header of the HTTP request, telling the server the name of the site it expects to connect to. ]
                [Very old or nonstandard browsers may not provide this information. In such a case, the TCP socket IP and port will be used to decide, if possible, the site the client is connecting to. ]
                [It will possible to safely decide if and only if one site only in the database has the correponding IP and port.] ; eol
                [So, if you don't specify an IP and port, stupid browser will not be abble to connect to your site.]
              para
                [If you use ] ; link "FullPliant" "/pliant/linux/fullpliant/" ; [ distribution, then if the IP of the web site is specifyed, it will be used to set the IP of the web site in the DNS server. ]
                [If no IP is specifyed, then the IP of the computer specifyed in the 'Server name' field will be used.]
          cell
            [Forward:]
          cell
            input "" s:forward
          cell
            [A request will be automatically forwarded to the specified destination.] ; eol
            [An example could be:] ; eol
            fixed [tcp://mycomputer.mydomain.org/client/8080]
          cell
            [Protocol:]
          cell
            select "" s:protocol
              option "All" ""
              option "" ""
              option "HTTP" "HTTP"
              option "FTP" "FTP"
              option "proxy" "proxy"
          cell
            [If you don't select 'All', then the site can be accessed only using the specifyed protocol.]
          cell
            [From IPs:]
          cell
            input "" s:from_ip
          cell
            [Restricts the set of IPs allowed to use the service. Sample value could be] ; fixed [ 10.0.0.0/255.0.0.0]
          cell
            [Public key:]
          cell
            input "" s:public_key length 30 noeol
            if allowed:"administrator"
              button "Generate"
                title "Generate a public/private key pair for '"+id+"'"
                var Int bits := min max_legal_key_bits 1024
                input "Number of bits: " bits length 4 noeol
                button "Generate now"
                  var DateTime start := datetime
                  rsa_generate "site:"+id bits ""
                  console "generated a " bits " bits key in " datetime:seconds-start:seconds " seconds." eol
                  goto_backward
                if max_legal_key_bits<10000
                  para
                    [This software cannot generate more than ] ; text string:max_legal_key_bits ; [ bits keys. ]
                    [If you live in a country where cryptography is not restricted, then you should make your own version of the software through changing the ] ; link "/pliant/util/crypto/legal.pli" "/pliant/util/crypto/legal.pli"; [ source module.]
                para
                  [Generating a long key pair will take a very long time. ]
                  [Let's say one hour for a 1024 bits key on a 300Mhz computer. ]
                  [If the key length is double, then the consumed time will be roughly multiplyed by five.]
                para
                  [The public key will be stored in] ; fixed [ security:/site.pdb ] ; [database file (] ; fixed (text file_os_name:"security:/site.pdb"+" ") ; [ system file on this computer), ]
                  [and the private key will be stored in] ; fixed [ security:/site_key.pdb ] ; [database file (] ; fixed (text file_os_name:"security:/site_key.pdb"+" ") ; [ system file on this computer).] ; eol
                  [You can publish the] ; fixed [ security:/site.pdb ] ; [file, but have to keep the] ; fixed [ security:/site_key.pdb ] ; [file secret.] ; eol
                  table columns 1 border 0
                    cell color (color hsl 0 10 80)
                      [Anybody that knows or can read the content of] ; fixed [ security:/site_key.pdb ] ; [file can bypass the Pliant HTTP server security mechanism, can probably also corrupt the all server content, and can make clients believe that one of his systems is this HTTP server.]
              var Int bits := rsa_nbbits s:public_key
              if bits=defined
                small
                  eol ; [The current key is ] ; text string:bits ; [ bits wild.]
          cell
            [The server key is used to prove the server identity to the clients connecting to it an so prevent from DNS corruption and session spoofing.] ; eol
            [You need to generate a key if you want to enable clients to securely connect to the server using ] ; link "Pliant secured proxy" "/pliant/protocol/http/" section "security" ; [.]
          cell
            [Site root path:]
          cell
            input "" s:root length 40
          cell
            [Keep in mind that a Pliant path starting with] ; fixed [ / ] ; [is specifying a directory within Pliant tree. If you want to specify a directory outside Pliant tree, it must start with] ; fixed [ file:/] ; eol
            [Futhermore, a Pliant path must end with a] ; fixed [ /]
          cell
            [Style:]
          cell
            input "" s:style length 40
          cell
            [The style will define the vocabulary that you can use in .page dynamic pages.] ; eol
            small
              [The default is] ; fixed [ /pliant/protocol/http/style/default.style ] ; [and is defined ] ; link "here" "/pliant/protocol/http/page"
          cell
            [Style options:]
          cell
            text_input "" s:style_options columns 60 rows 10
          cell
            [Enables you to customize the style.] ; eol
            note "more details"
              execute_dynamic_page "/pliant/protocol/http/style/default_customize.html"
          cell
            [Default page:]
          cell
            input "" s:default length 40
          cell
            [What virtual tree page will be called if the requested URL does not resolve.] ; eol
            [The true file extension is .page, but here you have to use .html anyway.]
        table columns 2 border 0
          cell [Abstract:]
          cell (text_input "" s:abstract rows 5 columns 60)
        table columns 10
        table columns 8
          cell header [Area ID]
          cell header [Path]
          cell header [Extension]
          cell header [Mode]
          cell header [Read]
          cell header [Write]
          cell header [Root path]
          cell header [Style]
          cell header [Style options]
          cell header [Forward]
          cell header
            small
              [Must be unique, but does not have any meaning.]
          cell header
            small
              [A path must end with a] ; fixed [ / ] ; [sign.]
          cell header
            small
              [If specifyed, only files with the corresponding extension are concerned.] ; eol
              [An extension is something like] ; fixed [ .jpeg]
          cell header
            void
          cell header
            small
              [The right a user need to own in order to access the area.] ; eol
              [An empty field means that the operation is not allowed, except for the server administrator.] ; eol
              [If a user is granted the right you specify here, then he will also be granted 'read' special right.] ; eol
              link "more details" "/pliant/protocol/http/" section "security"
          cell header
            small
              [The right a user need to own in order to upload (change) files in the area.] ; eol
              [If a user is granted the right you specify here, then he will also be granted 'write' special right.]
          cell header
            small
              [If specifyed, this area will not use the general site root path.]
          cell header
            small
              [If specifyed, this area will not use the general site style.]
          cell header
            small
              [Will add extra options that are specific to this area.]
          cell void
          cell header
            small
              [If specified, the connection will be forwarded to the specified remote TCP port.]
          var CBool ok := false
          each a s:area
            if a:path="/" and a:extension="" and a:read<>""
            if a:path="/" and a:read<>""
              ok := true
            cell
              text keyof:a
            cell
              input "" a:path length 30
            cell
              input "" a:extension length 6
            cell
              select "" a:mode
                option "" ""
                option "Static" "static"
                option "Dynamic" "dynamic"
                option "Open" "open"
            cell
              input "" a:read length 16 noeol
              note "*"
                title "List of users with '"+a:read+"' right"
                table columns 4
                  cell header [User]
                  cell header [Authentification mechanism]
                  cell header [Client IP]
                  cell header [Computers names]
                  each u user
                    each r u:right
                      if r:right=a:read
                        read_only
                          cell (text keyof:u)
                          cell
                            select "" r:auth
                              option "None" "0"
                              option "Clear password" "1"
                              option "Chalenge password" "2"
                              option "Strong crypto" "3"
                          cell
                            input "" r:ip length 16
                          cell
                            input "" r:server length 16
              if a:read="read" or a:read="write"
                eol ; highlight "You should not use 'read' or 'write' in configuration tables."
            cell
              input "" a:write length 16
              if a:write="read" or a:write="write"
                highlight "You should not use 'read' or 'write' in configuration tables."
            cell
              input "" a:root
            cell
              input "" a:style
            cell
              text a:style_options
              if a:style_options<>""
                eol
              button "edit"
                title "Style options for site '"+keyof:s+"' area '"+keyof:a+"'"
                text_input "Style options: " a:style_options columns 80 rows 15
                button "update"
                  goto_backward
            cell
              input "" a:forward
        if not ok
          [You have to create at least one area with path] ; fixed [ / ] ; [and with a non blank read right.] ; eol
        if allowed:"administrator"
          input "Area ID: " (var Str aid) noeol
          button "Create the new area" noeol
            s:area create aid
            reload_page
          button "Delete the area"
            s:area delete aid
            reload_page
          button "Update site informations"
            goto_backward

if allowed:"administrator"
  input "Site name: " (var Str sid) noeol
  button "Create the new site" noeol
    site create sid
    reload_page
  button "Delete the site"
    site delete sid
    site_secret_database:data:site delete sid
    reload_page

  page button "Test strong crypto access"
    var Str host := sid
    var CBool ok := true
    if user_secret_database:data:user:user_name:private_key=""
      text "You have no private key !" ; eol
      ok := false
    eif user:user_name:public_key=""
      text "You have no public key !" ; eol
      ok := false
    if site:host:public_key<>"" and name_database:data:host:host:public_key<>""
      text "'"+host+"' is defined both as a web site and as a host in the name database !" ; eol
      ok := false
    eif site:host:public_key="" and name_database:data:host:host:public_key=""
      text "This computer does not know '"+host+"' public key !" ; eol
      ok := false
    if net_ping:host=failure
      text "Cannot access '"+host+"' through the network !" ; eol
      ok := false
    else
      var Int port := name_database:data:host:host:http_port
      (var Stream tcp) open "tcp://"+host+"/client/"+(string 500+(shunt port=defined port 80)) in+out+safe
      if tcp=failure
        text "Secured HTTP server service is not running on "+host+" !" ; eol
        ok := false
      if tcp=success
        tcp writeline "server-site: "+base64_encode:host
        tcp writeline "client-user: "+base64_encode:user_name
        tcp writeline "query-server-key"
        tcp writeline "query-client-key"
        tcp writeline ""
        while { var Str l := tcp readline ; l<>"" }
          l parse "server-key" ":" any:(var Str server_public_key)
          l parse "client-key" ":" any:(var Str client_public_key)
        if server_public_key=site:host:public_key or server_public_key=name_database:data:host:host:public_key
          void
        eif site:host:public_key="" and name_database:data:host:host:public_key=""
          text host+" says that it's public key is: " ; eol
          fixed text:server_public_key ; eol
        eif server_public_key=""
          text "'"+host+"' does not have a public key !"
          ok := false
        else
          text "The public key of '"+host+"' on this computer seems to be wrong !" ; eol
          text "'"+host+"' says that it's public key is: " ; eol
          fixed text:server_public_key ; eol
          ok := false
        if client_public_key=user:user_name:public_key
          void
        eif user:user_name:public_key=""
          void # this computer has no public key
        eif client_public_key=""
          text "'"+host+"' does not know your public key !"
          ok := false
        else
          text "Your public key on '"+host+"' is wrong !" ; eol
          text "The right one is: " ; eol
          fixed (text user:user_name:public_key) ; eol
          ok := false
    if ok
      [Everything seems to be ok.]

para
  [The site name is the name you use in the browser to connect to it, without the port number.] ; eol
  [As an example, if the URL of the site is] ; fixed [ http://art.pliant.cx/ ] ; [then the name of the site is] ; fixed [ art.pliant.cx ]
  [and if the URL of the site is] ; fixed [ http://mysite.mycorp.com:8080/ ] ; [then the name of the site is] ; fixed [ mysite.mycorp.com] ; eol
para
  table columns 2 border 0
    cell
      table columns 1
        cell color (color hsl 120 25 80)
          fixed [ ]
    cell
      [A site with light green ground is a site that can be accessed on this computer.] ; eol
      [You should carrefully check it's various areas definition in order to verify that it does not introduce security holes on the computer.]
    cell
      table columns 1
        cell color (color hsl 120 10 80)
          fixed [ ]
    cell
      [A site with dull green ground is a site that can be accessed on this computer, but only by users having administrator rights and using Pliant secured channel.]

if allowed:"administrator"
  var CBool migrate := false
  each s site
    if s:computer=keyof:s
      migrate := true
  if migrate
    para
      page button "Migrate hosts definitions to the names database"
        each s site
          if s:computer=keyof:s
            name_database:data:host create keyof:s
            var Data:NameHost h :> name_database:data:host keyof:s
            h public_key := s public_key
            h http_port := shunt s:port=defined s:port (cast 80 Int)
            name_secret_database:data:host create keyof:s
            var Data:NameSecret hs :> name_secret_database:data:host keyof:s
            hs private_key := site_secret_database:data:site:(keyof s) private_key
            site delete keyof:s
            site_secret_database:data:site delete keyof:s
        reload_page