userid

CMcC: This is a critcl rendering of some TclX functions useful under Unix.
package provide userid 1.0
    
critcl::ccode {
    #include <pwd.h>
    #include <grp.h>
    #include <unistd.h>
    #include <sys/types.h>
    #include <time.h>
    #include <tcl.h>
    
    static int confNGroups = -1;
    
    static int UsernameToUseridResult (Tcl_Interp *interp, char *userName)
    {
        struct passwd *pw = getpwnam (userName);
        Tcl_Obj       *resultObj = Tcl_GetObjResult (interp);
    
        if (pw == NULL) {
            Tcl_AppendStringsToObj (resultObj,
                                    "unknown user id: ", 
                                    userName, 
                                    (char *) NULL);
            endpwent ();
            return TCL_ERROR;
        }
        Tcl_SetObjResult (interp, Tcl_NewIntObj (pw->pw_uid));
        endpwent ();
        return TCL_OK;
    }
    
    static int UseridToUsernameResult (Tcl_Interp *interp, int userId)
    {
        uid_t          uid = (uid_t) userId;
        struct passwd *pw = getpwuid (userId);
        Tcl_Obj       *resultObj = Tcl_GetObjResult (interp);
        char          userIdString[16];
    
        if ((pw == NULL) || ((int) uid != userId)) {
            sprintf (userIdString, "%d", uid);
            Tcl_AppendStringsToObj (resultObj, 
                "unknown user id: ",
                userIdString,
                NULL);
            endpwent ();
            return TCL_ERROR;
        }
        Tcl_AppendToObj (resultObj, pw->pw_name, -1);
        endpwent ();
        return TCL_OK;
    }
    
    static int GroupnameToGroupidResult (Tcl_Interp *interp, char *groupName)
    {
        struct group  *grp = getgrnam (groupName);
        Tcl_Obj       *resultObj = Tcl_GetObjResult (interp);
        if (grp == NULL) {
            Tcl_AppendStringsToObj (resultObj, 
                                    "unknown group id: ",
                                    groupName,
                                    (char *) NULL);
            return TCL_ERROR;
        }
        Tcl_SetIntObj (resultObj, grp->gr_gid);
        return TCL_OK;
    }
    
    static int GroupidToGroupnameResult (Tcl_Interp *interp, int groupId)
    {
        gid_t          gid = (gid_t) groupId;
        struct group  *grp = getgrgid (groupId);
        Tcl_Obj       *resultObj = Tcl_GetObjResult (interp);
        char          groupIdString[16];
    
        sprintf (groupIdString, "%d", gid);
    
        if ((grp == NULL) || ((int) gid != groupId)) {
            Tcl_AppendStringsToObj (resultObj, 
                                    "unknown group id: ", 
                                    groupIdString,
                                    (char *)NULL);
            endgrent ();
            return TCL_ERROR;
        }
        Tcl_AppendToObj (resultObj, grp->gr_name, -1);
        endgrent ();
        return TCL_OK;
    }
}

critcl::cproc id_convert_user {Tcl_Interp* interp char* name} ok {
    return UsernameToUseridResult (interp, name);
}
critcl::cproc id_convert_userid {Tcl_Interp* interp int uid} ok {
    return UseridToUsernameResult (interp, uid);
}
critcl::cproc id_convert_group {Tcl_Interp* interp char* name} ok {
    return GroupnameToGroupidResult (interp, name);
}
critcl::cproc id_convert_groupid {Tcl_Interp* interp int gid} ok {
    return GroupidToGroupnameResult (interp, gid);
}

critcl::cproc id_effective_user {Tcl_Interp* interp} ok {
    return UseridToUsernameResult (interp, geteuid ());
}

critcl::cproc id_effective_userid {Tcl_Interp* interp} ok {
    Tcl_SetObjResult (interp, Tcl_NewIntObj (geteuid ()));
    return TCL_OK;
}

critcl::cproc id_user {Tcl_Interp* interp} ok {
    return UseridToUsernameResult (interp, getuid ());
}

critcl::cproc id_userid {Tcl_Interp* interp} ok {
    Tcl_SetObjResult (interp, Tcl_NewIntObj (getuid ()));
    return TCL_OK;
}

critcl::cproc id_set_userid {Tcl_Interp* interp int uid} ok {
    if (setuid ((uid_t) uid) < 0) {
        Tcl_AppendStringsToObj (
                Tcl_GetObjResult (interp),
                Tcl_PosixError (interp), (char *) NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}
    
critcl::cproc id_effective_group {Tcl_Interp* interp} ok {
    return GroupidToGroupnameResult (interp, getegid ());
}

critcl::cproc id_effective_groupid {Tcl_Interp* interp} ok {
    Tcl_SetObjResult (interp, Tcl_NewIntObj (getegid ()));
    return TCL_OK;
}

critcl::cproc id_group {Tcl_Interp* interp} ok {
    return GroupidToGroupnameResult (interp, getgid ());
}

critcl::cproc id_groupid {Tcl_Interp* interp} ok {
    Tcl_SetObjResult (interp, Tcl_NewIntObj (getgid ()));
    return TCL_OK;
}

critcl::cproc id_set_groupid {Tcl_Interp* interp int gid} ok {
    if (setgid ((uid_t) gid) < 0) {
        Tcl_AppendStringsToObj (
                Tcl_GetObjResult (interp),
                Tcl_PosixError (interp), (char *) NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}

critcl::cproc id_process {Tcl_Interp* interp} ok {
    Tcl_SetObjResult (interp, Tcl_NewIntObj (getpid ()));
    return TCL_OK;
}

critcl::cproc id_process_parent {Tcl_Interp* interp} ok {
    Tcl_SetObjResult (interp, Tcl_NewIntObj (getppid ()));
    return TCL_OK;
}
critcl::cproc id_process_group {Tcl_Interp* interp} ok {
    Tcl_SetObjResult (interp, Tcl_NewIntObj (getpgrp ()));
    return TCL_OK;
}

critcl::cproc id_process_group_set {Tcl_Interp* interp int pgid} ok {
    int pid;
    if (Tcl_IsSafe (interp)) {
        Tcl_AppendStringsToObj (
                Tcl_GetObjResult (interp),
                "can't set process group from a ",
                "safe interpeter", (char *) NULL);
        return TCL_ERROR;
    }

    pid = getpid ();
    setpgid (pid, pgid);
    return TCL_OK;
}

critcl::cproc id_host {Tcl_Interp* interp} ok {
    #ifndef MAXHOSTNAMELEN
    #  define MAXHOSTNAMELEN 256
    #endif
    char hostNameBuf[MAXHOSTNAMELEN];

    if (gethostname (hostNameBuf, MAXHOSTNAMELEN) < 0) {
        Tcl_AppendStringsToObj (
                Tcl_GetObjResult (interp),
                Tcl_PosixError (interp),
                (char *) NULL);
        return TCL_ERROR;
    }

    hostNameBuf[MAXHOSTNAMELEN-1] = '\0';
    Tcl_SetObjResult (interp, Tcl_NewStringObj (hostNameBuf, -1));
    return TCL_OK;
}

critcl::cproc id_groupids {Tcl_Interp* interp} ok {
    gid_t *groups;
    int nGroups, groupIndex;
    Tcl_Obj          *newObj;
    Tcl_Obj  *resultObj = Tcl_GetObjResult (interp);
    
    if (confNGroups < 0)
        confNGroups = sysconf (_SC_NGROUPS_MAX);
    groups = (gid_t *) ckalloc (confNGroups * sizeof (gid_t));

    nGroups = getgroups (confNGroups, groups);
    if (nGroups < 0) {
            Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
                Tcl_PosixError (interp), (char *) NULL);
        ckfree ((char *) groups);
        return TCL_ERROR;
    }

    for (groupIndex = 0; groupIndex < nGroups; groupIndex++) {
            newObj = Tcl_NewIntObj(groups[groupIndex]);
            Tcl_ListObjAppendElement (interp,  resultObj, newObj);
    }

    ckfree ((char *) groups);
    return TCL_OK;
}
Category System Administration
Category Critcl