;;;; DJ Seppl!  Da best deejay in town!!
;;;; (c)2007 Hans Bulfone <address@hidden>

(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))