From d95bef644a3c533c6e50e8d34cd6a8f0a98e63dc Mon Sep 17 00:00:00 2001 From: Dimitri Fontaine Date: Mon, 9 Sep 2013 22:31:11 +0200 Subject: [PATCH] Use the ABNF machinery in the syslog message receiver and parser. --- syslog.lisp | 195 ++++------------------------------------------------ 1 file changed, 14 insertions(+), 181 deletions(-) diff --git a/syslog.lisp b/syslog.lisp index 4daae2b..b876c44 100644 --- a/syslog.lisp +++ b/syslog.lisp @@ -6,194 +6,27 @@ (in-package #:pgloader.syslog) -(defvar *buffer* "" "Buffer we are currently parsing") -(defvar *position* 0 "Reading position in the message") -(defvar *message* nil "Current message parsed from the *buffer*") +(defun process-message (data) + "Process the data: send it in the queue for PostgreSQL COPY handling." + (format t "data: ~{~a~^, ~}~%" data)) -;; -;; Those "constants" straight from the RFC 3164 -;; -(defvar *facility-bytespec* (byte 3 0) "Read facility from priority") -(defvar *severity-bytespec* (byte 5 3) "Read severity from priority") - -(defvar *space-code-set* #. (quote (coerce " " 'list))) -(defvar *decimal-code-set* #. (quote (coerce "0123456789" 'list))) -(defvar *header-code-set* #. (quote (loop - :for i :from 32 :to 126 - :collect (code-char i)))) -(defvar *alphabetical-code-set* - #. (quote (concatenate 'list - "abcdefghijklmnopqrstuvwxyz" - "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))) - -(defvar *month-abbrevs* - '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) - -(defun parse-priority (pri &aux (priority (parse-integer pri))) - "Return facility and severity from PRI, as multiple values" - (values (ldb *facility-bytespec* priority) - (ldb *severity-bytespec* priority))) - -(defstruct message facility severity timestamp hostname tag content) - -;; -;; Some low level utils -;; -(defun skip-one (character-bag) - "Skip a character in the stream" - ;; NOOP as of now TODO: signal a condition if current *buffer* *position* - ;; is not containing a character of the bag - (declare (ignore character-bag)) - (incf *position*)) - -(defun skip-many (character-bag) - "Skip all characters from CHARACTER-BAG current *buffer*" - (loop - :while (member (aref *buffer* *position*) character-bag) - :do (incf *position*))) - -(defun collect-many (character-bag) - "Return a string of the chars found in *buffer* at *position* that are in - the given CHARACTER-BAG." - (coerce - (loop - :until (= *position* (length *buffer*)) - :for char = (aref *buffer* *position*) - :while (member char character-bag) - :collect char - :do (incf *position*)) - 'string)) - -(defun collect-max (character-bag limit) - "Return a string of the chars found in *buffer* at *position* that are in - the given CHARACTER-BAG." - (coerce - (loop - :repeat limit - :for char = (aref *buffer* *position*) - :while (member char character-bag) - :collect char - :do (incf *position*)) - 'string)) - -(defun collect-until (character-bag) - "Collect characters and increment *position* until we reach one of - CHARACTER-BAG." - (coerce - (loop - :for char = (aref *buffer* *position*) - :until (member char character-bag) - :collect char - :do (incf *position*)) - 'string)) - -(defun read-one-of (list-of-strings &optional length) - "Return one of the strings given in LIST-OF-STRINGS and increment *position*." - (loop - :for match :in list-of-strings - :for len = (or length (length match)) - :until (string= match - (coerce - (subseq *buffer* *position* (+ *position* len)) 'string)) - :finally (progn (incf *position* len) - (return match)))) - -;; -;; Read parts of the syslog message -;; -(defun read-priority () - "Reads the priority from the BUFFER position POS and return the priority - and the next item position as multiple values" - (skip-one "<") - (multiple-value-bind (facility severity) - (parse-priority (collect-many *decimal-code-set*)) - (setf (message-facility *message*) facility - (message-severity *message*) severity)) - (skip-one ">")) - -(defun read-spaces-and-number () - (skip-many *space-code-set*) - (let ((digits (collect-many *decimal-code-set*))) - (or (parse-integer digits :junk-allowed t) 0))) - -(defun maybe-read-year () - "See if there's a year and/or a TZ at current *position* in *buffer*." - (let* ((start-position *position*) - (ignore-space (skip-one " ")) - (digits-at-point (collect-many *decimal-code-set*))) - (declare (ignore ignore-space)) - (if (and digits-at-point - (char= (aref *buffer* *position*) #\Space) - (or (= 2 (length digits-at-point)) - (= 4 (length digits-at-point)))) - (parse-integer digits-at-point) - ;; that was not a year after all - (prog2 (setf *position* start-position) - ;; get current year - (nth 5 (multiple-value-list (get-decoded-time))))))) - -(defun read-timestamp () - "The TIMESTAMP field is the local time and is in the format of \"Mmm dd - hh:mm:ss\" (without the quote marks)" - (multiple-value-bind (month day hours mins secs year) - (values (+ 1 (position (read-one-of *month-abbrevs*) - *month-abbrevs* - :test #'string=)) ; month - (read-spaces-and-number) ; day - (read-spaces-and-number) ; hours - (prog2 (skip-one ":") ; - (read-spaces-and-number)) ; mins - (prog2 (skip-one ":") ; - (read-spaces-and-number)) ; secs - (maybe-read-year)) ; year - (setf (message-timestamp *message*) - (local-time:encode-timestamp 0 secs mins hours day month year)))) - -(defun read-hostname () - "Any non whitespace is constituent of the HOSTNAME field." - (setf (message-hostname *message*) (collect-until *space-code-set*))) - -(defun read-header () - "Read the HEADER part of a syslog UDP buffer" - (read-timestamp) - (skip-one " ") - (read-hostname) - (skip-one " ")) - -(defun read-tag () - (setf (message-tag *message*) (collect-max *alphabetical-code-set* 32))) - -(defun read-content () - (setf (message-content *message*) (subseq *buffer* *position*))) - -(defun read-msg () - (read-tag) - (read-content)) - -(defun parse-message (&key - ((:buffer *buffer*) *buffer*) - ((:position *position*) *position*)) - "Parse a whole syslog message and return a message structure." - ;; (declare (type (simple-array (unsigned-byte 8) *) *buffer*)) - (let ((*message* (make-message))) - (read-priority) - (read-header) - (read-msg) - *message*)) - -(defun syslog-udp-handler (buffer) +(defun syslog-udp-handler (buffer scanners) "Handler to register to usocket:socket-server call." (declare (type (simple-array (unsigned-byte 8) *) buffer)) - (let* ((*buffer* (map 'string #'code-char buffer)) - (*position* 0) - (mesg (parse-message))) - (format t "recv: ~a~%" mesg))) + (let* ((mesg (map 'string #'code-char buffer))) + (loop + for scanner in scanners + for (match parts) = (multiple-value-list + (cl-ppcre:scan-to-strings scanner mesg)) + until match + finally (process-message (coerce parts 'list))))) (defun start-syslog-server (&key + scanners (host nil) (port 10514)) "Start our syslog socket and read messages." - (usocket:socket-server host port #'syslog-udp-handler nil + (usocket:socket-server host port #'syslog-udp-handler (list scanners) :protocol :datagram :reuse-address t :element-type '(unsigned-byte 8))) @@ -210,7 +43,7 @@ #| -(send-message "<165>Aug 29 00:30:12 Dimitris-MacBook-Air.local coreaudiod[215]: Enabled automatic stack shots because audio IO is inactive") +(send-message "<165>1 2013-08-29T00:30:12Z Dimitris-MacBook-Air.local coreaudiod[215]: - - Enabled automatic stack shots because audio IO is inactive") (send-message "<0>Aug 31 21:38:28 Dimitris-MacBook-Air.local Google Chrome[236]: notify name \"com.apple.coregraphics.GUIConsoleSessionChanged\" has been registered 20 times - this may be a leak")