/[tcldrop]/tcldrop/modules/users/users.tcl
ViewVC logotype

Diff of /tcldrop/modules/users/users.tcl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by fireegl, Tue May 27 15:32:09 2003 UTC revision 1.9 by fireegl, Mon Jun 30 06:25:05 2003 UTC
# Line 3  Line 3 
3  # $Id$  # $Id$
4  #  #
5  # Copyright (C) 2003 FireEgl (Philip Moore) <FireEgl@Tcldrop.Tk>  # Copyright (C) 2003 FireEgl (Philip Moore) <FireEgl@Tcldrop.Tk>
6  #  #
7  # This program is free software; you can redistribute it and/or  # This program is free software; you can redistribute it and/or
8  # modify it under the terms of the GNU General Public License  # modify it under the terms of the GNU General Public License
9  # as published by the Free Software Foundation; either version 2  # as published by the Free Software Foundation; either version 2
10  # of the License, or (at your option) any later version.  # of the License, or (at your option) any later version.
11  #  #
12  # This program is distributed in the hope that it will be useful,  # This program is distributed in the hope that it will be useful,
13  # but WITHOUT ANY WARRANTY; without even the implied warranty of  # but WITHOUT ANY WARRANTY; without even the implied warranty of
14  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15  # GNU General Public License for more details.  # GNU General Public License for more details.
16  #  #
17  # You should have received a copy of the GNU General Public License  # You should have received a copy of the GNU General Public License
18  # along with this program (see gpl.txt); if not, write to the  # along with this program (see gpl.txt); if not, write to the
19  # Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.  # Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20  # Or visit http://www.GNU.Org/licenses/gpl.html  # Or visit http://www.GNU.Org/licenses/gpl.html
21  #  #
22  # The author of this project can be reached at FireEgl@Tcldrop.Tk  # The author of this project can be reached at FireEgl@Tcldrop.Tk
23  # Or can be found on IRC (EFNet or FreeNode) as FireEgl.  # Or can be found on IRC (EFNet or FreeNode) as FireEgl.
24  #  #
# Line 94  proc ::tcldrop::users::validuser {handle Line 94  proc ::tcldrop::users::validuser {handle
94  # Searches the user database for the handle that most closely matches $nuhost.  # Searches the user database for the handle that most closely matches $nuhost.
95  # Returns the matching handle, or "*" if none found.  # Returns the matching handle, or "*" if none found.
96  proc ::tcldrop::users::finduser {nuhost} {  proc ::tcldrop::users::finduser {nuhost} {
97            if {![string match {*!*} $nuhost]} { set nuhost "*!$nuhost" }
98          foreach a [binds finduser] {          foreach a [binds finduser] {
99                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
100                  if {[catch { $proc $nuhost } val]} {                  if {[catch { $proc $nuhost } val]} {
# Line 155  proc ::tcldrop::users::passwdok {handle Line 156  proc ::tcldrop::users::passwdok {handle
156  # Gets user related info:  # Gets user related info:
157  proc ::tcldrop::users::getuser {handle {type {}} {xtra {}}} {  proc ::tcldrop::users::getuser {handle {type {}} {xtra {}}} {
158          foreach a [binds getuser] {          foreach a [binds getuser] {
159                  foreach {type flags mask count proc} $a {}                  foreach {bindtype flags mask count proc} $a {}
160                  if {[catch { $proc $handle $type $xtra } val]} {                  if {[catch { uplevel \#0 $proc $handle $type $xtra } val]} {
161                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
162                          puterrlog "$::errorInfo"                          puterrlog "$::errorInfo"
163                          return -code error $val                          return -code error $val
164                    } else {
165                            return $val
166                  }                  }
                 return $val  
167          }          }
168          return -code error {No user database module has been loaded.}          return -code error {No user database module has been loaded.}
169  }  }
# Line 177  proc ::tcldrop::users::getuser {handle { Line 179  proc ::tcldrop::users::getuser {handle {
179  # It returns the new setting.  # It returns the new setting.
180  proc ::tcldrop::users::setuser {handle {type {}} {setting {}} {xtra {}}} {  proc ::tcldrop::users::setuser {handle {type {}} {setting {}} {xtra {}}} {
181          foreach a [binds setuser] {          foreach a [binds setuser] {
182                  foreach {type flags mask count proc} $a {}                  foreach {bindtype flags mask count proc} $a {}
183                  if {[set lev [catch { $proc $handle $type $setting $xtra } val]]} {                  if {[set lev [catch { $proc $handle $type $setting $xtra } val]]} {
184                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
185                          puterrlog "$::errorInfo"                          puterrlog "$::errorInfo"
186                  }                  }
187                    putlog "lev: $lev"
188                    putlog "val: $val"
189                  if {![info exists retval]} {                  if {![info exists retval]} {
190                          set retlev $lev                          set retlev $lev
191                          set retval $val                          set retval $val

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26