;;; -*- Mode: LISP; Package: :cl-user; BASE: 10; Syntax: ANSI-Common-Lisp; -*-
;;;
;;;   Touched: Sun Aug 06 21:28:43 2006 +0530 <enometh@meer.net>
;;;   Time-stamp: <06/08/07 06:36:00 madhu>
;;;   Bugs-To: enometh@net.meer
;;;
;;;  (C) 2006 Madhu, All Rights Reserved
;;; SysV IPC under CMUCL, useful for logging messages from some process.

(defpackage "MSGOP" (:use "CL") (:export "LOGD"))
(in-package "MSGOP")
;;;
;;; msgget(2) - get a message queue identifier
;;;
(alien:def-alien-routine "msgget"  c-call:int
  (key c-call::unsigned)
  (msgflag c-call:int))

;;; from <linux/ipc.h>
(defconstant IPC_CREAT  00001000)   ;; create if key is nonexistent 
(defconstant IPC_EXCL   00002000)   ;; fail if key exists 
(defconstant IPC_NOWAIT 00004000)   ;; return error on wait

;;;
;;; Error reporting:
;;;
(defun errsys (control-string &rest format-args)
  "Fatal error related to a system call. Should terminate. print
 the system's errno value and its associated message."
  (let ((errno (UNIX:UNIX-ERRNO)))
    (assert (> errno 0))
    (apply #'error (concatenate 'string control-string "(~D): ~A~&")
	   (append format-args
		   (list errno
			 (UNIX:GET-UNIX-ERROR-MSG errno))))))

(defvar *mkey1* 1234)
(defvar *perms* #o666)

(defun create-message-queue-if-required ()
  (let ((id (msgget *mkey1* (logior *perms* IPC_CREAT))))
    (if (< id 0)
	(errsys "Cannot get Message Queue ~A" *mkey1*)
	id)))

(defvar *id* nil)

(defconstant LOGMESG 1)			; A message type.
(defconstant MAXMESGLEN 80)	  ; 80 columns is enough for everyone.

;; Template for struct to be used as argument for `msgsnd' and
;; `msgrcv'. From <sys/msg.h>
(alien:def-alien-type nil
    (alien:struct
     msgbuf
     (mtype c-call:int)		; type of received/sent message.
     (mtext (array c-call:char #.MAXMESGLEN))))	; text of message.


(defvar *msgbuf* (alien:make-alien (alien:struct msgbuf)))

;; msgrcv(2) - reads a message from the message queue specified by
;; msqid into the msgbuf pointed to by the msgp argument, removing the
;; read message from the queue.

(alien:def-alien-routine "msgrcv"  c-call:int ;ssize_t
  (msqid c-call:int)
  (msgp (* (alien:struct msgbuf)))
  (msgsz c-call:int)			;size_t
  (msgtyp c-call:long)
  (msgflg c-call:int))

(defun logd ()
  "Read messages of type LOGMESG from message queue specified by
*ID*"
  (setf (unix:unix-errno) 0)
  (when (null *id*)
    (setq *id* (create-message-queue-if-required)))
  (loop
     (let ((n (msgrcv *id* (alien:alien-sap *msgbuf*) MAXMESGLEN LOGMESG 0)))
       (cond ((< n 0)
	      (unwind-protect		; cerror, actually
		   (restart-case (errsys "msgrcv failed")
		     (return () (return))
		     (continue ()))
		(setf (unix:unix-errno) 0)))
	     ((> n 0)
	      (assert (<= n MAXMESGLEN))
	      (warn "{~A}~%~A" (user::iso-8601-date)
		    (coerce (loop for i below n
				  collect
				  (code-char
				   (alien:deref
				    (alien:slot *msgbuf* 'mtext)
				    i)))
			    'string)))
	     ((= n 0)		     ; implies client asked us to quit
	      (return)))))
  (setq *id* nil))