* modules/dmd.scm (main): Start logging to a buffer instead of a
file when the logfile option is set to "delayed".
* modules/dmd/comm.scm (start-logging-to-buffer): New procedure.
(start-logging): If logs were being written to a string port,
write its contents to the log file.
---
Hi,
When using dmd to bring up a read-only file system, it will quit when it
fails to open a log file for writing.
This is a proof-of-concept patch that adds the option to start writing
logs to a string port. It allows having a dmdconf.scm that runs fsck,
makes the disk writable, and then starts writing past and future log
messages to disk with (start-logging "/var/log/dmd.log").
Does anyone have any thoughts on this? Is there a better way to handle
this case?
Thanks.
David
modules/dmd.scm | 7 +++++--
modules/dmd/comm.scm | 17 ++++++++++++++---
2 files changed, 19 insertions(+), 5 deletions(-)
diff --git a/modules/dmd.scm b/modules/dmd.scm
index cf72d7a..e0f69c7 100644
--- a/modules/dmd.scm
+++ b/modules/dmd.scm
@@ -97,7 +97,8 @@
(make <option>
#:long "logfile" #:short #\l
#:takes-arg? #t #:optional-arg? #f #:arg-name "FILE"
- #:description "log actions in FILE"
+ #:description
+ "log actions in FILE or to a buffer if FILE is \"delayed\""
#:action (lambda (file)
(set! logfile file)))
(make <option>
@@ -137,7 +138,9 @@
(and socket-file
(verify-dir (dirname socket-file) insecure))
;; Enable logging as first action.
- (start-logging logfile)
+ (if (string-ci=? logfile "delayed")
+ (start-logging-to-buffer)
+ (start-logging logfile))
;; Send output to log and clients.
(set-current-output-port dmd-output-port)
diff --git a/modules/dmd/comm.scm b/modules/dmd/comm.scm
index fb08629..aeb45ca 100644
--- a/modules/dmd/comm.scm
+++ b/modules/dmd/comm.scm
@@ -37,6 +37,7 @@
read-command
start-logging
+ start-logging-to-buffer
stop-logging
%current-client-socket
dmd-output-port))
@@ -103,10 +104,20 @@ return the socket."
;; Port for logging. This must always be a valid port, never `#f'.
(define log-output-port (%make-void-port "w"))
(define (start-logging file)
- (let ((directory (dirname file)))
+ (let ((directory (dirname file)) (oldport log-output-port))
(unless (file-exists? directory)
- (mkdir directory)))
- (set! log-output-port (open-file file "al"))) ; line-buffered port
+ (mkdir directory))
+ (set! log-output-port (open-file file "al")) ; line-buffered port
+ ;; Attempt to dump any buffered log data to the given log file. This only
+ ;; succeeds if log-output-port was an open output string port, as verified
+ ;; by get-output-string. Otherwise, logging to a file is started normally.
+ (catch #t
+ (lambda ()
+ (display (get-output-string oldport) log-output-port)
+ (close-output-port oldport))
+ noop)))
+(define (start-logging-to-buffer)
+ (set! log-output-port (open-output-string)))
(define (stop-logging)
(close-port log-output-port)
(set! log-output-port (%make-void-port "w")))
--
1.9.3
