Patch title: Release 92 bulk changes
Abstract:
File: /protocol/http/login.pli
Key:
    Removed line
    Added line
   
module "/pliant/protocol/http/server.pli"
module "/pliant/protocol/http/style/default.style"
module "/pliant/language/stream.pli"
module "/pliant/language/context.pli"
module "/pliant/fullpliant/this_computer.pli"
module "/pliant/fullpliant/user.pli"
module "/pliant/fullpliant/login.pli"
module "/pliant/admin/md5.pli"
module "/pliant/util/crypto/intn.pli"
module "/pliant/util/crypto/rsa.pli"


method page login_request
  arg_rw HtmlPage page
  page goto_url "/login "+page:user_name no_extension


method page login_create_account
  arg_rw HtmlPage page
  implicit page
    input "User ID: " (var Str id)
    input "Real first name: " (var Str first_name) noeol
    input " and name: " (var Str name)
    [New user description:] ; eol
    text_input "" (var Str abstract) columns 60 rows 10
    input "Email: " (var Str email)
    input "Clear password: " (var Str password) password
    input "Public key: " (var Str key) length 60
    button "Create the new account now"
      title "Account creation report"
      if id=""
        [You must provide a user ID.]
      eif name=""
        [You must provide a real name, and you are praised to provide the right one.]
      eif (exists user:id)
        fixed text:id ; [ already exists on this server.]
      eif key<>"" and rsa_nbbits:key<256
        [The public key is too short.]
      eif key<>"" and rsa_nbbits:key>1024
        [The public key is too long.]
      else
        user create id
        user:id first_name := first_name
        user:id name := name
        user:id abstract := abstract
        user:id email := email
        if password<>""
          user_secret_database:data:user create id
          user_secret_database:data:user:id password_md5 := string_md5_hexa_signature password
        if key<>""
          user:id public_key := key
        [Welcome to '] ; text name ; ['.]


method page login_change_password
  arg_rw HtmlPage page
  implicit page
    title "Change '"+user_name+"' password"
    input "Enter old password: " (var Str old) password
    input "Enter new password: " (var Str new) password
    input "Enter new password once again: " (var Str new2) password
    button "Change the password now"
      if user_secret_database:data:user:user_name:password_md5<>string_md5_hexa_signature:old
        text "Old password is incorrect !"
      eif new2<>new
        text "The new password is not correct !"
      else
        var Str md5 := string_md5_hexa_signature new
        user_secret_database:data:user:user_name password_md5 := md5
        var CBool ok := true
        each c this_computer:env:"pliant":"password"
          if (keyof:c parse "client" any) and c<>computer_fullname
            if (user_change_password user_name md5 c)=failure
              text "Failed to change password on server "+c ; eol
              ok := false
        if ok
          goto_backward 2

method page login_generate_passwords
  arg_rw HtmlPage page
  implicit page
    each p user_secret_database:data:user:user_name:password_list
      user_secret_database:data:user:user_name:password_list delete keyof:p
    [Here is your new passwords list:] ; eol
    for (var Int l) 1 50
      var Intn r := random 34n^8
      var Str pass := ""
      for (var Int i) 1 8
        pass += "0123456789abcdefghijkmnpqrstuvwxyz" (cast r%34 Int)
        r \= 34
      var Str id := generate_id
      user_secret_database:data:user:user_name:password_list create id
      user_secret_database:data:user:user_name:password_list id := string_md5_hexa_signature pass
      fixed text:pass ; eol
    button "Ok I've printed it"
      goto_backward 2
    para
      [Passwords contain no 'o' and no 'l' letters, so if you wonder if something is an 'o' letter or a zero, then it is a zero, and if you wonder if something is an 'l' or a one, then it is a one.]

method page login_burn_password
  arg_rw HtmlPage page
  implicit page
    part burn_one
      each p user_secret_database:data:user:user_name:password_list
        user_secret_database:data:user:user_name:password_md5 := p
        user_secret_database:data:user:user_name:password_list delete keyof:p
        leave burn_one
    var Str md5 := user_secret_database:data:user:user_name password_md5
    var CBool ok := true
    each c this_computer:env:"pliant":"password"
      if (keyof:c parse "client" any) and c<>computer_fullname
        if (user_change_password user_name md5 c)=failure
          text "Failed to change password on server "+c ; eol
          ok := false
    if ok
      goto_backward


method page login_display_history user day_count
  arg_rw HtmlPage page ; arg Str user ; arg Int day_count
  implicit page
    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
          para
            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)

method page login_display_history user
  arg_rw HtmlPage page ; arg Str user
  implicit page
    var DateTime now := datetime
    text "Seven days login history summary:" ; eol
    table columns 4
      cell header [Day]
      cell header [First access]
      cell header [Last access]
      cell header [IP addresses]
      (var Stream s) open "data:/pliant/login/"+user_name in+safe
      for (var Int i) 6 0 step -1
        (var DateTime ts) seconds := now:seconds-i*86400
        var DateTime first_from := undefined ; var DateTime last_to := undefined
        var Str ips := ""
        part day_scan
          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=ts:date
                if first_from=undefined
                  first_from := from
                last_to := to
                if (" "+ips+" " search " "+ip+" " -1)=(-1)
                  ips += (shunt ips<>"" " " "")+ip
              eif from:date>ts:date
                s unreadline l
                leave day_scan
        var Data:User2 u :> user_database2:data:user user_name
        if u:from:date=ts:date
          if first_from=undefined
            first_from := u from
          last_to := u to
          if (" "+ips+" " search " "+u:ip+" " -1)=(-1)
            ips += (shunt ips<>"" " " "")+u:ip
        if first_from=defined
          cell text:(string first_from:date)
          cell text:((string first_from) 11 5)
          cell text:((string last_to) 11 5)
          cell text:ips


method page login_manage_account options
  arg_rw HtmlPage page ; arg Str options
  implicit page
    if user_name=""
      return
    if options="" or (options option "password")
      para
        button "Change password"
          login_change_password
        button "Generate passwords list"
          login_generate_passwords
        var Int count := user_secret_database:data:user:user_name:password_list:size
        if count>0
          text "You still have "+string:count+" password"+(shunt count>1 "s" "")+" in your list." ; eol
          button "Burn current password" noeol
            login_burn_password
    if options="" or (options option "summary")
      para
        login_display_history user_name
    if options="" or (options option "today")
      para
        [Today detailed history:]
        login_display_history user_name 1
    if options="" or (options option "history")
      para
        var Int dc := 7 ; input "Display " dc length 2 noeol
        [ days ]
        button "detailed history"
          title (string dc)+" days history for '"+user_name+"' account"
          login_display_history user_name dc

method page login_manage_account
  arg_rw HtmlPage page
  page login_manage_account ""


export '. login_request'
export '. login_create_account'
export '. login_change_password' '. login_generate_passwords' '. login_burn_password'
export '. login_display_history'
export '. login_manage_account'