Patch title: Release 86 bulk changes
Abstract:
File: /pliant/fullpliant/user.page
Key:
    Removed line
    Added line
module "/pliant/language/stream.pli"
module "/pliant/admin/md5.pli"
module "/pliant/util/crypto/rsa.pli"
module "/pliant/util/crypto/legal.pli"
module "user.pli"
module "this_computer.pli"
module "login.pli"
module "/pliant/language/context.pli"

requires "browse_configuration"

method page detailed_history user day_count
  arg_rw HtmlPage page ; arg Str user ; arg Int day_count
  var DateTime now := datetime
  (var Stream s) open "data:/pliant/login/"+user in+safe
  while not s:atend
    var Str l := s readline
    if (l parse (var DateTime from) (var DateTime to) _ any:(var Str ip) _ any:(var Str comment))
      var Int old := now:date:days-from:date:days
      if old<day_count
        s unreadline l
        var Date day := from date
        if day_count=1
          [Today detailed history:]
        else
          fixed (text string:day)
          text " detailed history ("+string:old+" day"+(shunt old>1 "s" "")+" ago):"
        table columns 4
          cell header [From]
          cell header [To]
          cell header [IP address]
          cell header [comment]
          part scan_day
            while not s:atend
              var Str l := s readline
              if (l parse (var DateTime from) (var DateTime to) _ any:(var Str ip) _ any:(var Str comment))
                if from:date=day
                  cell text:((string from) 11 5)
                  cell text:((string to) 11 5)
                  cell (text ip)
                  cell (text comment)
                else
                  s unreadline l
                  leave scan_day
          var Data:User2 u :> user_database2:data:user user
          if u:from:date=day
            cell text:((string u:from) 11 5)
            cell text:((string u:to) 11 5)
            cell (text u:ip)
            cell (text u:comment)

title "Users administration"

para
  note "Users database client and server global settings for this computer"
    read_only not allowed:"administrator"
    title "This computer users databse settings"
    title "This computer users database settings"
    table columns 1
      cell header [Users database server computers]
      each s this_computer:env:"pliant":"password"
        if (keyof:s parse "server" any)
          cell
            text s
    table columns 1
      cell header [Users database client computers]
      each c this_computer:env:"pliant":"password"
        if (keyof:c parse "client" any)
          cell
            text c
    input "Computer name: " (var Str name) noeol
    button "Add server" noeol
      var Int num := 1
      while exists:(this_computer:env:"pliant":"password" "server"+string:num)
        num += 1
      this_computer "pliant" "password" "server"+string:num := name
      reload_page
    button "Remove server" noeol
      each s this_computer:env:"pliant":"password"
        if (keyof:s parse "server" any) and s=name
          this_computer:env:"pliant":"password" delete keyof:s
      reload_page
    button "Add client" noeol
      var Int num := 1
      while exists:(this_computer:env:"pliant":"password" "client"+string:num)
        num += 1
      this_computer "pliant" "password" "client"+string:num := name
      reload_page
    button "Remove client"
      each c this_computer:env:"pliant":"password"
        if (keyof:c parse "client" any) and c=name
          this_computer:env:"pliant":"password" delete keyof:c
      reload_page
    if allowed:"administrator"
      input "Computer name: " (var Str name) noeol
      button "Add server" noeol
        var Int num := 1
        while exists:(this_computer:env:"pliant":"password" "server"+string:num)
          num += 1
        this_computer "pliant" "password" "server"+string:num := name
        reload_page
      button "Remove server" noeol
        each s this_computer:env:"pliant":"password"
          if (keyof:s parse "server" any) and s=name
            this_computer:env:"pliant":"password" delete keyof:s
        reload_page
      button "Add client" noeol
        var Int num := 1
        while exists:(this_computer:env:"pliant":"password" "client"+string:num)
          num += 1
        this_computer "pliant" "password" "client"+string:num := name
        reload_page
      button "Remove client"
        each c this_computer:env:"pliant":"password"
          if (keyof:c parse "client" any) and c=name
            this_computer:env:"pliant":"password" delete keyof:c
        reload_page
    para
      [The rule is fairly simple: when a change is applied on a user account on one of the servers, it is automatically propagated to various clients.] ; eol
      [Changes to accounts with 'administrator' right are not propagated.]


[List of currently defined users:]

table columns 5
  cell header
    [User ID]
  cell header
    [First name]
  cell header
    [Name]
  cell header
    [Description]
  cell
    void
  each u user
    var Str id := keyof u
    cell
      text id
    cell
      text u:first_name
    cell
      text u:name
    cell
      text u:abstract
      if u:homepage<>""
        small
          eol ; link "Homepage" u:homepage
    cell
      page button "Edit"
        read_only not allowed:"administrator"
        title "User '"+id+"'"
        table columns 3 border 0
          cell
            [User ID:]
          cell
            fixed text:id
          cell
            [The string the user uses to authenticate in the computer.] ; eol
            [An example is] ; fixed [ helene.tonneau]
          cell
            [First name:]
          cell
            input "" u:first_name
          cell void
          cell
            [Name:]
          cell
            input "" u:name
          cell
            [The human readable name of the user.] ; eol
            [An example is] ; fixed [ H鬨ne Tonneau]
          cell
            [Email:]
          cell
            input "" u:email
          cell
            [You may leave it blank if you prefer.]
          cell
            [Home page:]
          cell
            input "" u:homepage
          cell
            [You may leave it blank if you prefer.]
          cell
            [Contact:]
          cell
            text_input "" u:contact rows 5 columns 40
          cell
            [Other ways to contact this user (phone, fax, postal address, ...)]
          cell
            [Password:]
          cell
            if allowed:"administrator"
              input "" (var Str password) password
          cell
            [In the users database, only the MD5 digest of the password is stored.]
          cell
            [Public key:]
          cell
            input "" u: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
                input "Key password: " (var Str password) password noeol
                button "Generate now"
                  rsa_generate "user:"+id bits password
                  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.]
              var Int bits := rsa_nbbits u:public_key
              if bits=defined
                small
                  eol ; [The current key is ] ; text string:bits ; [ bits wild.]
          cell
            []
          cell
            [Options:]
          cell
            input "" u:options length 40
          cell
            [Options might be parsed by some specific applications.]
          cell
            [Styling options:]
          cell
            input "" u:style_options length 40
          cell
            [More options used for specifying user viewing preferences.]
          cell
            [Unix user ID:]
          cell
            input "" u:uid
          cell
            []
          cell
            [Computer:]
          cell
            input "" u:computer
          cell
            [If you specify a Unix user ID and computer, then installed the specifyed computer with FullPliant, then a Unix user will be created.]
        table columns 2 border 0
          cell [Description:]
          cell (text_input "" u:abstract rows 5 columns 60)

        [The following table enables you to grant rights to the user:]
        table columns 5
          cell header [Line ID]
          cell header [Authentification mechanism]
          cell header [Client IP]
          cell header [Computers names]
          cell header [Granted right]
          cell header
            small
              [Must be unique, but does not have any meaning.]
          cell header
            small
              [The right will be granted only if the connection mecanism/protocol used by the user is at least as secured as the one specifyed here.]
          cell header
            small
              [If not empty, the right will be granted only if the user is connecting from within the specifyed IP areas.] ; eol
              note "extra details"
                title "Client IP field"
                [This is used to restrict the computers the user is allowed to connect from. ]
                [As an example, you may want to specify that a use can connect from the intranet, but not from the Internet.]
                para
                  [An axample can be:] ; fixed [ 127.0.0.1 10.30.144.0/255.255.255.0 ] ; eol
                  [and it means either 127.0.0.1 or 10.30.144.xxx IP address.]
          cell header
            small
              [If not empty, the right will be granted only if connecting to one of the listed servers.] ; eol
              note "extra details"
                title "Server names field"
                [You must list the real names of the server computers, not the logical names you use to access these.]
          cell header
            small
              [This is the name of the right you are granting to the user. It must match the name specifyed in the 'Read' column of the web sites areas configuration.] ; eol
              [See ] ; link "security section" "/pliant/protocol/http/" section "security" ; [ in the HTTP server documentation for predifined rights meanings.]
          each r u:right
            cell
              text keyof:r
            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
            cell
              input "" r:right
              if r:right="read" or r:right="write"
                highlight "You should not use 'read' or 'write' in configuration tables."
        if allowed:"administrator"
          input "Line ID: " (var Str rid) length 10 noeol
          button "Create one new line" noeol
            u:right create rid
            reload_page
          button "Delete the line"
            u:right delete rid
            reload_page

        [The following table enables you to assign maiboxes to this user so that he can use these from Pliant web site:]
        table columns 2
          cell header [Line ID]
          cell header [Mailbox]
          each m u:mailbox
            cell
              text keyof:m
            cell
              input "" m length 30
        if allowed:"administrator"
          input "Line ID: " (var Str mid) length 10 noeol
          button "Add a line" noeol
            u:mailbox create mid
            reload_page
          button "Remove a line"
            u:mailbox delete mid
            reload_page
  
          para
            page button "Update user informations"
              if password<>""
                user_secret_database:data:user create id
                user_secret_database:data:user:id password_md5 := string_md5_hexa_signature password
              var CBool ok := true
              each c this_computer:env:"pliant":"password"
                if (keyof:c parse "client" any) and c<>computer_fullname
                  if (user_update id u:first_name u:name u:abstract user_secret_database:data:user:id:password_md5 c)=failure
                    text "Failed to forward changes to server "+c ; eol
                    ok := false
              if ok
                goto_backward
          para
            var Int dc := 7
            button "Display '"+id+"' log history" noeol
              title (string dc)+" days history for '"+id+"' account"
              detailed_history id dc
            input " on " dc length 2 noeol ; [ days]

if allowed:"administrator"
  input "User ID: " (var Str uid) noeol
  button "Create the new user" noeol
    user create uid
    user_database2:data:user create uid
    user_secret_database:data:user create uid
    reload_page
  page button "Delete the user"
    var CBool ok := true
    each c this_computer:env:"pliant":"password"
      if (keyof:c parse "client" any) and c<>computer_fullname
        if (user_delete uid c)=failure
          text "Failed to delete '"+uid+"' user on server "+c ; eol
          ok := false
    if ok
      user delete uid
      user_database2:data:user delete uid
      user_secret_database:data:user delete uid
      reload_page
    else
      data_reset user_database:data:user:uid:right

para
  input "Right: " (var Str right) noeol
  button "Find users having this right"
    title "List of users with '"+right+"' 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=right
            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 not (exists user:"anonymous")
  para
    [You should create an] ; fixed [ anonymous ] ; [user for defining the rights users that are not logged in are granted.] ; eol