[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[kahua-dev:01248] id-counter 破壊の回避
備前です。
Kahua 0.3.5を使ってインハウスツールを作っているのですが、
その際、db/id-counterが空ファイルになってしまうケースが
あることがわかりました。例えば、デュアルコアCPUなNetBSD
マシン上では、make check数回あたり1回くらいの割合で
発生
します。
全てのケースを細かく追い切れてはいませんが、
1. kahua-server.scmを終了させるシグナルを全くブロック
していない。
2. id-counterの更新について、ファイルを直接上書きして
いる。
あたりが原因だと思います。そこで、1についてはaccept-handler
実行中はSIGINT、SIGHUP、SIGTERMをブロックする
ことで、2に
ついてはwrite-kahua-instanceで使っているのと同じ手法
(テン
ポラリファイルに書いてからsys-rename)で対処してみました。
以下がパッチになります。この変更で、わたしが試した範囲では
db/id-counterが壊れることはなくなりました。
Index: src/kahua/persistence.scm
===================================================================
--- src/kahua/persistence.scm (revision 44)
+++ src/kahua/persistence.scm (revision 47)
@@ -1026,6 +1026,16 @@
(define (id-counter-path path)
(build-path path "id-counter"))
+;; write id-counter or kahua-instance into kahua-db-fs safely.
+(define (%call-writer-to-file-safely file tmpbase writer)
+ (receive (out tmp) (sys-mkstemp tmpbase)
+ (with-error-handler
+ (lambda (e) (sys-unlink tmp) (raise e))
+ (lambda ()
+ (writer out)
+ (close-output-port out)
+ (sys-rename tmp file)))))
+
;; lock mechanism - we need more robust one later, but just for now...
(define (lock-file-path path)
(build-path path "lock"))
@@ -1063,9 +1073,12 @@
(let ((cntfile (id-counter-path path)))
(if (file-is-directory? path)
(if (file-is-regular? cntfile)
- (let1 db (make class :path path)
+ (let ((db (make class :path path))
+ (cnt (with-input-from-file cntfile read)))
+ (unless (number? cnt)
+ (error "kahua-db-open: number required but got as id-
counter: " cnt))
(set! (ref db 'active) #t)
- (set! (ref db 'id-counter) (with-input-from-file cntfile
read))
+ (set! (ref db 'id-counter) cnt)
(unless (lock-db db)
(error "kahua-db-open: couldn't obtain database lock: "
path))
db)
@@ -1074,8 +1087,9 @@
;; There could be a race condition here, but it would be very
;; low prob., so for now it should be OK.
(make-directory* path)
- (make-directory* (build-path path "tmp"))
- (with-output-to-file cntfile (cut write 0))
+ (let1 tmp-path (build-path path "tmp/")
+ (make-directory* tmp-path)
+ (%call-writer-to-file-safely cntfile tmp-path (pa$ write 0)))
(let1 db (make class :path path)
(set! (ref db 'active) #t)
(unless (lock-db db)
@@ -1149,8 +1163,10 @@
(kahua-db-write-id-counter db)))
(define-method kahua-db-write-id-counter ((db <kahua-db-fs>))
- (with-output-to-file (id-counter-path (ref db 'path))
- (cut write (ref db 'id-counter))))
+ (let1 db-path (ref db 'path)
+ (%call-writer-to-file-safely (id-counter-path db-path)
+ (build-path db-path "tmp/")
+ (pa$ write (ref db 'id-counter)))))
(define-method kahua-db-write-id-counter ((db <kahua-db-dbi>))
(let ((q (ref db 'query)))
@@ -1298,14 +1314,9 @@
(obj <kahua-persistent-base>))
(let* ((path (data-path db (class-of obj) (key-of obj))))
(make-directory* (sys-dirname path))
- (receive (p tmp) (sys-mkstemp (build-path (ref db 'path) "tmp"))
- (with-error-handler
- (lambda (e) (sys-unlink tmp) (raise e))
- (lambda ()
- (kahua-write obj p)
- (close-output-port p)
- (sys-rename tmp path)
- (set! (ref obj '%floating-instance) #f))))))
+ (%call-writer-to-file-safely path (build-path (ref db 'path)
"tmp/")
+ (cut kahua-write obj <>))
+ (set! (ref obj '%floating-instance) #f)))
(define-method write-kahua-instance ((db <kahua-db-dbi>)
(obj <kahua-persistent-base>))
Index: src/kahua-server.scm
===================================================================
--- src/kahua-server.scm (revision 44)
+++ src/kahua-server.scm (revision 47)
@@ -44,6 +44,8 @@
(define primary-database-name (make-parameter #f))
(define kahua-app-args (make-parameter #f))
+(define-constant *SIGNAL-LIST* (list SIGTERM SIGINT SIGHUP))
+
(define (kahua-application-environment)
(let ((sandbox (make-sandbox-module))
(cm (current-module)))
@@ -107,14 +109,16 @@
(define (run-server worker-id sockaddr)
(let ((sock (make-server-socket sockaddr :reuse-addr? #t))
- (selector (make <selector>)))
+ (selector (make <selector>))
+ (new_sigset (apply sys-sigset-add! (make <sys-sigset>)
*SIGNAL-LIST*)))
(define (accept-handler fd flag)
(let* ((client (socket-accept sock))
(input (socket-input-port client :buffered? #f))
- (output (socket-output-port client)))
+ (output (socket-output-port client))
+ (old_sigset (sys-sigmask SIG_BLOCK new_sigset)))
(guard (e
(#t (log-format
- "[server]: Read error occured in accept-
handler")))
+ "[server]: Read error occured in accept-
handler: ~a" (ref e 'message))))
(let ((header (read input))
(body (read input)))
(handle-request
@@ -129,6 +133,7 @@
(flush output)))
(socket-close client))
selector)))
+ (sys-sigmask SIG_SETMASK old_sigset)
))
;; hack
@@ -176,19 +181,12 @@
(log-format "[~a] exit" worker-name)
(when (is-a? sockaddr <sockaddr-un>)
(sys-unlink (sockaddr-name sockaddr))))))
+ (define (termination-handler sig)
+ (log-format "[~a] ~a" worker-name (sys-signal-name sig))
+ (cleanup)
+ (exit 0))
(log-open (kahua-logpath "kahua-spvr.log") :prefix "~Y ~T ~P[~
$]: ")
- (set-signal-handler! SIGINT (lambda _
- (log-format "[~a] SIGINT"
worker-name)
- (cleanup)
- (exit 0)))
- (set-signal-handler! SIGHUP (lambda _
- (log-format "[~a] SIGHUP"
worker-name)
- (cleanup)
- (exit 0)))
- (set-signal-handler! SIGTERM (lambda _
- (log-format "[~a] SIGTERM"
worker-name)
- (cleanup)
- (exit 0)))
+ (for-each (cut set-signal-handler! <> termination-handler)
*SIGNAL-LIST*)
(with-error-handler
(lambda (e)
(log-format "[server] error in main:\n~a"
--
備前 達矢