diff --git a/scsh/scsh-interfaces.scm b/scsh/scsh-interfaces.scm index 1830f2b..f3bb8a3 100644 --- a/scsh/scsh-interfaces.scm +++ b/scsh/scsh-interfaces.scm @@ -1156,4 +1156,37 @@ (define-interface locks-interface (export obtain-lock release-lock - (with-lock :syntax))) \ No newline at end of file + (with-lock :syntax))) + +(define-interface syslog-interface + (export openlog + syslog + closelog + syslog-option/default + syslog-option/cons + syslog-option/ndelay + syslog-option/pid + syslog-facility/default + syslog-facility/auth + syslog-facility/daemon + syslog-facility/kern + syslog-facility/local0 + syslog-facility/local1 + syslog-facility/local2 + syslog-facility/local3 + syslog-facility/local4 + syslog-facility/local5 + syslog-facility/local6 + syslog-facility/local7 + syslog-facility/lpr + syslog-facility/mail + syslog-facility/user + syslog-level/default + syslog-level/emerg + syslog-level/alert + syslog-level/crit + syslog-level/err + syslog-level/warning + syslog-level/notice + syslog-level/info + syslog-level/debug)) \ No newline at end of file diff --git a/scsh/scsh-package.scm b/scsh/scsh-package.scm index 453bc24..14110d2 100644 --- a/scsh/scsh-package.scm +++ b/scsh/scsh-package.scm @@ -134,6 +134,7 @@ ;; in separate modules, but we'll toss it in for now. (interface-of ascii) ; char<->ascii string-ports-interface + syslog-interface )) (scsh-level-0-internals (export set-command-line-args! init-scsh-hindbrain @@ -143,6 +144,7 @@ (for-syntax (open scsh-syntax-helpers scheme)) (access events) (open enumerated + defenum-package external-calls ;JMG new FFI structure-refs cig-aux @@ -247,7 +249,9 @@ ) (define-structure defenum-package (export (define-enum-constant :syntax) - (define-enum-constants :syntax)) + (define-enum-constants :syntax) + (define-enum-constants-from-zero + :syntax)) (open scheme) (files enumconst) ; (optimize auto-integrate) diff --git a/scsh/syscalls.scm b/scsh/syscalls.scm index db576ca..4f09663 100644 --- a/scsh/syscalls.scm +++ b/scsh/syscalls.scm @@ -944,4 +944,69 @@ (if (> (string-length key) 8) (error "key too long " (string-length key))) (%crypt key salt))) - +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Interface to syslog +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(define-enum-constants-from-zero syslog-option + (default + cons + ndelay + pid)) + +(define-enum-constants-from-zero syslog-facility + (default + auth + daemon + kern + local0 + local1 + local2 + local3 + local4 + local5 + local6 + local7 + lpr + mail + user)) + +;;; sorted by priority +(define-enum-constants-from-zero syslog-level + (default + emerg + alert + crit + err + warning + notice + info + debug)) + +(define-stubless-foreign %openlog (ident option facility) "scm_openlog") +(define-stubless-foreign %syslog (facility level message) "scm_syslog") +(define-stubless-foreign closelog () "scm_closelog") + +(define (openlog ident option facility) + (%openlog ident option facility)) + +(define (syslog facility level message) + (%syslog facility level (double-char #\% message))) + + +(define (double-char the-char s) + (let* ((ans-len (string-fold (lambda (c sum) + (+ sum (if (char=? c the-char) 2 1))) + 0 s)) + (ans (make-string ans-len))) + (string-fold (lambda (c i) + (let ((i (if (char=? c the-char) + (begin (string-set! ans i the-char) (+ i 1)) + i))) + (string-set! ans i c) + (+ i 1))) + 0 s) + ans)) \ No newline at end of file diff --git a/scsh/syscalls1.c b/scsh/syscalls1.c index 05a55b8..725340e 100644 --- a/scsh/syscalls1.c +++ b/scsh/syscalls1.c @@ -34,6 +34,7 @@ #ifdef HAVE_CRYPT_H #include #endif +#include #include "cstuff.h" #include "machine/stdio_dep.h" @@ -766,3 +767,112 @@ s48_value scm_crypt(s48_value key, s48_value salt) return s48_enter_string (crypt ( s48_extract_string (key), s48_extract_string(salt))); } + +/* syslog +******************* +*/ + +enum scsh_syslog_option {SCSH_LOG_OPTION_DEFAULT, + SCSH_LOG_CONS, SCSH_LOG_NDELAY, SCSH_LOG_PID}; + +int extract_option(s48_value _option) +{ + int option; + switch (s48_extract_fixnum (_option)){ + case SCSH_LOG_OPTION_DEFAULT: option = 0; break; + case SCSH_LOG_CONS: option = LOG_CONS; break; + case SCSH_LOG_NDELAY: option = LOG_NDELAY; break; + case SCSH_LOG_PID: option = LOG_PID; break; + default: s48_raise_argtype_error (_option);} + return option; +} + +enum scsh_syslog_facility{SCSH_LOG_FACILITY_DEFAULT, + SCSH_LOG_AUTH, + SCSH_LOG_DAEMON, + SCSH_LOG_KERN, + SCSH_LOG_LOCAL0, + SCSH_LOG_LOCAL1, + SCSH_LOG_LOCAL2, + SCSH_LOG_LOCAL3, + SCSH_LOG_LOCAL4, + SCSH_LOG_LOCAL5, + SCSH_LOG_LOCAL6, + SCSH_LOG_LOCAL7, + SCSH_LOG_LPR, + SCSH_LOG_MAIL, + SCSH_LOG_USER}; + +int extract_facility(s48_value _facility) +{ + int facility; + switch (s48_extract_fixnum(_facility)){ + case SCSH_LOG_FACILITY_DEFAULT: facility = 0; break; + case SCSH_LOG_AUTH: facility = LOG_AUTH; break; + case SCSH_LOG_DAEMON: facility = LOG_DAEMON; break; + case SCSH_LOG_KERN: facility = LOG_KERN; break; + case SCSH_LOG_LOCAL0: facility = LOG_LOCAL0; break; + case SCSH_LOG_LOCAL1: facility = LOG_LOCAL1; break; + case SCSH_LOG_LOCAL2: facility = LOG_LOCAL2; break; + case SCSH_LOG_LOCAL3: facility = LOG_LOCAL3; break; + case SCSH_LOG_LOCAL4: facility = LOG_LOCAL4; break; + case SCSH_LOG_LOCAL5: facility = LOG_LOCAL5; break; + case SCSH_LOG_LOCAL6: facility = LOG_LOCAL6; break; + case SCSH_LOG_LOCAL7: facility = LOG_LOCAL7; break; + case SCSH_LOG_LPR: facility = LOG_LPR; break; + case SCSH_LOG_MAIL: facility = LOG_MAIL; break; + case SCSH_LOG_USER: facility = LOG_USER; break; + default: s48_raise_argtype_error (_facility);} + return facility; +} + +enum scsh_syslog_level{SCSH_LOG_LEVEL_DEFAULT, + SCSH_LOG_EMERG, + SCSH_LOG_ALERT, + SCSH_LOG_CRIT, + SCSH_LOG_ERR, + SCSH_LOG_WARNING, + SCSH_LOG_NOTICE, + SCSH_LOG_INFO, + SCSH_LOG_DEBUG}; + +int extract_level(s48_value _level) +{ + int level; + switch (s48_extract_fixnum (_level)){ + case SCSH_LOG_LEVEL_DEFAULT: level = 0; break; + case SCSH_LOG_EMERG: level = LOG_EMERG; break; + case SCSH_LOG_ALERT: level = LOG_ALERT; break; + case SCSH_LOG_CRIT: level = LOG_CRIT; break; + case SCSH_LOG_ERR: level = LOG_ERR; break; + case SCSH_LOG_WARNING: level = LOG_WARNING; break; + case SCSH_LOG_NOTICE: level = LOG_NOTICE; break; + case SCSH_LOG_INFO: level = LOG_INFO; break; + case SCSH_LOG_DEBUG: level = LOG_DEBUG; break; + default: s48_raise_argtype_error (_level);} + return level; +} + +s48_value scm_openlog (s48_value _ident, s48_value _option, s48_value _facility) +{ + openlog(s48_extract_string(_ident), + extract_option (_option), + extract_facility (_facility)); + return S48_UNSPECIFIC; +} + +s48_value scm_syslog (s48_value _facility, s48_value _level, s48_value _message) +{ + int facility = extract_facility (_facility); + int level = extract_level (_level); + + syslog (facility | level, s48_extract_string (_message)); + return S48_UNSPECIFIC; +} + +s48_value scm_closelog () +{ + closelog(); + return S48_UNSPECIFIC; +} + diff --git a/scsh/syscalls1.h b/scsh/syscalls1.h index 50ec567..91e8465 100644 --- a/scsh/syscalls1.h +++ b/scsh/syscalls1.h @@ -82,3 +82,10 @@ s48_value fcntl_read(s48_value fd, s48_value command); s48_value fcntl_write(s48_value fd, s48_value command, s48_value value); s48_value scm_crypt(s48_value key, s48_value salt); + +s48_value scm_openlog (s48_value _ident, s48_value _option, s48_value _facility); + +s48_value scm_syslog (s48_value _facility, s48_value _level, s48_value _message); + +s48_value scm_closelog(); +