From: Juho Snellman Date: Mon, 15 Jan 2007 22:09:10 +0000 (+0000) Subject: 1.0.1.27: Add syslog(3) and friends to SB-POSIX. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=sidebyside;h=6c849ec3769e576fdc8b15caeb7c1fda6d7a651b;p=sbcl.git 1.0.1.27: Add syslog(3) and friends to SB-POSIX. * Patch by Richard Kreuter --- diff --git a/NEWS b/NEWS index 36ce348..b8adb5c 100644 --- a/NEWS +++ b/NEWS @@ -13,6 +13,8 @@ changes in sbcl-1.0.2 relative to sbcl-1.0.1: * new feature: new generic function SB-GRAY:STREAM-FILE-POSITION can be used to provide an implementation for FILE-POSITION on Gray streams (thanks to Eric Marsden) + * new feature: add syslog, openlog and closelog support to SB-POSIX + (thanks to Richard Kreuter) * optimization: the function call overhead in code compiled with a high DEBUG optimization setting is significantly * bug fix: an error is signaled for attempts to use READ-SEQUENCE @@ -27,7 +29,7 @@ changes in sbcl-1.0.2 relative to sbcl-1.0.1: * bug fix: NIL can be used as a tagbody tag (thanks to Stephen Wilson) * bug fix: Win32 port can now handle foreign code unwinding Lisp stack frames from alien callbacks. - * bug fix: ATANH returned incorrect results on win32 (thanks to Pierre Mai) + * bug fix: ATANH returned incorrect results on win32 (thanks to Pierre Mai) changes in sbcl-1.0.1 relative to sbcl-1.0: * new platform: FreeBSD/x86-64, including support for threading. diff --git a/contrib/sb-posix/TODO b/contrib/sb-posix/TODO index 0261a5a..c6249c1 100644 --- a/contrib/sb-posix/TODO +++ b/contrib/sb-posix/TODO @@ -28,7 +28,7 @@ settimeofday sgetmask shmat shmctl shmdt shmget shmop shutdown sigaction sigaltstack sigblock siggetmask sigmask signal sigpause sigpending sigprocmask sigreturn sigsetmask sigsuspend sigvec socket socketcall socketpair ssetmask statfs stime stty swapoff swapon -syscalls sysctl sysfs sysinfo syslog times +syscalls sysctl sysfs sysinfo times ulimit umount uname ustat vfork vhangup wait3 wait4 write writev diff --git a/contrib/sb-posix/constants.lisp b/contrib/sb-posix/constants.lisp index 7018fca..6e05505 100644 --- a/contrib/sb-posix/constants.lisp +++ b/contrib/sb-posix/constants.lisp @@ -22,7 +22,8 @@ "dirent.h" "signal.h" #-win32 "pwd.h" "unistd.h" - #-win32 "termios.h") + #-win32 "termios.h" + #-win32 "syslog.h") ;;; then the stuff we're looking for ((:integer af-inet "AF_INET" "IP Protocol family" t) @@ -472,4 +473,119 @@ (:integer tcooff "TCOOFF" nil t) (:integer tcoon "TCOON" nil t) - ) + ;; syslog -- does this exist at all on Windows? + + ;; SUSv3-standard openlog() facilities + #-win32 + (:integer log-user "LOG_USER" "Default openlog() faclity." t) + #-win32 + (:integer log-local0 "LOG_LOCAL0" "Locally-defined openlog() facility" t) + #-win32 + (:integer log-local1 "LOG_LOCAL1" "Locally-defined openlog() facility" t) + #-win32 + (:integer log-local2 "LOG_LOCAL2" "Locally-defined openlog() facility" t) + #-win32 + (:integer log-local3 "LOG_LOCAL3" "Locally-defined openlog() facility" t) + #-win32 + (:integer log-local4 "LOG_LOCAL4" "Locally-defined openlog() facility" t) + #-win32 + (:integer log-local5 "LOG_LOCAL5" "Locally-defined openlog() facility" t) + #-win32 + (:integer log-local6 "LOG_LOCAL6" "Locally-defined openlog() facility" t) + #-win32 + (:integer log-local7 "LOG_LOCAL7" "Locally-defined openlog() facility" t) + + ;; Additional, non-standard openlog() facilities (most of which + ;; probably won't be needed by Lisp programs, but here for + ;; completeness). + #-win32 + (:integer + log-authpriv "LOG_AUTHPRIV" "openlog() facility for authorization messages" t) + #-win32 + (:integer + log-cron "LOG_CRON" "openlog() facility for cron and at daemons" t) + #-win32 + (:integer + log-daemon "LOG_DAEMON" "openlog() facility for arbitrary daemons" t) + #-win32 + (:integer + log-ftp "LOG_FTP" "openlog() facility for FTP daemons" t) + #-win32 + (:integer + log-kern "LOG_KERN" "openlog() facility for kernel messages" t) + #-win32 + (:integer + log-lpr "LOG_LPR" "openlog() facility for the printer subsystem" t) + #-win32 + (:integer + log-mail "LOG_MAIL" "openlog() facility for the mail subsystem" t) + #-win32 + (:integer + log-news "LOG_NEWS" "openlog() facility for the usenet subsystem" t) + #-win32 + (:integer + log-syslog "LOG_SYSLOG" "openlog() facility for the syslog subsystem" t) + #-win32 + (:integer + log-uucp "LOG_UUCP" "openlog() facility for the UUCP subsystem" t) + + ;; openlog() options + #-win32 + (:integer + log-pid "LOG_PID" + "If supplied to openlog(), log the process ID with each message" + t) + #-win32 + (:integer + log-cons "LOG_CONS" + "If supplied to openlog(), log to the system console as well as logfiles" + t) + #-win32 + (:integer + log-ndelay "LOG_NDELAY" + "If supplied to openlog(), immediately open the syslog connection." + t) + #-win32 + (:integer + log-odelay "LOG_ODELAY" + "If supplied to openlog(), delay opening the syslog connection to the first syslog() call." + t) + #-win32 + (:integer + log-nowait "LOG_NOWAIT" + "If supplied to openlog(), do not wait for child processes created by calls to syslog()." + t) + ;; Not in SUSv3, but at least Glibc and BSD libc have this + #-win32 + (:integer + log-perror "LOG_PERROR" + "If supplied to openlog(), write log messages to the process's standard error descriptor in addition to the logging facility." + t) + + ;; syslog() severity levels + #-win32 + (:integer + log-emerg "LOG_EMERG" "Log severity level denoting a panic." t) + #-win32 + (:integer + log-alert "LOG_ALERT" "Log severity level denoting a condition that should be corrected immediately." t) + #-win32 + (:integer + log-crit "LOG_CRIT" "Log severity level denoting critical conditions." t) + #-win32 + (:integer + log-err "LOG_ERR" "Log severity level denoting an error." t) + #-win32 + (:integer + log-warning "LOG_WARNING" "Log severity level denoting a warning." t) + #-win32 + (:integer + log-notice "LOG_NOTICE" "Log severity level denoting non-errors that may require special handling." t) + #-win32 + (:integer + log-info "LOG_INFO" "Log severity level denoting informational messages." t) + #-win32 + (:integer + log-debug "LOG_DEBUG" "Log severity level denoting debugging information ." t) + +) diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp index 349c74d..6d6d72c 100644 --- a/contrib/sb-posix/interface.lisp +++ b/contrib/sb-posix/interface.lisp @@ -552,3 +552,25 @@ (unless (null-alien r) (cast r c-string)))) (define-call "putenv" int minusp (string c-string)) + +;;; syslog +#-win32 +(progn + (export 'openlog :sb-posix) + (export 'syslog :sb-posix) + (export 'closelog :sb-posix) + (defun openlog (ident options &optional (facility log-user)) + (alien-funcall (extern-alien + "openlog" (function void c-string int int)) + ident options facility)) + (defun syslog (priority format &rest args) + "Send a message to the syslog facility, with severity level +PRIORITY. The message will be formatted as by CL:FORMAT (rather +than C's printf) with format string FORMAT and arguments ARGS." + (flet ((syslog1 (priority message) + (alien-funcall (extern-alien + "syslog" (function void int c-string c-string)) + priority "%s" message))) + (syslog1 priority (apply #'format nil format args)))) + (define-call "closelog" void never-fails)) + diff --git a/version.lisp-expr b/version.lisp-expr index 39aeae8..efcda04 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.1.26" +"1.0.1.27"