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 (file)
--- 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: 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
   * 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: 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.
 
 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 (file)
--- 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
 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
 
 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 (file)
--- 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"
  "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)
 
 ;;; 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)
 
  (: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 (file)
--- 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))
     (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 (file)
--- 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".)
 ;;; 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"