DOC HOME SITE MAP MAN PAGES GNU INFO SEARCH PRINT BOOK
 
OSA reference

Example helper functions and procedures (Tcl)

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 }


Next topic: Example request processors
Previous topic: Example helper functions and procedures (C/C++)

© 2005 The SCO Group, Inc. All rights reserved.
SCO OpenServer Release 6.0.0 -- 03 June 2005