# $Id: s.PlaceAccessControl.xotcl 1.7 01/03/23 21:55:32+01:00 neumann@somewhere.wu-wien.ac.at $
package provide xotcl::actiweb::placeAccessControl 0.8

package require xotcl::comm::httpd
package require xotcl::actiweb::httpPlace

#
# Simple Object Pwd Protection with BasicAccessControl
#
#Usage example:
#ConferenceOrgPlace confPlace -port $placeport -root [pwd] \
#  -mixin PlaceAccessControl
#
#confPlace protect conference.html [confData set password]
#
#confPlace setPasswd conference.html xxx

Class ObjectAccessControl -superclass BasicAccessControl

ObjectAccessControl instproc protectedResource {fn method varAuthMethod varRealm} {
  # check whether access to $fn via $method is protected
  upvar [self callinglevel] $varAuthMethod authMethod $varRealm realm
  my instvar root
  # we check only the current directory, not the parent directories
  set call [url decodeItem $fn]
  regsub "^$root" $call "" call
  set call [string trimleft $call /]
  set call [string trimleft $call :]
  regexp {^([^ ]*)} $call _ call
  set call "$root/$call"

  foreach i [list $call $call:$method] {
    #puts stderr "check <$i>"
    if {[my exists protected($i)]} {
      set realm [my set protected($i)]
      set authMethod Basic
      return 1
    }
  }
  return 0
}

Class PlaceAccessControl
PlaceAccessControl instproc init args {
  next
  [self]::httpd mixinappend ObjectAccessControl
  [self]::httpd initWorkerMixins
}

PlaceAccessControl instproc protect {objName id pwd} {
  set objName [string trimleft $objName :]
  [self]::httpd protectDir $objName $objName {}
  if {$pwd != ""} {
    my setPassword $objName $id $pwd
  } 
}

PlaceAccessControl instproc credentialsNotOk {credentials authMethod realm} {
  #my instvar passwd
  #parray passwd
  next
}

PlaceAccessControl instproc setPassword {realm id pwd} {
  set httpd [self]::httpd 
  if {[$httpd exists passwd($realm:$id)]} {
    $httpd unset passwd($realm:$id)
    $httpd set passwd($realm:$id) $pwd
  } else {
    $httpd addRealmEntry $realm "$id $pwd"
  }
  #$httpd set passwd($realm:admin) nimda
}
PlaceAccessControl instproc removeID {realm id} {
  set httpd [self]::httpd
  if {[$httpd exists passwd($realm:$id)]} {
    $httpd unset passwd($realm:$id)
  }
}

