This is the mail archive of the guile@cygnus.com mailing list for the guile project.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
Please try this patch and let me know if there are any problems. If it builds properly, start your Guile and evaluate this: (dynamic-wind setutent (lambda () (let loop ((u (getutent)) (result '())) (if (not u) (reverse result) (loop (getutent) (cons u result))))) endutent) It should return something like this: (#(8 4 "" "si" "" "" (0 . 0) 0 (916428217 . 534277) #(0 0 0 0)) #(1 20018 "~" "~~" "runlevel" "" (0 . 0) 0 (916428217 . 569179) #(0 0 0 0)) #(8 95 "" "l2" "" "" (0 . 0) 0 (916428222 . 550791) #(0 0 0 0)) #(6 10113 "tty1" "1" "LOGIN" "" (0 . 0) 0 (916465365 . 77565) #(0 0 0 0)) #(6 10114 "tty2" "2" "LOGIN" "" (0 . 0) 0 (916465369 . 105608) #(0 0 0 0)) #(6 153 "tty3" "3" "LOGIN" "" (0 . 0) 0 (916428222 . 552864) #(0 0 0 0)) #(6 154 "tty4" "4" "LOGIN" "" (0 . 0) 0 (916428222 . 553447) #(0 0 0 0)) #(6 155 "tty5" "5" "LOGIN" "" (0 . 0) 0 (916428222 . 554006) #(0 0 0 0)) #(6 156 "tty6" "6" "LOGIN" "" (0 . 0) 0 (916428222 . 554602) #(0 0 0 0)) #(7 10115 ":0" ":0" "offby1" "" (7 . 0) 134513176 (916465375 . 134514168) #(1073927883 1074427948 134517056 134514704)) #(7 0 "" "p0" "" "" (0 . 0) 0 (0 . 0) #(0 0 0 0)) #(7 0 "" "p2" "" "" (0 . 0) 0 (0 . 0) #(0 0 0 0)) #(7 0 "" "p4" "" "" (0 . 0) 0 (0 . 0) #(0 0 0 0)) #(7 0 "" "p5" "" "" (0 . 0) 0 (0 . 0) #(0 0 0 0))) Thanks! Index: NEWS =================================================================== RCS file: /egcs/carton/cvsfiles/guile/guile-core/NEWS,v retrieving revision 1.99 diff -w -u -p -r1.99 NEWS --- NEWS 1999/01/10 12:31:31 1.99 +++ NEWS 1999/01/17 16:45:19 @@ -35,6 +35,74 @@ in backtraces. * Changes to Scheme functions and syntax +** New functions: setutent, utmpname, getutent, endutent +Access to the similarly-named system calls. These let you see who has +logged on recently. + +These functions may not be available on your system; check whether the +`*features*' list includes the `utent' symbol. + +*** setutent takes no arguments and returns an unspecified value. +Call it before calling any of the other functions. + +*** utmpname chooses which file getutent will examine. The argument +must be #t, #f, or a string. If it is #t, getutent will examine +whichever file holds the data about currently logged-on users; if it +is #f, getutent will examine the file that holds data about users who +have already logged off; if it is a string, getutent will examine +whichever file is named in the string. (The only sensible values for +the string, on Debian Linux 2.0, at least, are "/var/run/utmp" and +"/var/log/wtmp", which correspond to #t and #f respectively). + +Use #t or #f if you don't want to hard-code system-dependet string +constants in your program. Use a string if you need to access some +third file which neither #t nor #f accesses (and please file a bug +against guile in that case, so that we can teach utmpname about your +system). + +You need not call this function; if you don't, getutent will behave as +if you *had* called (utmpname #t). + +*** getutent returns a vector describing a utmp entry. It's laid out +like this: + +0 an integer, ut_type + +1 an integer, ut_pid + +2 a string, ut_line + +3 a string, ut_id + +4 a string, ut_user + +5 a string, ut_host + +6 a pair. The car is an integer representing the termination status +of some process FIXME; the cdr is the exit status of that process. + +7 an integer, ut_session + +8 a pair. The car is the number of seconds, and the cdr the number of +microseconds, which when added yield the number of seconds since the +epoch that passed when the utmp entry was created. (This is the same +encoding of time that `gettimeofday' returns.) + +9 a vector. Each element is an integer; they are the IP address of +the host from which the logon ocurred. + +*** getutid finds an entry whose ut_id field matches that of the +passed-in one. (The actual behavior is slightly more complicated than +this; see the man page for getutid(5) for details.) + +*** getutline finds an entry whose `ut_line' entry matches that of the +passed-in one. (See getutline(5) for details.) + +*** pututline adds an entry to the database. + +*** endutent closes the utmp file. Call it after you're done with the +other functions. + ** New function: sorted? SEQUENCE LESS? Returns `#t' when the sequence argument is in non-decreasing order according to LESS? (that is, there is no adjacent pair `... x y Index: configure.in =================================================================== RCS file: /egcs/carton/cvsfiles/guile/guile-core/configure.in,v retrieving revision 1.76 diff -w -u -p -r1.76 configure.in --- configure.in 1999/01/11 06:46:53 1.76 +++ configure.in 1999/01/17 16:27:15 @@ -76,7 +76,7 @@ AC_HEADER_STDC AC_HEADER_DIRENT AC_HEADER_TIME AC_HEADER_SYS_WAIT -AC_CHECK_HEADERS(libc.h limits.h malloc.h memory.h string.h regex.h rxposix.h rx/rxposix.h sys/ioctl.h sys/select.h sys/time.h sys/timeb.h sys/times.h sys/types.h sys/utime.h time.h unistd.h utime.h) +AC_CHECK_HEADERS(libc.h limits.h malloc.h memory.h string.h regex.h rxposix.h rx/rxposix.h sys/ioctl.h sys/select.h sys/time.h sys/timeb.h sys/times.h sys/types.h sys/utime.h time.h unistd.h utime.h utmp.h) GUILE_HEADER_LIBC_WITH_UNISTD AC_TYPE_GETGROUPS Index: ChangeLog =================================================================== RCS file: /egcs/carton/cvsfiles/guile/guile-core/libguile/ChangeLog,v retrieving revision 1.521 diff -w -u -p -r1.521 ChangeLog --- ChangeLog 1999/01/11 11:34:51 1.521 +++ ChangeLog 1999/01/17 16:39:43 @@ -1,3 +1,18 @@ +1999-01-17 Eric Hanchrow <offby1@blarg.net> + + * scmconfig.h.in: Regenerated. + +1999-01-15 Eric Hanchrow <offby1@blarg.net> + + * init.c: #include "utent.h"; + (scm_boot_guile_1): Call scm_init_utent (). + + * Makefile.in: regenerated + + * Makefile.am: added utent.c, utent.h, utent.x + + * utent.c, utent.h: New files: setutent and related system calls. + 1999-01-11 Roland Orre <mdj@mdj.nada.kth.se> * sort.c (scm_merge, scm_merge_list_x): Bugfix: Place elements Index: libguile/Makefile.am =================================================================== RCS file: /egcs/carton/cvsfiles/guile/guile-core/libguile/Makefile.am,v retrieving revision 1.60 diff -w -u -p -r1.60 Makefile.am --- Makefile.am 1999/01/10 07:59:02 1.60 +++ Makefile.am 1999/01/17 16:27:45 @@ -46,7 +46,7 @@ libguile_la_SOURCES = \ procs.c ramap.c random.c read.c readline.c root.c scmsigs.c script.c \ simpos.c smob.c socket.c sort.c srcprop.c stackchk.c stacks.c stime.c \ strings.c strop.c strorder.c strports.c struct.c symbols.c tag.c \ - throw.c unif.c variable.c vectors.c version.c vports.c weaks.c + throw.c unif.c utent.c variable.c vectors.c version.c vports.c weaks.c BUILT_SOURCES = \ cpp_err_symbols.c cpp_sig_symbols.c libpath.h \ @@ -61,7 +61,7 @@ BUILT_SOURCES = \ procprop.x procs.x random.x ramap.x read.x readline.x regex-posix.x \ root.x scmsigs.x script.x simpos.x smob.x socket.x sort.x srcprop.x \ stackchk.x stacks.x stime.x strings.x strop.x strorder.x strports.x \ - struct.x symbols.x tag.x threads.x throw.x unif.x variable.x vectors.x \ + struct.x symbols.x tag.x threads.x throw.x unif.x utent.x variable.x vectors.x \ version.x vports.x weaks.x EXTRA_libguile_la_SOURCES = _scm.h \ @@ -97,7 +97,7 @@ modinclude_HEADERS = \ procs.h random.h ramap.h read.h readline.h root.h scmsigs.h script.h \ simpos.h smob.h socket.h sort.h srcprop.h stackchk.h stacks.h stime.h \ strings.h strop.h strorder.h strports.h struct.h symbols.h tag.h \ - tags.h throw.h unif.h variable.h vectors.h version.h vports.h \ + tags.h throw.h unif.h utent.h variable.h vectors.h version.h vports.h \ weaks.h snarf.h threads.h coop-defs.h fluids.h iselect.h ## This file is generated at configure time. That is why it is DATA Index: libguile/init.c =================================================================== RCS file: /egcs/carton/cvsfiles/guile/guile-core/libguile/init.c,v retrieving revision 1.60 diff -w -u -p -r1.60 init.c --- init.c 1999/01/10 07:54:50 1.60 +++ init.c 1999/01/17 16:27:48 @@ -118,6 +118,7 @@ #include "tag.h" #include "throw.h" #include "unif.h" +#include "utent.h" #include "variable.h" #include "vectors.h" #include "version.h" @@ -477,6 +478,9 @@ scm_boot_guile_1 (base, closure) scm_init_strports (); scm_init_symbols (); scm_init_tag (); +#if defined (HAVE_UTMP_H) + scm_init_utent (); +#endif scm_init_load (); scm_init_objects (); /* Requires struct */ scm_init_print (); /* Requires struct */ =================================================================== libguile/utent.c /* Copyright (C) 1999 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2, or (at your option) * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, * Boston, MA 02111-1307 USA * * As a special exception, the Free Software Foundation gives permission * for additional uses of the text contained in its release of GUILE. * * The exception is that, if you link the GUILE library with other files * to produce an executable, this does not by itself cause the * resulting executable to be covered by the GNU General Public License. * Your use of that executable is in no way restricted on account of * linking the GUILE library code into it. * * This exception does not however invalidate any other reasons why * the executable file might be covered by the GNU General Public License. * * This exception applies only to the code released by the * Free Software Foundation under the name GUILE. If you copy * code from other Free Software Foundation releases into a copy of * GUILE, as the General Public License permits, the exception does * not apply to the code that you add in this way. To avoid misleading * anyone as to the status of such modified files, you must delete * this exception notice from them. * * If you write modifications of your own for GUILE, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ #include "_scm.h" #if defined (HAVE_UTMP_H) #include <utmp.h> #include "feature.h" #include "utent.h" SCM_PROC (s_setutent, "setutent", 0, 0, 0, scm_setutent); SCM scm_setutent () { SCM_DEFER_INTS; SCM_SYSCALL (setutent ()); SCM_ALLOW_INTS; return SCM_UNSPECIFIED; } SCM_PROC (s_endutent, "endutent", 0, 0, 0, scm_endutent); SCM scm_endutent () { SCM_DEFER_INTS; SCM_SYSCALL (endutent ()); SCM_ALLOW_INTS; return SCM_UNSPECIFIED; } static SCM scm_from_ut (ut_in) const struct utmp *ut_in; { SCM *vector_elements = 0; SCM ip_addr = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED); SCM result = scm_make_vector (SCM_MAKINUM (10), SCM_UNSPECIFIED); if (!ut_in) { return SCM_BOOL_F; } vector_elements = SCM_VELTS (result); vector_elements [0] = SCM_MAKINUM (ut_in->ut_type); vector_elements [1] = scm_ulong2num ((unsigned long) ut_in->ut_pid); vector_elements [2] = scm_makfrom0str (ut_in->ut_line); vector_elements [3] = scm_makfrom0str (ut_in->ut_id); vector_elements [4] = scm_makfrom0str (ut_in->ut_user); vector_elements [5] = scm_makfrom0str (ut_in->ut_host); vector_elements [6] = scm_cons (SCM_MAKINUM (ut_in->ut_exit.e_termination), SCM_MAKINUM (ut_in->ut_exit.e_exit)); vector_elements [7] = scm_long2num (ut_in->ut_session); vector_elements [8] = scm_cons (scm_long2num ((long)ut_in->ut_tv.tv_sec), scm_long2num ((long)ut_in->ut_tv.tv_usec)); { SCM *ip_ve = SCM_VELTS (ip_addr); ip_ve [0] = scm_ulong2num ((unsigned long)ut_in->ut_addr_v6 [0]); ip_ve [1] = scm_ulong2num ((unsigned long)ut_in->ut_addr_v6 [1]); ip_ve [2] = scm_ulong2num ((unsigned long)ut_in->ut_addr_v6 [2]); ip_ve [3] = scm_ulong2num ((unsigned long)ut_in->ut_addr_v6 [3]); } vector_elements [9] = ip_addr; return result; } static char s_helper[] = "utent helper"; /* Free the returned pointer when you're done with it. */ static struct utmp * scm_to_ut (scm_ut) SCM scm_ut; { struct utmp *ut_return = (struct utmp *) scm_must_malloc (sizeof (struct utmp), s_helper); SCM *vector_elements = 0; /* I'd like to put a stronger assertion here -- namely, I'd like to assert that scm_ut is the sort of thing that scm_getutent returns. But I don't know how to do that. */ SCM_ASSERT (SCM_NIMP (scm_ut) && SCM_VECTORP (scm_ut), scm_ut, SCM_ARG1, s_helper); vector_elements = SCM_VELTS (scm_ut); ut_return->ut_type = SCM_INUM (vector_elements [0]); ut_return->ut_pid = scm_num2ulong (vector_elements [1], (char *)SCM_ARG1, s_helper); /* Using `strncpy' here instead of `strcpy' avoids the risk of corrupting ut_return if the strings in scm_ut are too long to fit. */ strncpy (ut_return->ut_line, SCM_CHARS (vector_elements [2]), UT_LINESIZE); strncpy (ut_return->ut_id, SCM_CHARS (vector_elements [3]), 4); strncpy (ut_return->ut_user, SCM_CHARS (vector_elements [4]), UT_NAMESIZE); strncpy (ut_return->ut_host, SCM_CHARS (vector_elements [5]), UT_HOSTSIZE); ut_return->ut_exit.e_termination = SCM_INUM (SCM_CAR (vector_elements [6])); ut_return->ut_exit.e_exit = SCM_INUM (SCM_CDR (vector_elements [6])); ut_return->ut_tv.tv_sec = scm_num2ulong (SCM_CAR (vector_elements [8]),(char *)SCM_ARG1, s_helper); ut_return->ut_tv.tv_usec = scm_num2ulong (SCM_CDR (vector_elements [8]),(char *)SCM_ARG1, s_helper); ut_return->ut_addr_v6 [0] = scm_num2ulong (SCM_VELTS (vector_elements [9])[0],(char *)SCM_ARG1, s_helper); ut_return->ut_addr_v6 [1] = scm_num2ulong (SCM_VELTS (vector_elements [9])[1],(char *)SCM_ARG1, s_helper); ut_return->ut_addr_v6 [2] = scm_num2ulong (SCM_VELTS (vector_elements [9])[2],(char *)SCM_ARG1, s_helper); ut_return->ut_addr_v6 [3] = scm_num2ulong (SCM_VELTS (vector_elements [9])[3],(char *)SCM_ARG1, s_helper); return ut_return; } SCM_PROC (s_getutent, "getutent", 0, 0, 0, scm_getutent); SCM scm_getutent () { struct utmp *ut = 0; SCM_DEFER_INTS; SCM_SYSCALL (ut = getutent ()); SCM_ALLOW_INTS; if (!ut) { return SCM_BOOL_F; } return scm_from_ut (ut); } SCM_PROC (s_utmpname, "utmpname", 1, 0, 0, scm_utmpname); SCM scm_utmpname (name) SCM name; { char *input_string = 0; if (SCM_BOOL_T == name) { input_string = _PATH_UTMP; } else if (SCM_BOOL_F == name) { input_string = _PATH_WTMP; } else { SCM_ASSERT (SCM_NIMP (name) && SCM_ROSTRINGP (name), name, SCM_ARG1, s_utmpname); input_string = SCM_ROCHARS (name); } SCM_SYSCALL (utmpname (input_string)); return SCM_UNSPECIFIED; } SCM_PROC (s_getutid, "getutid", 1, 0, 0, scm_getutid); SCM scm_getutid (scm_ut_in) SCM scm_ut_in; { struct utmp *ut_in = scm_to_ut (scm_ut_in); struct utmp *ut_out = 0; SCM_DEFER_INTS; ut_out = SCM_SYSCALL (getutid (ut_in)); SCM_ALLOW_INTS; free (ut_in); return scm_from_ut (ut_out); } SCM_PROC (s_getutline, "getutline", 1, 0, 0, scm_getutline); SCM scm_getutline (scm_ut_in) SCM scm_ut_in; { struct utmp *ut_in = scm_to_ut (scm_ut_in); struct utmp *ut_out = 0; SCM_DEFER_INTS; ut_out = SCM_SYSCALL (getutline (ut_in)); SCM_ALLOW_INTS; free (ut_in); return scm_from_ut (ut_out); } SCM_PROC (s_pututline, "pututline", 1, 0, 0, scm_pututline); SCM scm_pututline (scm_ut_in) SCM scm_ut_in; { struct utmp *ut_in = scm_to_ut (scm_ut_in); SCM_DEFER_INTS; SCM_SYSCALL (pututline (ut_in)); SCM_ALLOW_INTS; free (ut_in); return SCM_UNSPECIFIED; } void scm_init_utent () { scm_add_feature ("utent"); #include "utent.x" } #endif /* HAVE_UTMP_H */ =================================================================== libguile/utent.h /* classes: h_files */ #ifndef UTENTH #define UTENTH #include "libguile/__scm.h" extern SCM scm_getutent (void); extern SCM scm_setutent (void); extern SCM scm_endutent (void); extern SCM scm_utmpname (SCM name); extern SCM scm_getutid (SCM ut); extern SCM scm_getutline (SCM ut); extern SCM scm_pututline (SCM ut); extern void scm_init_utent (void); #endif /* UTENTH */