|
|
The following procedures that cover the same functions in ``Example helper functions and procedures (C/C++)'' written in Tcl.
GetUserInformationFromPasswdFile
#=========================================================================== # OSA Helper Function: GetUserInformationFromPasswdFile -- # # This OSA helper routine looks up a user in the /etc/passwd file. It then # turns all the data there into a list of user information. # # Parameters: # userName - the user that this function will work on. # # Returns: # A seven element list from /etc/passwd: # 0 - the user name, same as that argument given to this function # 1 - user's encrypted password, often just a mark if security is turned on # 2 - user's USERID # 3 - user's primary GROUPID # 4 - user's real name # 5 - user's home directory # 6 - user's shell # #---------------------------------------------------------------------------proc GetUserInformationFromPasswdFile {userName} {
# # open /etc/passwd and get the $object's line #
set fileName [open /etc/passwd]
while {[gets $fileName tmpName] != -1} { if {1 == [regexp "^$userName:" $tmpName]} { close $fileName return [split $tmpName :] } }
close $fileName error "\"$userName\" not found in /etc/passwd" }
GetUsersGroupListFromGroupFile
#=========================================================================== # OSA Helper Function: GetUsersGroupListFromGroupFile -- # # This routine looks up a user in the /etc/group file, then # forms an list of all the groups that the user belongs to. # # Parameters: # userName - the user that this function will work on. # # Returns: # an ASCII-sorted list of all the group GROUPIDs that the user belongs to. # #---------------------------------------------------------------------------proc GetUsersGroupListFromGroupFile {userName} {
# # Open up /etc/group and scan each line for the # $object, if that line contains it, then include # that line's groupId number in what we return. #
set usersGroups {} set fileName [open /etc/group]
while {[gets $fileName tmpName] != -1} { set tmpName [split $tmpName :] set groupUsers [split [lindex $tmpName 3] ,] if {[lsearch $groupUsers $userName] != -1} { lappend usersGroups [lindex $tmpName 2] } }
close $fileName
return [lsort $usersGroups] }
user_get
#=========================================================================== # OSA Operation: user_get -- # # This function returns to the caller the value of the specified object's # specified attribute. The attribute should not be accompanied by any value. # # Parameters: # class - the name of the class that the object is a member of. # object - the object instance that this function will work on. # objectRef - object a create will use as a template to base the # current object on. If the operation is not a create # operation, this field will be left empty. # operation - the operation involved. This should always be get. # subOperation - this is only used by action and filter operations, as # it indicates what action or filter is being performed. # filterValue - this field is used by FILTER and ACTION Tcl procs; # it will not be used by user_get(). # attribute - the attribute whose value is requested. # paramList - the complete attribute parameter list that was put # on the command line. If for any reason the value of # the object's attribute is dependent on what other # attributes were listed on the line, look at this list # for those attributes and their values. # # Returns: # a list of attribute/value pairs. In the case of user_get() the function # is called only once per attribute per object, so there will be only one # element in the returned list: that of get and its value. # #---------------------------------------------------------------------------proc user_get { class object objectRef operation subOperation filterData attribute paramList osaData } {
# # The following helper routine will return the $object's entry from # the /etc/passwd file in the form of a list of 7 elements: # # objectName securityMark USERID mainGroupId # realName homeDirectory loginShell #
if {[catch { GetUserInformationFromPasswdFile $object } userAttrs] != 0} { error $userAttrs {$attribute {}} }
# # for all cases except for groupId just return the proper field. #
case $attribute { userName {set returnedAttributeValue $object} userId {set returnedAttributeValue [lindex $userAttrs 2]} groupId { set returnedAttributeValue [GetUsersGroupListFromGroupFile $object] } homeDirectory {set returnedAttributeValue [lindex $userAttrs 5]} loginShell {set returnedAttributeValue [lindex $userAttrs 6]} realLifeName {set returnedAttributeValue [lindex $userAttrs 4]} }
return {[list $attribute $returnedAttributeValue]} }
OSA Filter
#=========================================================================== # OSA Filter # # This function evaluates whether the data passed to it is matched to # the data contained by the attribute passed to it by the indicated function. # # Parameters: # class - the name of the class that the object is a member of. # object - the object instance that this function will work on. # objectRef - object a create will use as a template to base the # current object on. If the operation is not a create # operation, this field will be left empty. # operation - the operation involved. This should always be filter. # subOperation - this is only used by action and filter operations # as it indicates what action or filter is being performed. # For a filter it will contain the comparison # function being performed. # filterValue - this contains a list off the data that the named attribute # will be compared against by the subOperation function. # attribute - the attribute whose value is requested. # paramList - this field is only used by operations and should be # ignored in filter procedures. # # Returns: # a list of attribute/value pairs. In the case of user_get() the function # is called only once per attribute per object, so there will be only one # element in the returned list: that of get and its value. # # Returns: # A boolean TRUE if the specified data and the attribute's data are logically # equivalent. Otherwise the keyword FALSE should be returned. Only the eq # (equivalence) and subset operators are implemented in this function. # #---------------------------------------------------------------------------proc user_filter { class object objectRef operation subOperation filterData attribute paramList osaData } {
# # if we are given a set/array of data, then sort it, otherwise turn # it into a single value for the single datatype attributes to # compare against. #
if {[llength $filterData] == 1} then { set dataValue [lindex $filterData 0] } else { set dataValue [lsort $filterData] }
# # The following helper routine will return the $object's entry from # the /etc/passwd file in the form of a list of 7 elements: # # objectName securityMark USERID mainGroupId # realName homeDirectory loginShell #
set userAttrs [GetUserInformationFromPasswdFile $object]
# only the eq and subset functions are implemented in this example.
case $subOperation { subset { # # only works for the groupId attribute # case $attribute { groupId { set usersGroups [GetUsersGroupListFromGroupFile $object] foreach loop $dataValue { if {[lsearch $usersGroups $loop] == -1} { return FALSE } } return TRUE } # # if not the groupId attribute, return an error. # default { error "filter function \"$subOperation\" not implemented for\ attribute \"$attribute\"." } } } eq { # # for all cases except for groupId just compare to the proper # field. # case $attribute { userId { if {[lindex $userAttrs 2] == $dataValue} { return TRUE } { return FALSE } } groupId { set usersGroups [GetUsersGroupListFromGroupFile $object] if {$usersGroups == $dataValue} { return TRUE } { return FALSE } } loginShell { if {[lindex $userAttrs 6] == $dataValue} { return TRUE } { return FALSE } } realLifeName { if {[lindex $userAttrs 4] == $dataValue} { return TRUE } { return FALSE } } default { error "filter function \"$subOperation\" not \ implemented for attribute \"$attribute\"." } } } }
error "filter function \"$subOperation\" unsupported in class \"$class\"" }
OSA List
#=========================================================================== # OSA List # # This function returns the list of objects of the current (subordinate) # class that are contained by the named object instance (of the superior # class). # # Parameters: # class - the name of the class that the object is a member of, this will # be the subordinate class. # object - the object instance that contains instances of the subordinate # class. This object instance is a member of the superior class. # operation - the operation involved. This should always be list. # # Returns: # The list of all objects of the current (subordinate) class that are # contained by the give object instance. In this example, as in many # contained/list functions, the function does not care what the object # instance of the superior class was; this is just a way to provide # the caller with a list of all the object instances of this class on # this machine. In other examples there would be persistent storage # databases that would indicate what objects contained what objects. # #---------------------------------------------------------------------------proc user_list { class object objectRef operation subOperation filterData attribute paramList handle } { set objectList [GetListOfAllUsers] return $objectList }