scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added syslog.

This commit is contained in:
mainzelm 2001-01-02 14:43:27 +00:00
parent 73b9c41bbb
commit fb6abe74fa
5 changed files with 222 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
scsh/scsh-interfaces.scm
View File

@ -1156,4 +1156,37 @@
(define-interface locks-interface (define-interface locks-interface
(export obtain-lock (export obtain-lock
release-lock release-lock
(with-lock :syntax))) (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))

6
scsh/scsh-package.scm
View File

@ -134,6 +134,7 @@
;; in separate modules, but we'll toss it in for now. ;; in separate modules, but we'll toss it in for now.
(interface-of ascii) ; char<->ascii (interface-of ascii) ; char<->ascii
string-ports-interface string-ports-interface
syslog-interface
)) ))
(scsh-level-0-internals (export set-command-line-args! (scsh-level-0-internals (export set-command-line-args!
init-scsh-hindbrain init-scsh-hindbrain
@ -143,6 +144,7 @@
(for-syntax (open scsh-syntax-helpers scheme)) (for-syntax (open scsh-syntax-helpers scheme))
(access events) (access events)
(open enumerated (open enumerated
defenum-package
external-calls ;JMG new FFI external-calls ;JMG new FFI
structure-refs structure-refs
cig-aux cig-aux
@ -247,7 +249,9 @@
) )
(define-structure defenum-package (export (define-enum-constant :syntax) (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) (open scheme)
(files enumconst) (files enumconst)
; (optimize auto-integrate) ; (optimize auto-integrate)

67
scsh/syscalls.scm
View File

@ -944,4 +944,69 @@
(if (> (string-length key) 8) (error "key too long " (string-length key))) (if (> (string-length key) 8) (error "key too long " (string-length key)))
(%crypt key salt))) (%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
View File

@ -34,6 +34,7 @@
#ifdef HAVE_CRYPT_H #ifdef HAVE_CRYPT_H
#include <crypt.h> #include <crypt.h>
#endif #endif
#include <syslog.h>
#include "cstuff.h" #include "cstuff.h"
#include "machine/stdio_dep.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), return s48_enter_string (crypt ( s48_extract_string (key),
s48_extract_string(salt))); 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;
}

7
scsh/syscalls1.h
View File

@ -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 fcntl_write(s48_value fd, s48_value command, s48_value value);
s48_value scm_crypt(s48_value key, s48_value salt); 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();