From xemacs-m  Sun Jul 27 15:41:14 1997
Received: from bittersweet.inetarena.com (karlheg@bittersweet.inetarena.com [206.129.216.38])
	by xemacs.org (8.8.5/8.8.5) with ESMTP id PAA12094
	for <xemacs-beta@xemacs.org>; Sun, 27 Jul 1997 15:41:07 -0500 (CDT)
Received: (from karlheg@localhost)
	by bittersweet.inetarena.com (8.8.5/8.8.5) id NAA26192;
	Sun, 27 Jul 1997 13:41:13 -0700
To: XEmacs Beta <xemacs-beta@xemacs.org>
Subject: Namespace pollution problems, efs, and cl-macs ???
X-Face: /Q}=yl}1_v7nP)xXo5XjG8+tl@=uVu7o5u6)f]zN?+<hB!K.m9:[|*p34jVN`O;:XZXVSy>/\R>qDt(t8w!-i{(y0"`jFw^uk8inzO9wXabd'CdjUWfC\GHi:6nO*YC89#-qD>Q4r%9!V"<RYJ=7D#$";q=zML5'!=wvXk^$`6FT=5CMofQX)WUKt0p:OKl.mFOXx/D
Mime-Version: 1.0 (generated by tm-edit 7.108)
Content-Type: multipart/mixed;
 boundary="Multipart_Sun_Jul_27_13:41:11_1997-1"
Content-Transfer-Encoding: 7bit
From: karlheg+xemacs@inetarena.com (Karl M. Hegbloom)
Date: 27 Jul 1997 13:41:12 -0700
Message-ID: <87k9ickz2v.fsf@bittersweet.inetarena.com>
Lines: 309
X-Mailer: Gnus v5.4.63/XEmacs 20.3(beta14) - "Vienna"

--Multipart_Sun_Jul_27_13:41:11_1997-1
Content-Type: text/plain; charset=US-ASCII

 I'm having trouble with a program I'm writing, which is tickling a
bug in XEmacs, (?) cl-macs, (?) efs, and maybe (?) gnus.  The
beginnings of the program are attached, so you can look it over and
try to reproduce the problem.  I'm not sure what might be happening,
or even how to go about tracking it down.  *I think it's namespace*
*and scoping problems, internal to efs and cl-macs.*

 The program uses the cl `defstruct', and works fine, on local files,
but causes a strange error when efs is called upon.  At one point, I
got it to work somehow; I'm not sure what I did.  I think it had to do
with using C-x C-f to get an ftp connection started, and once one was
alive, it worked from within the program.  I had to type my password,
when usually I don't, as it's in my .netrc file. `efs' was behaving
strangely; it took several tries to get connected, when usually it
works right away. That instance of XEmacs is still running, and it
will run my function, but when I started Gnus and tried to write a
message, C-c C-c blonked with the error message shown below.  I cannot
get the program to work again in a new XEmacs at all, except on local
files.

 It's always the same error message, for each thing I do that blonks;
both the retrieve file or send mail from message mode.  Whether or not
the program is byte-compiled has no effect, nor does it make any
difference if I (require 'efs) prior to loading my program.

 In a fresh XEmacs, -q -no-site-file, when I first `eval-buffer' my
program, and then run:

(usrmg::parse-passwd-and-group-files "/karlheg@ia:/etc/passwd" 'ia-passwd-table
				     "/karlheg@ia:/etc/group" 'ia-group-table)

 I get:

Wrong number of arguments: (lambda (cl-x) (block user-uid (or (and (vectorp cl-x) (>= (length cl-x) 7) (memq (aref cl-x 0) cl-struct-user-tags)) (error "user-uid accessing a non-user" cl-x)) (aref cl-x 1))), 0

 Or, when the program is byte-compiled:

Wrong number of arguments: #<compiled-function (from "user-mgmt.elc") (cl-x) "...(16)" [cl-x 0 cl-struct-user-tags error "user-uid accessing a non-user" 1] 3>, 0


 `edebug' has shown me that it happens at the `insert-file-contents';
when I press space when the cursor is:

(insert-file-contents passwd-file)
                                ^ Here.

... it gives the error shown above.

 In a fresh XEmacs, -q -no-site-file, if I do {C-x C-f /ia:/etc/passwd},
or {C-x C-f /karlheg@ia:/etc/passwd} it will get the file with no
trouble.  I can eval (insert-file-contents "/karlheg@ia:/etc/passwd") in
the scratch buffer with no trouble; it gets the file and fills the buffer.
But once my program has been loaded, the error will occur.

 I don't think I've done anything in this simple program that should
cause this to occur, and I believe there is an error inside XEmacs.

 When my program is eval-buffer'd, XEmacs messages: "loading cl-macs".
If I then do C-x C-f /ia:/etc/passwd, it says "loading efs", and
immediately blonks with the error shown above.

 So what's going on here?  Has anyone else run across this?  Can you
help me figure out how to fix it?   Here's the program itself:


--Multipart_Sun_Jul_27_13:41:11_1997-1
Content-Type: text/plain; charset=US-ASCII

;;; user-mgmt.el --- Linux user account management.

;;; $Id: user-mgmt.el,v 1.1.2.2 1997/07/25 22:35:33 karlheg Exp $

;; Author: Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
;; Keywords: unix, tools, local, maint, extensions, data

;;; Commentary:

;; Some utilities for user account maintenence.  Maybe a mode in
;; progress.

;; NIS is not installed here, so...

;;; Code:

;;; (package usrmg) or something...

(defgroup usrmg
  '(
    (usrmg::passwd-file 'custom-variable)
    )
  "User account management."
  :group 'unix)

;; -----------------------------------------
(defcustom usrmg::passwd-file "/etc/passwd"
  "Path to the system password file."
  :type 'file
  :group 'usrmg)

(defcustom usrmg::passwd-table-size 2047
  "The size of hashtable to hold the information in the system passwd
file."
  :type 'integer
  :group 'usrmg)

(defconst usrmg::passwd-table nil)

(defstruct user
  (uid nil)
  (gid nil)
  (gecos nil)
  (home "")
  (shell "")
  (groups nil))

;; -----------------------------------------
(defcustom usrmg::group-file "/etc/group"
  "Path to the system group file."
  :type 'file
  :group 'usrmg)

(defcustom usrmg::group-table-size 2047
  "The size of a hashtable to hold the information in the system group
file."
  :type 'integer
  :group 'usrmg)

(defconst usrmg::group-table nil)

(defstruct group
  (gid nil)
  (users nil))

;; -----------------------------------------
(defmacro until (pred &rest body)
  `(while (not ,pred)
     (progn
       ,@body)))

(put 'until 'lisp-indent-function 1)

;; -----------------------------------------

;;(usrmg::parse-passwd-and-group-files "/karlheg@ia:/etc/passwd" 'ia-passwd-table
;;				     "/karlheg@ia:/etc/group" 'ia-group-table)


(defun usrmg::parse-passwd-and-group-files
  (&optional passwd-file passwd-table group-file group-table)

  "Parse the passwd file, and fill the data structures.

passwd-file: a string holding the name of a passwd-file.  If this is
nil, it will use `usrmg::passwd-file'.

passwd-table: pass it a quoted symbol name that is to be the location
of a hashtable with `usrmg::passwd-table-size' slots that will hold
user records.

groups-file: a string holding the name of a group file.  If this is
nil, it will use `usrmg::group-file'.

group-table: pass it a quoted symbol name that is to be the location
of a hashtable with `usrmg::group-table-size' slots that will hold
group records.
"
  (or passwd-file
      (setq passwd-file usrmg::passwd-file))
  (or passwd-table
      (setq passwd-table 'usrmg::passwd-table))
  (or group-file
      (setq group-file usrmg::group-file))
  (or group-table
      (setq group-table 'usrmg::group-table))

  (set passwd-table (make-hashtable usrmg::passwd-table-size 'equal))
  (set group-table (make-hashtable usrmg::group-table-size 'equal))

  (let ((require-final-newline nil)
	(line nil))
    (with-temp-buffer
     ;;; An error is signalled here if the file is remote and efs
     ;;; cannot reach it.  The error message doesn't really indicate
     ;;; the real problem.  I need to look into this and put some
     ;;; checks around it or something. If I make an efs connection to
     ;;; a site manually prior to running this function, it works
     ;;; fine.  Otherwise, it blonks.
     (insert-file-contents passwd-file)
     (goto-char (point-min))
     (while (not (eobp))
       ;; (do-the-right-thing-for-NIS around here someplace)
       ;; The shadow utils will not allow ?: inside GECOS.  Good.
       (setq line (split-string (buffer-substring
				 (point)
				 (save-excursion (end-of-line) (point)))
				":"))
       (let* ((this-id (nth 0 line))
	      (login-id this-id)
	      (id-exists (gethash this-id (symbol-value passwd-table)))
	      (n 1))
	 ;; It is possible that the passwd file has duplicate
	 ;; login-id's in it.  This should handle that situation.
	 ;; Remember that most programs will only see the first entry,
	 ;; the one we don't put a number on here.  Those will be
	 ;; flagged as extraneous in any report we generate from this.
	 (while id-exists
	   (setq login-id (format "%s<%03s>" this-id n)
		 id-exists (gethash login-id (symbol-value passwd-table))
		 n (1+ n)))
	 (puthash login-id (make-user :uid (string-to-int (nth 2 line))
				      :gid (string-to-int (nth 3 line))
				      :gecos (split-string (nth 4 line) ",")
				      :home (nth 5 line)
				      :shell (nth 6 line))
		  (symbol-value passwd-table))
	 (forward-line))))
    (with-temp-buffer
     (insert-file-contents group-file)
     (goto-char (point-min))
     (while (not (eobp))
       (setq line (split-string (buffer-substring
				 (point)
				 (save-excursion (end-of-line) (point)))
				":"))
       (let* ((this-group (nth 0 line))
	      (group-id this-group)
	      (group-exists (gethash this-group (symbol-value group-table)))
	      (n 1))
	 ;; It is possible that the group file has duplicate
	 ;; group-id's in it.  This should handle that situation.
	 ;; Remember that most programs will only see the first entry,
	 ;; the one we don't put a number on here.  Those will be
	 ;; flagged as extraneous in any report we generate from this.
	 (while group-exists
	   (setq group-id (format "%s<%03s>" this-group n)
		 group-exists (gethash group-id (symbol-value group-table))
		 n (1+ n)))
	 (puthash group-id (make-group :gid (string-to-int (nth 2 line))
				       :users (split-string (nth 3 line) ","))
		  (symbol-value group-table))
	 (when (string= group-id this-group) ; Don't put extraneous groups on lists.
	   (let ((userlist (group-users (gethash group-id (symbol-value group-table)))))
	     (while userlist
	       (let ((this-user (gethash (car userlist) (symbol-value passwd-table))))
		 (if this-user		; this is a valid user id
		     (setf (user-groups this-user) (nconc (user-groups this-user)
							  (list group-id)))
		   (let ((user-id (format "%s<bog>" (car userlist))))
		     (unless (gethash user-id (symbol-value passwd-table))
		       (puthash user-id (make-user) (symbol-value passwd-table)))
		     (setf (user-groups (gethash user-id (symbol-value passwd-table)))
			   (nconc (user-groups (gethash user-id (symbol-value passwd-table)))
				  (list group-id))))))
	       (setq userlist (cdr userlist))))))
       (forward-line)))))


(defun usrmg::make-formatted-userlisting (passwd-table)
  (with-current-buffer (get-buffer-create "*userlisting*")
    (erase-buffer)
    (buffer-disable-undo)
    (setq truncate-lines t)
    (insert (format "%-18s  %-5s  %-5s  %-25s %-40s %-10s %-10s %-24s %-s\n"
		    "Login ID" "UID" "GID"
		    "Full Name" "Room" "Office" "Home" "Other"
		    "Groups"))
    (maphash #'(lambda (user-id user-struct)
		 (insert
		  (format "%-18s  %05s  %05s  %-25s %-40s %-10s %-10s %-24s %-s\n"
			  user-id (user-uid user-struct) (user-gid user-struct)
			  (nth 0 (user-gecos user-struct))
			  (nth 1 (user-gecos user-struct))
			  (nth 2 (user-gecos user-struct))
			  (nth 3 (user-gecos user-struct))
			  (nth 4 (user-gecos user-struct))
			  (apply 'concat (mapcar #'(lambda (group)
						     (concat group " "))
						 (user-groups user-struct))))))
	     (symbol-value passwd-table))
    (goto-char (point-min))
    (forward-line)
    (sort-fields 1 (point) (point-max))
    (goto-char (point-min))
    (forward-line)
    (sort-fields 2 (point) (point-max))
    (buffer-enable-undo)
    ))

;;;; Test with:
;;;(usrmg::make-formatted-userlisting 'ia-passwd-table)


(provide 'user-mgmt)

;;; user-mgmt.el ends here


--Multipart_Sun_Jul_27_13:41:11_1997-1
Content-Type: text/plain; charset=US-ASCII

mailto:karlheg+sig@inetarena.com (Karl M. Hegbloom)
http://www.inetarena.com/~karlheg
Portland, OR  USA
Debian GNU 1.3  Linux 2.0.30+parport AMD K5 PR-133

--Multipart_Sun_Jul_27_13:41:11_1997-1--

