デーモン
以前に書いた『HTTPリクエストの中身を表示するだけのHTTPサーバ』を拡張して、デーモンサーバを作成する機会があったので、それをまとめてpackage化した。
プロセス(サーバ)をデーモン化すること自体は、以下のような処理で出来た。
(require :sb-posix) (defvar *common-lisp-streams* '(*standard-input* *standard-output* *query-io* *debug-io* *terminal-io* *error-output* *trace-output*)) ;;;;;;;;;;;; ;;; デーモン作成 (unless (zerop (sb-posix:fork)) (sb-ext:quit)) ; <- 親プロセスは終了 (sb-posix:setsid) (unless (zerop (sb-posix:fork)) (sb-ext:quit)) (sb-posix:chdir "/") (sb-posix:umask 0) ;; file-discriptorを閉じる ※ MAXFDには適当な上限を設定 (dotimes (fd MAXFD) (sb-unix:unix-close fd)) ;; common-lispパッケージにあるstreamには、"/dev/null"へのfile-streamを設定する (let ((null-io (open "/dev/null" :direction :io :if-exists :overwrite))) (dolist (s *common-lisp-streams*) (setf s null-io)))) ;;;;;;;;;;;; ;;; ここ以降に、デーモンプロセスで動かしたいプログラムを記述
forkを二回呼んだり、setsidを使ったり、ファイルディスクリプタを閉じたりするのは、デーモンをターミナル(制御端末)から完全に切り離すのに必要らしい。
作成したもの
上のデーモン化処理に加えて、次のような機能も実装。
- デーモン化の有無フラグ
- pidファイル作成
- ログ用の簡単な関数
後、*standard-output*と*standard-input*は(クライアント)ソケットのstreamにバインドするようにした。
簡単な使用例。
;; 3000番ポートで待機するデーモンプロセス(サーバ)作成 ;; deamon:log関数は、*error-output*に出力を行う (deamon:do-accept (#(0 0 0 0) 3000) (deamon:log "==============") (deamon:log "リクエスト") (read-request *standard-input*) (deamon:log "レスポンス") (write-response *standard-output*)) ;;; デーモンプロセスにしない場合 (deamon:do-accept (#(0 0 0 0) 3000 :deamon nil) ...) ;;; pidファイルを作成する場合 (deamon:do-accept (#(0 0 0 0) 3000 :pid "/tmp/3000.pid") ...) ;;; ログをファイルに書き出す場合 (deamon:do-accept (#(0 0 0 0) 3000 :log "/tmp/3000.log") ...)
全部で100行にも満たないので、ソースコードを以下に掲載。
また、asdfを使ってインストールできると便利なので、それも用意: deamon(0.1.0)
(require :sb-bsd-sockets) (require :sb-posix) (defpackage :deamon (:use :common-lisp :sb-bsd-sockets) (:shadow :log) (:export :do-accept :log)) (in-package :deamon) ;;; 定数とか (defconstant MAXFD 64) (defvar *common-lisp-streams* '(*standard-input* *standard-output* *query-io* *debug-io* *terminal-io* *error-output* *trace-output*)) ;; 空stream作成 (defun make-null-io-stream () (open "/dev/null" :direction :io :if-exists :overwrite)) ;; ログ用のstream作成 (defun make-log-stream (log deamon?) (cond ((typep log '(or string pathname)) (open log :direction :output :if-exists :append :if-does-not-exist :create)) ((or deamon? (null log)) (make-broadcast-stream)) (t *error-output*))) ;; pidファイル作成 (defun write-pid-file (pid) (check-type pid (or string pathname NULL)) (when pid (with-open-file (out pid :direction :output :if-exists :supersede) (princ (sb-posix:getpid) out)))) ;; forkして親プロセスを終了 (defun fork-and-exit-parent () (unless (zerop (sb-posix:fork)) (sb-ext:quit))) ;; デーモンプロセス作成関数 (defun init-deamon () (fork-and-exit-parent) (sb-posix:setsid) (fork-and-exit-parent) (sb-posix:chdir "/") (sb-posix:umask 0) (dotimes (fd MAXFD) (sb-unix:unix-close fd)) (let ((null-io (make-null-io-stream))) (dolist (s *common-lisp-streams*) (setf s null-io)))) ;; TCPのconnect,listen,acceptを行ってくれるマクロ (defmacro do-accept-impl ((address port backlog error-output) &body body) (let ((server (gensym)) (client (gensym))) `(let ((,server (make-instance 'inet-socket :type :stream :protocol :tcp))) (unwind-protect (progn (setf (sockopt-reuse-address ,server) t) (socket-bind ,server ,address ,port) (socket-listen ,server ,backlog) (loop (let ((,client (socket-accept ,server))) (sb-thread:make-thread (lambda () (let* ((*standard-output* (socket-make-stream ,client :input t :output t :element-type '(unsigned-byte 8))) (*error-output* ,error-output) (*standard-input* *standard-output*)) (unwind-protect (progn ,@body) (close *standard-output*)))))))) (socket-close ,server))))) ;; (defmacro do-accept ((address port &key (backlog 16) (deamon t) pid (log t)) &body body) (let ((error-output (gensym))) `(progn ,(when deamon '(init-deamon)) (let ((,error-output (make-log-stream ,log ,deamon))) (unwind-protect (handler-case (progn (write-pid-file ,pid) (do-accept-impl (,address ,port ,backlog ,error-output) ,@body)) (error (c) (format ,error-output "~A: ~A~%" (type-of c) c))) (when (typep ,error-output 'sb-sys:fd-stream) (close ,error-output))))))) ;; ログ関数 (defun log (fmt-str &rest args) (if (typep fmt-str 'string) (apply #'format *error-output* fmt-str args) (princ fmt-str *error-output*)) (terpri *error-output*) (force-output *error-output*))
少し更新
若干機能追加。
ほとんど、sb-bsd-sockets:make-socket-stream関数に渡す引数を増やしただけなので、ソースはdeamon(0.1.1)を参照。
;; bivalent-streamを使う (deamon:do-accept (#(0 0 0 0) 3000 :bivalent t) ;; どちらの入力関数でも大丈夫 (read-char *standard-input*) (read-byte *standard-input*)) ;; 読み込みtimeoutを設定 (deamon:do-accept (#(0 0 0 0) 3000 :read-timeout 3) (handler-case (read) (timeout () ...))) ;; serverとclientのソケットを参照できるようにする(名前は適当) (deamon:do-accept (#(0 0 0 0) 3000 :anaph t) ;; シンボル「client」と「server」で参照可能に (sb-bsd-sockets:socket-peername client) (sb-bsd-sockets:socket-peername server))