hi,
sorry for the late reply, i didn't have much time/energy for chicken
in the last few weeks :(
i'm using the following code in a daemon i wrote:
(iirc i translated it from a perl manpage or something)
(require-extension posix)
(define (daemon:ize)
(change-directory "/")
(let ((fd-r (file-open "/dev/null" open/rdonly))
(fd-w (file-open "/dev/null" open/wronly)))
(duplicate-fileno fd-r 0)
(duplicate-fileno fd-w 1)
(file-close fd-r)
(file-close fd-w))
(let ((child-pid (process-fork)))
(if (not (zero? child-pid))
(exit 0)))
(create-session)
(duplicate-fileno 1 2)
(void))
i also wanted to create an egg from that code, along with some
syslog functions, but was to lazy to do it as yet :)
perhaps we should merge our code...
On Fri, Nov 16, 2007 at 01:21:25PM -0600, Ozzi wrote:
> I'm most definitely not a scheme guru, so if someone with half a clue would
> take a look at my little daemonize egg below and let me know what they
> think, I'd appreciate it.
>
> I ended up using the (foreign-lambda int "daemon" int int) approach.
afaik daemon() already calls fork() so i don't think you'd really
need to call (process-fork) then.
otoh - daemon() is like my (daemon:ize) function above, it terminates
the parent process which means your api would change and it would no
longer be directly possible to fork multiple independent daemon processes
from a single master.
i've attached my whole daemon library including the syslog functions.
bye,
hans.
> I use on-exit to remove the PID file, which means that the daemon have to
> handle signals and exit cleanly. I added a default handler for signal/term
> to call (exit), there are probably other default handlers that should be
> added.
>
> Oz
>
>
>
> (define (daemonize proc #!key (pidfile #f))
>
> (define (create-pid-file filename pid)
> (with-output-to-file filename (lambda () (print pid))))
>
> (define (remove-pid-file filename)
> (delete-file* filename))
>
> (define (run-pre-fork-tests)
> (when pidfile
> (when (file-exists? pidfile)
> (error "PID file exists."))
> (unless (file-exists? (pathname-directory pidfile))
> (error "Directory for PID file does not exist."))
> (unless (and
> (file-read-access? (pathname-directory pidfile))
> (file-write-access? (pathname-directory pidfile))
> (file-execute-access? (pathname-directory pidfile)))
> (error "Insuficcient rights to create PID file."))))
>
> (define (set-default-signal-handlers)
> (set-signal-handler! signal/term (lambda (signum) (exit))))
>
> (define (cleanup)
> (if pidfile (remove-pid-file pidfile)))
>
> (run-pre-fork-tests)
>
> (process-fork
> (lambda ()
> ((foreign-lambda int "daemon" int int) 0 0)
> (on-exit cleanup)
> (if pidfile (create-pid-file pidfile pid))
> (set-default-signal-handlers)
> (proc))) #t)
;;;; DJ Seppl! Da best deejay in town!!
;;;; (c)2007 Hans Bulfone <[EMAIL PROTECTED]>
(declare
(unit daemon)
(export daemon:openlog daemon:syslog daemon:ize)
(foreign-declare "#include <syslog.h>"))
(require-extension posix)
(define-macro (def-c-constants prefix . constants)
`(begin
,@(append-map
(lambda (x)
(let ((scm-name (string->symbol
(string-append
prefix
(string-translate x "_" "-")))))
`((define ,scm-name (foreign-value ,x integer))
(declare (export ,scm-name)))))
constants)))
(def-c-constants "daemon:"
"LOG_CONS" "LOG_NDELAY" "LOG_NOWAIT" "LOG_ODELAY" "LOG_PID"
"LOG_AUTHPRIV" "LOG_CRON" "LOG_DAEMON" "LOG_KERN"
"LOG_LOCAL0" "LOG_LOCAL1" "LOG_LOCAL2" "LOG_LOCAL3" "LOG_LOCAL4"
"LOG_LOCAL5" "LOG_LOCAL6" "LOG_LOCAL7"
"LOG_LPR" "LOG_MAIL" "LOG_NEWS" "LOG_SYSLOG" "LOG_USER" "LOG_UUCP"
"LOG_EMERG" "LOG_ALERT" "LOG_CRIT" "LOG_ERR" "LOG_WARNING"
"LOG_NOTICE" "LOG_INFO" "LOG_DEBUG")
;; WARNING: openlog leaks memory if ident is not #f
(define daemon:openlog
(foreign-lambda*
void ((c-string ident) (integer option) (integer facility))
"openlog(((ident)?strdup(ident):NULL), option, facility);"))
(define %syslog
(foreign-lambda*
void ((integer priority) (nonnull-c-string message))
"syslog(priority, \"%s\\n\", message);"))
(define (daemon:syslog priority message . args)
(%syslog priority (apply sprintf message args)))
(define (daemon:ize)
(change-directory "/")
(let ((fd-r (file-open "/dev/null" open/rdonly))
(fd-w (file-open "/dev/null" open/wronly)))
(duplicate-fileno fd-r 0)
(duplicate-fileno fd-w 1)
(file-close fd-r)
(file-close fd-w))
(let ((child-pid (process-fork)))
(if (not (zero? child-pid))
(exit 0)))
(create-session)
(duplicate-fileno 1 2)
(void))
_______________________________________________
Chicken-users mailing list
Chicken-users@nongnu.org
http://lists.nongnu.org/mailman/listinfo/chicken-users
