Added syslog.
This commit is contained in:
parent
73b9c41bbb
commit
fb6abe74fa
|
@ -1157,3 +1157,36 @@
|
|||
(export obtain-lock
|
||||
release-lock
|
||||
(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))
|
|
@ -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)
|
||||
|
|
|
@ -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))
|
110
scsh/syscalls1.c
110
scsh/syscalls1.c
|
@ -34,6 +34,7 @@
|
|||
#ifdef HAVE_CRYPT_H
|
||||
#include <crypt.h>
|
||||
#endif
|
||||
#include <syslog.h>
|
||||
#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;
|
||||
}
|
||||
|
||||
|
|
|
@ -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();
|
||||
|
||||
|
|
Loading…
Reference in New Issue