Patch title: Release 90 bulk changes
Abstract:
File: /fullpliant/login.pli
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "/pliant/language/stream.pli"
module "/pliant/fullpliant/user.pli"

module "/pliant/fullpliant/this_computer.pli"
module "/pliant/util/remote/client.pli"
module "/pliant/admin/md5.pli"


type LoginSlice
  field DateTime from to
  field Str ip comment

gvar (Dictionary Str LoginSlice) slice
gvar Sem slice_sem
gvar DateTime purged_on := datetime


function write_down u
  arg_rw Data:User2 u
  (var Stream s) open "data:/pliant/login/"+keyof:u append+mkdir+safe
  s writeline (string u:from)+" "+(string u:to)+" "+u:ip+" "+u:comment
  s close

function login_record user ip comment -> accepted
  arg Str user ip comment ; arg CBool accepted
  accepted := true
  plugin login
  var DateTime now := datetime
  # first try with read only lock, even if we might update the data
  slice_sem rd_request
  var Pointer:LoginSlice s :> slice first user
  if exists:s and s:ip=ip and s:comment=comment
    if now:seconds-s:to:seconds<60
      # less than one minute, do nothing
      slice_sem rd_release
      return
    if now:seconds-s:to:seconds<3600 and s:to:date=now:date
      # more than one minute, just update the 'to' field
      s to := now
      var Data:User2 u :> user_database2:data:user user
      u to := now
      slice_sem rd_release
      return
  slice_sem rd_release
  # start a new slice
  var Data:User2 u :> user_database2:data:user user
  if not exists:u
    user_database2:data:user create user
    u :> user_database2:data:user user
  slice_sem request
  var Pointer:LoginSlice s :> slice first user
  if exists:s
    if s:ip=ip and s:comment=comment and now:seconds-s:to:seconds<60
      # another thread got in between semaphore rd_release and request
      slice_sem release
      return  
    write_down u
  else  
    slice insert user (var LoginSlice empty_slice)
    s :> slice first user
  s from := now
  s to := now
  s ip := ip
  s comment := comment
  u from := now
  u to := now
  u ip := ip
  u comment := comment
  if now:seconds-purged_on:seconds>3600
    var Pointer:LoginSlice s :> slice first
    while exists:s
      if now:seconds-s:to:seconds<3600
        s :> slice next s
      else
        write_down (user_database2:data:user (slice key s))
        var Data:User2 u :> user_database2:data:user (slice key s)
        u from := undefined
        s :> slice remove s
    purged_on := datetime
  slice_sem release


function startup
  each u user_database2:data:user
    if u:from=defined
      write_down u
      u from := undefined
startup


function is_administrator user -> admin
  arg Str user ; arg CBool admin
  var Data:User u :> user_database:data:user user
  each r u:right
    if r:right="administrator"
      return true
  each t u:template
    each r user_database:data:user:t:right
      if r:right="administrator"
        return true
  admin := false

function is_password_server host -> pp
  arg Str host ; arg CBool pp
  each server this_computer:env:"pliant":"password"
    if (keyof:server parse "server" any)
      if server=host
        return true
  pp := false

function user_update user first_name name abstract password_md5 server -> status
  arg Str user first_name name abstract password_md5 server ; arg Status status
  remote server
    control c is_password_server:c
    control c not is_administrator:user
    share status
    user_database:data:user create user
    user_database2:data:user create user
    user_secret_database:data:user create user
    var Data:User u :> user_database:data:user user
    u first_name := first_name
    u name := name
    u abstract := abstract
    user_secret_database:data:user:user password_md5 := password_md5
  local_streaming s
    each r user_database:data:user:user:right
      s writeline "right "+(string keyof:r)+" "+(string r:auth)+" "+(string r:ip)+" "+(string r:server)+" "+(string r:right)
    each t user_database:data:user:user:template
      s writeline "template "+(string keyof:t)+" "+string:t
  remote_streaming s
    var Data:User u :> user_database:data:user user
    var (Dictionary Str Void) lines
    var (Dictionary Str Void) lines templates
    while not s:atend
      if (s:readline parse "right" (var Str id) (var Str auth) (var Str ip) (var Str server) (var Str right)) and right<>"administrator"
        u:right create id
        var Data:UserRight r :> u:right id
        r auth := auth+"3" 0 ; r ip := ip ; r server := server ; r right := right
      if (s:readline parse "right" (var Str id) (var Str auth) (var Str ip) (var Str server) (var Str right))
        if right<>"administrator"
          u:right create id
          var Data:UserRight r :> u:right id
          r auth := auth+"3" 0 ; r ip := ip ; r server := server ; r right := right
        lines insert id void
      eif (s:readline parse "template" (var Str id) (var Str template))
        if not is_administrator:template
          u:template create id
          u:template id := template
        templates insert id void
    each r u:right
      if not exists:(lines first keyof:r)
        u:right delete keyof:r
    each t u:template
      if not exists:(templates first keyof:t)
        u:template delete keyof:t
  success
    status := success
  failure
    status := failure

function user_change_password user password_md5 server -> status
  arg Str user password_md5 server ; arg Status status
  remote server
    control c is_password_server:c
    control c not is_administrator:user
    share status
    user_secret_database:data:user:user password_md5 := password_md5
  success
    status := success
  failure
    status := failure

function user_delete user server -> status
  arg Str user server ; arg Status status
  remote server
    control c is_password_server:c
    control c not is_administrator:user
    share status
    user_database:data:user delete user
    user_database2:data:user delete user
    user_secret_database:data:user delete user
  success
    status := success
  failure
    status := failure


export login_record
export user_update user_change_password user_delete