scsh-common-0.6 0.6.7-8 / usr / share / scsh-0.6 / scsh / syslog.scm

This file is indexed.

/usr/share/scsh-0.6/scsh/syslog.scm is in scsh-common-0.6 0.6.7-8.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
; Copyright (c) 1993-2000 by Richard Kelsey and Jonathan Rees. See file COPYING.

;; Options for openlog

(define-enumerated-type syslog-option :syslog-option
  syslog-option?
  the-syslog-options
  syslog-option-name
  syslog-option-index
  ;; The order of these is known to the C code.
  (console
   delay
   no-delay
   log-pid))

(define-exported-binding "syslog-options" the-syslog-options)

(define-enum-set-type syslog-options :syslog-options
  syslog-options?
  make-syslog-options
  
  syslog-option
  syslog-option?
  the-syslog-options
  syslog-option-index)

(define-exported-binding "syslog-options?" syslog-options?)

(define default-syslog-options (syslog-options))

(define-enumerated-type syslog-facility :syslog-facility
  syslog-facility?
  syslog-facilities
  syslog-facility-name
  syslog-facility-index
  ;; Options for openlog
  ;; The order of these is known to the C code.
  (authorization
   cron
   daemon
   kernel
   lpr
   mail
   news
   user
   uucp
   local0 local1 local2 local3 local4 local5 local6 local7))

(define default-syslog-facility (syslog-facility user))

(define-exported-binding "syslog-facility-type" :syslog-facility)
(define-exported-binding "syslog-facilities" syslog-facilities)

(define-enumerated-type syslog-level :syslog-level
  syslog-level?
  syslog-levels
  syslog-level-name
  syslog-level-index
  ;; The order of these is known to the C code.
  (emergency	
   alert	
   critical	
   error	
   warning	
   notice	
   info	
   debug))

(define-exported-binding "syslog-level-type" :syslog-level)
(define-exported-binding "syslog-levels" syslog-levels)

(define-enum-set-type syslog-mask :syslog-mask
  syslog-mask?
  make-syslog-mask

  syslog-level
  syslog-level?
  syslog-levels
  syslog-level-index)

(define-exported-binding "syslog-mask?" syslog-mask?)
(define-exported-binding ":syslog-mask" :syslog-mask)

(define (syslog-mask-upto level)
  (let loop ((index (syslog-level-index level)) (levels '()))
    (if (< index 0)
	(make-syslog-mask levels)
	(loop (- index 1)
	      (cons (vector-ref syslog-levels index)
		    levels)))))

(define syslog-mask-all (make-syslog-mask (vector->list syslog-levels)))

(define default-syslog-mask syslog-mask-all)

(import-lambda-definition openlog (ident options facility)
			  "sch_openlog")
(import-lambda-definition unix-syslog (level opt-facility message)
			  "sch_syslog")
(import-lambda-definition setlogmask! (logmask)
			  "sch_setlogmask")
(import-lambda-definition closelog ()
			  "sch_closelog")

(define-record-type syslog-channel :syslog-channel
  (make-syslog-channel ident options facility mask)
  syslog-channel?
  (ident syslog-channel-ident)
  (options syslog-channel-options)
  (facility syslog-channel-facility)
  (mask syslog-channel-mask))

(define (syslog-channel-equivalent? channel-1 channel-2)
  (and (string=? (syslog-channel-ident channel-1)
		 (syslog-channel-ident channel-2))
       (enum-set=? (syslog-channel-options channel-1)
		   (syslog-channel-options channel-2))
       ;; facility can be specified with each syslog-write
       (enum-set=? (syslog-channel-mask channel-1)
		   (syslog-channel-mask channel-2))))

(define current-syslog-channel 'unitinialized)
(define current-syslog-channel-lock 'unitinialized)

(define (initialize-syslog)
  (set! current-syslog-channel #f)
  (set! current-syslog-channel-lock (make-lock)))

(define open-syslog-channel make-syslog-channel)

(define (close-syslog-channel channel)
  (obtain-lock current-syslog-channel-lock)
  (if (syslog-channel-equivalent? channel
				  current-syslog-channel)
      (closelog))
  (release-lock current-syslog-channel-lock))

(define (with-syslog-channel channel thunk)
  (dynamic-wind
   (lambda ()
     (obtain-lock current-syslog-channel-lock))
   (lambda ()
     (if (or (not current-syslog-channel)
	     (not (syslog-channel-equivalent? channel
					      current-syslog-channel)))
	 (begin
	   (if current-syslog-channel
	       (closelog))
	   (openlog (syslog-channel-ident channel)
		    (syslog-channel-options channel)
		    (syslog-channel-facility channel))
	   (if (not (enum-set=? (syslog-channel-mask channel)
				default-syslog-mask))
	       (setlogmask! (syslog-channel-mask channel)))
	   (set! current-syslog-channel channel)))
     (thunk))
   (lambda ()
     (release-lock current-syslog-channel-lock))))

(define (syslog-write level message channel)
  (with-syslog-channel
   channel
   (lambda ()
     (unix-syslog level (syslog-channel-facility channel) message))))

(define (change-syslog-channel channel ident options facility mask)
  (make-syslog-channel (or ident
			   (syslog-channel-ident channel))
		       (or options
			   (syslog-channel-options channel))
		       (or facility
			   (syslog-channel-facility channel))
		       (or mask
			   (syslog-channel-mask channel))))

(define dynamic-syslog-channel
  (make-preserved-thread-fluid
   (make-syslog-channel "scsh"
			default-syslog-options
			default-syslog-facility
			default-syslog-mask)))

(define (syslog level message . rest)
  (syslog-write level message
		(cond
		 ((null? rest)
		  (thread-fluid dynamic-syslog-channel))
		 ((and (null? (cdr rest))
		       (syslog-channel? (car rest)))
		  (car rest))
		 (else
		  ;; this might be a little excessive allocation
		  (apply change-syslog-channel
			 (thread-fluid dynamic-syslog-channel)
			 (append rest '(#f)))))))

(define (with-syslog-destination ident options facility mask thunk)
  (let-thread-fluid dynamic-syslog-channel
		    (change-syslog-channel
		     (thread-fluid dynamic-syslog-channel)
		     ident options facility mask)
		    thunk))

(define (set-syslog-channel! channel)
  (set-thread-fluid! dynamic-syslog-channel
		    channel))

(define (set-syslog-destination! ident options facility mask)
  (set-thread-fluid! dynamic-syslog-channel
		     (change-syslog-channel
		      (thread-fluid dynamic-syslog-channel)
		      ident options facility mask)))

;----------------
; A record type whose only purpose is to run some code when we start up an
; image.

(define-record-type reinitializer :reinitializer
  (make-reinitializer thunk)
  reinitializer?
  (thunk reinitializer-thunk))

(define-record-discloser :reinitializer
  (lambda (r)
    (list 'reinitializer (reinitializer-thunk r))))

(define-record-resumer :reinitializer
  (lambda (r)
    ((reinitializer-thunk r))))

(initialize-syslog)

(define syslog-reinitializer
  (make-reinitializer initialize-syslog))

APT Browse - Built by Thomas Orozco.