git.fiddlerwoaroof.com
Browse code

Working version

fiddlerwoaroof authored on 03/10/2016 00:03:39
Showing 9 changed files
.gitignore
History View file @ 117ea1e
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,2 @@
1 
+*~
2 
+syslog-helper
client.lisp
History View file @ 117ea1e
0 3 
new file mode 100644
... ... 
@@ -0,0 +1,40 @@
1 
+;; This Source Code Form is subject to the terms of the Mozilla Public
2 
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
3 
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
4 
+
5 
+(in-package #:syslog_helper)
6 
+
7 
+(defsynopsis ()
8 
+  (flag :short-name "h" :long-name "help" :description "Show the help")
9 
+  (stropt :short-name "s" :long-name "severity" :description "Show this syslog severity (or higher)"
10 
+	  :default-value (format nil "~a" (encode-severity "debug")))
11 
+  (stropt :short-name "f" :long-name "facility" :description "Show messages from comma-separated list of facilities"))
12 
+
13 
+(defun main ()
14 
+  (declare (optimize (debug 3)))
15 
+  (ql:quickload :swank)
16 
+  (swank:create-server :port 5676 :dont-close t)
17 
+  (make-context)
18 
+  (cl-ansi-term:register-hook :before-printing
19 
+			      (lambda ()
20 
+				(handler-case (setf cl-ansi-term:*terminal-width*
21 
+						    (cadr (get-term-size)))
22 
+				  (osicat-posix:enotty (c) c nil))))
23 
+  (if (getopt :long-name "help")
24 
+      (help)
25 
+      (let ((match-severity (parse-integer (or (getopt :long-name "severity")
26 
+					       "7")))
27 
+	    (match-facilities (split-sequence:split-sequence #\, (getopt :long-name "facility")
28 
+							     :remove-empty-subseqs t)))
29 
+	(when match-facilities
30 
+	  (setf match-facilities
31 
+		(loop for facility in match-facilities
32 
+		   if (digit-char-p (elt facility 0)) collect (parse-integer facility)
33 
+		   else collect (encode-facility (string-downcase facility)))))
34 
+	(handler-case
35 
+	    (with-simple-restart (abort "Exit")
36 
+	      (loop
37 
+		 (with-simple-restart (continue "Restart server")
38 
+		   (start-syslog-server (main-loop match-severity match-facilities)))))
39 
+	  #+sbcl (sb-sys:interactive-interrupt (c) c)))))
40 
+
db-write.lisp
History View file @ 117ea1e
0 41 
new file mode 100644
... ... 
@@ -0,0 +1,21 @@
1 
+;; This Source Code Form is subject to the terms of the Mozilla Public
2 
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
3 
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
4 
+
5 
+(in-package #:syslog_helper)
6 
+
7 
+(defun log-to-sqlite (db severity facility tag pid message host)
8 
+  (let* ((query (dbi:prepare db "insert into messages (severity, facility, tag, pid, message, host) values (?,?,?,?,?,?)"))
9 
+	 (result (dbi:execute query severity facility tag pid message host)))
10 
+    result))
11 
+
12 
+(defun log-dnsquery-to-sqlite (db &key query-type query from)
13 
+  (let* ((db-query (dbi:prepare db "insert into dns_query (query_type, request, requester) values (?,?,?)"))
14 
+	 (result (dbi:execute db-query query-type query from)))
15 
+    result))
16 
+
17 
+(defun log-dnsreply-to-sqlite (db &key query reply)
18 
+  (let* ((db-query (dbi:prepare db "insert into dns_reply (query, reply) values (?,?)"))
19 
+	 (result (dbi:execute db-query query reply)))
20 
+    result))
21 
+
log-handler.lisp
History View file @ 117ea1e
0 22 
new file mode 100644
... ... 
@@ -0,0 +1,82 @@
1 
+(in-package #:syslog_helper)
2 
+
3 
+(define-codecs facility ()
4 
+  (0 "kernel")
5 
+  (1 "user")
6 
+  (2 "mail")
7 
+  (3 "system")
8 
+  (4 "security")
9 
+  (5 "syslogd")
10 
+  (6 "lpr")
11 
+  (7 "nntp")
12 
+  (8 "uucp")
13 
+  (9 "clock")
14 
+  (10 "auth")
15 
+  (11 "ftp")
16 
+  (12 "ntp")
17 
+  (13 "audit")
18 
+  (14 "alert")
19 
+  (15 "clock1")
20 
+  (16 "local0")
21 
+  (17 "local1")
22 
+  (18 "local2")
23 
+  (19 "local3")
24 
+  (20 "local4")
25 
+  (21 "local5")
26 
+  (22 "local6")
27 
+  (23 "local7"))
28 
+
29 
+(define-codecs severity ()
30 
+  (0 "emergency") ; system is unusable
31 
+  (1 "alert")	; action must be taken immediately
32 
+  (2 "critical") ; critical conditions
33 
+  (3 "error")	   ; error conditions
34 
+  (4 "warning")  ; warning conditions
35 
+  (5 "notice") ; normal but significant condition
36 
+  (6 "info")	; informational messages
37 
+  (7 "debug"))	; debug-level messages
38 
+
39 
+(defun format-tag (tag-data)
40 
+  (if tag-data
41 
+      (destructuring-bind (tag pid) tag-data
42 
+	(format nil "[~a~:[~; ~:*~a~]]" tag pid))
43 
+      "[untagged]"))
44 
+
45 
+(defgeneric handle-log-message (tag metadata message orig-line)
46 
+  (:method (tag metadata message orig-line)
47 
+    (declare (ignore tag metadata message))))
48 
+
49 
+(defmethod handle-log-message ((tag (eql :dnsmasq)) metadata message orig-line)
50 
+  (let* ((parsed-query (smug:parse (.dnsmasq-query) message))
51 
+	 (parsed-reply (unless parsed-query
52 
+			 (smug:parse (.dnsmasq-reply) message))))
53 
+    (dbi:with-connection (db :sqlite3 :database-name "/tmp/logs.db")
54 
+      (when parsed-query
55 
+	(apply #'log-dnsquery-to-sqlite db parsed-query))
56 
+      (when parsed-reply
57 
+	(apply #'log-dnsreply-to-sqlite db parsed-reply)))))
58 
+
59 
+(defun main-loop (match-severity match-facilities)
60 
+  (declare (optimize (debug 3)))
61 
+  (lambda (line)
62 
+    (let ((host-info (format nil "~{~a~^.~}:~a "
63 
+			     (map 'list #'identity usocket:*remote-host*)
64 
+			     usocket:*remote-port*)))
65 
+      (with-simple-restart (skip "skip this line")
66 
+	(multiple-value-bind (facility severity tag-els timestamp message) (parse-syslog line)
67 
+	  (destructuring-bind (tag pid) tag-els
68 
+	    (dbi:with-connection (db :sqlite3 :database-name "/tmp/logs.db")
69 
+	      (when (< severity 7)
70 
+		(log-to-sqlite db severity facility tag pid message host-info)))
71 
+	    (when (and (<= severity match-severity)
72 
+		       (or (null match-facilities)
73 
+			   (member facility match-facilities)))
74 
+	      (cl-ansi-term:cat-print
75 
+	       `((,(format nil "~11<<~a~>:~11@<~a>~>"
76 
+			   (decode-facility facility)
77 
+			   (decode-severity severity))
78 
+		   ,(alexandria:make-keyword (string-upcase (decode-severity severity))))
79 
+		 ,host-info
80 
+		 (,(format-tag tag-els) :info)
81 
+		 ,message)))))))))
82 
+
package.lisp
History View file @ 117ea1e
0 83 
new file mode 100644
... ... 
@@ -0,0 +1,9 @@
1 
+;;;; package.lisp
2 
+
3 
+;; This Source Code Form is subject to the terms of the Mozilla Public
4 
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
5 
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
6 
+
7 
+(defpackage #:syslog_helper
8 
+  (:use :net.didierverna.clon #:cl))
9 
+
parser.lisp
History View file @ 117ea1e
0 10 
new file mode 100644
... ... 
@@ -0,0 +1,147 @@
1 
+;; This Source Code Form is subject to the terms of the Mozilla Public
2 
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
3 
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
4 
+
5 
+(in-package #:syslog_helper)
6 
+
7 
+(defun .one-of (choices)
8 
+  (apply #'smug:.or
9 
+	 (mapcar #'smug:.string=
10 
+		 choices)))
11 
+
12 
+(defun .numeric-in-range (&key (min 0) max (min-inclusive t) max-inclusive)
13 
+  (let ((min-op (if min-inclusive #'<= #'<))
14 
+	(max-op (if max-inclusive #'>= #'>)))
15 
+    (smug:.let* ((num (smug:.first (smug:.map 'string (smug:.is #'digit-char-p)))))
16 
+      (let ((num (parse-integer num)))
17 
+	(if (and (funcall min-op min num)
18 
+		 (if max
19 
+		     (funcall max-op max num)
20 
+		     t))
21 
+	    (smug:.identity num)
22 
+	    (smug:.fail))))))
23 
+
24 
+(defun .time ()
25 
+  (flet ((.min-sec ()
26 
+	     (.numeric-in-range :max 60))
27 
+	   (.hour ()
28 
+	     (.numeric-in-range :max 24)))
29 
+    (smug:.let* ((hour (smug:.prog1 (.hour)
30 
+				    (smug:.char= #\:)))
31 
+		 (minute (smug:.prog1 (.min-sec)
32 
+				      (smug:.char= #\:)))
33 
+		 (second (.min-sec)))
34 
+      (smug:.identity (format nil "~2,'0d:~2,'0d:~2,'0d" hour minute second)))))
35 
+
36 
+(defun .timestamp ()
37 
+  (flet ((.month ()
38 
+	   (.one-of '("Jan" "Feb" "Mar" "Apr" "May" "Jun"
39 
+		      "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))
40 
+	 (.day ()
41 
+	   (.numeric-in-range :max 32)))
42 
+    (smug:.let* ((month (smug:.prog1 (.month)
43 
+				     (smug:.map 'list
44 
+						(smug:.char= #\space))))
45 
+		 (day (smug:.prog1 (.day)
46 
+				   (smug:.map 'list
47 
+					      (smug:.char= #\space))))
48 
+		 (time (.time)))
49 
+      (smug:.identity (format nil "~a ~a ~a" month day time)))))
50 
+
51 
+(defun .hostname ()
52 
+  (smug:.prog1
53 
+   (smug:.first
54 
+    (smug:.map 'string
55 
+	       (smug:.or (smug:.char= #\.)
56 
+			 (smug:.is #'alphanumericp))))
57 
+   (smug:.char= #\space)))
58 
+
59 
+(defun .tag ()
60 
+  (smug:.first
61 
+   (smug:.prog1
62 
+    (smug:.let* ((tag (smug:.optional (smug:.map 'string
63 
+						 (smug:.is #'alphanumericp))))
64 
+		 (process (smug:.optional
65 
+			   (smug:.prog2 (smug:.char= #\[)
66 
+					(smug:.map 'string (smug:.is #'digit-char-p))
67 
+					(smug:.char= #\])))))
68 
+      (if (> (length tag) 32)
69 
+	  (smug:.fail)
70 
+	  (smug:.identity (list (or tag "untagged")
71 
+				(when process
72 
+				  (parse-integer process))))))
73 
+    (smug:.optional (smug:.char= #\:)))))
74 
+
75 
+(defun .dnsmasq-reply ()
76 
+  (smug:.progn (smug:.optional (smug:.char= #\space))
77 
+	       (.one-of '("cached " "reply " "/tmp/hosts/dhcp " "DHCP "))
78 
+	       (smug:.let* ((query (smug:.prog1 (smug:.map 'string
79 
+							   (smug:.or (smug:.char= #\-)
80 
+								     (smug:.char= #\_)
81 
+								     (smug:.char= #\.)
82 
+								     (smug:.is #'alphanumericp)))
83 
+						(smug:.string= " is ")))
84 
+			    (reply (smug:.prog1 (smug:.map 'string (smug:.item))
85 
+						(smug:.not (smug:.item)))))
86 
+		 (smug:.identity (list :query query
87 
+				       :reply reply)))))
88 
+
89 
+(defun .dnsmasq-query ()
90 
+  (smug:.progn (smug:.optional (smug:.char= #\space))
91 
+	       (smug:.string= "query")
92 
+	       (smug:.let* ((query-type (smug:.prog2 (smug:.char= #\[)
93 
+						     (smug:.map 'string (smug:.is #'upper-case-p))
94 
+						     (smug:.char= #\])
95 
+						     (smug:.char= #\space)))
96 
+			    (query (smug:.prog1 (smug:.map 'string
97 
+							       (smug:.or (smug:.char= #\-)
98 
+									 (smug:.char= #\_)
99 
+									 (smug:.char= #\.)
100 
+									 (smug:.is #'alphanumericp)))
101 
+						    (smug:.string= " from ")))
102 
+			    (from (smug:.prog1 (smug:.map 'string (smug:.item))
103 
+					       (smug:.not (smug:.item)))))
104 
+		 (smug:.identity (list :query-type query-type
105 
+				       :query query
106 
+				       :from from)))))
107 
+
108 
+(defstruct (priority (:type vector))
109 
+  facility severity)
110 
+
111 
+(defun extract-priority (line)
112 
+  "Extract a priority from a syslog line and parse it into a severity/priority list"
113 
+  (when (char= (elt line 0)
114 
+	       #\<)
115 
+    (multiple-value-bind (result end) (parse-integer line :start 1 :junk-allowed t)
116 
+      (when (and (< end
117 
+		    (length line))
118 
+		 (char= (elt line end)
119 
+			#\>))
120 
+	(values (multiple-value-call #'vector
121 
+		  (floor result 8))
122 
+		(1+ end))))))
123 
+
124 
+(defun parse-syslog (line)
125 
+  (multiple-value-bind (priority end-priority) (extract-priority line)
126 
+    (let ((line (subseq line end-priority)))
127 
+      (multiple-value-bind (timestamp ts-leftover) (smug:parse (smug:.optional (smug:.prog1 (.timestamp)
128 
+											    (smug:.map 'list
129 
+												       (smug:.char= #\space))))
130 
+							       line)
131 
+	(multiple-value-bind (hostname hn-leftover) (smug:parse (smug:.optional (.hostname)) ts-leftover)
132 
+	  (multiple-value-bind (tag-els leftover) (smug:parse (.tag) hn-leftover)
133 
+	    (handle-log-message (alexandria:make-keyword
134 
+				 (string-upcase (car tag-els)))
135 
+				(list :priority priority
136 
+				      :timestamp timestamp
137 
+				      :hostname hostname
138 
+				      :tag-value (car tag-els)
139 
+				      :tag-pid (cadr tag-els))
140 
+				leftover
141 
+				line)
142 
+	    (values (priority-facility priority)
143 
+		    (priority-severity priority)
144 
+		    tag-els
145 
+		    timestamp
146 
+		    leftover)))))))
147 
+
syslog-server.lisp
History View file @ 117ea1e
0 148 
new file mode 100644
... ... 
@@ -0,0 +1,20 @@
1 
+;;;; syslog_helper.lisp
2 
+
3 
+;; This Source Code Form is subject to the terms of the Mozilla Public
4 
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
5 
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
6 
+
7 
+(in-package #:syslog_helper)
8 
+
9 
+(defvar *zxcv* *debug-io*
10 
+  "Where to send debug output: only used during development")
11 
+
12 
+(defun start-syslog-server (handler &key (port 514))
13 
+  (usocket:socket-server "0.0.0.0" port
14 
+			 (lambda (buffer)
15 
+			   (declare (type (simple-array (unsigned-byte 8) *) buffer))
16 
+			   (funcall handler (babel:octets-to-string buffer))
17 
+			   (vector))
18 
+			 nil
19 
+			 :protocol :datagram))
20 
+
syslog_helper.asd
History View file @ 117ea1e
0 21 
new file mode 100644
... ... 
@@ -0,0 +1,32 @@
1 
+;;;; syslog_helper.asd
2 
+
3 
+;; This Source Code Form is subject to the terms of the Mozilla Public
4 
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
5 
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
6 
+
7 
+(asdf:defsystem #:syslog_helper
8 
+  :description "A syslog server that prints incoming logs prettily and writes them to a db"
9 
+  :author "Edward Langeley"
10 
+  :license "MPLv2"
11 
+  :depends-on (#:alexandria
12 
+	       #:cffi
13 
+	       #:cl-ansi-term
14 
+	       #:cl-dbi
15 
+	       #:dbd-sqlite3
16 
+	       #:fwoar.lisputils
17 
+	       #:net.didierverna.clon
18 
+	       #:osicat
19 
+	       #:positional-lambda
20 
+	       #:serapeum
21 
+	       #:smug
22 
+	       #:swank
23 
+	       #:usocket)
24 
+  :serial t
25 
+  :components ((:file "package")
26 
+	       (:file "utils")
27 
+	       (:file "parser")
28 
+	       (:file "db-write")
29 
+	       (:file "syslog-server")
30 
+	       (:file "log-handler")
31 
+	       (:file "client")))
32 
+
utils.lisp
History View file @ 117ea1e
0 33 
new file mode 100644
... ... 
@@ -0,0 +1,52 @@
1 
+;; This Source Code Form is subject to the terms of the Mozilla Public
2 
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
3 
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
4 
+
5 
+(in-package #:syslog_helper)
6 
+
7 
+(cffi:defcstruct winsize
8 
+  (ws_row :unsigned-short)
9 
+  (ws_col :unsigned-short)
10 
+  (ws_xpixel :unsigned-short)
11 
+  (ws_ypixel :unsigned-short))
12 
+
13 
+(defun get-term-size ()
14 
+  (flet ((ioctl-gwinsz (fd)
15 
+	   (cffi:with-foreign-object (ptr '(:pointer (:struct winsize)))
16 
+	     (let* ((res (osicat-posix:ioctl fd osicat-posix:tiocgwinsz ptr)))
17 
+	       (if (= res 0)
18 
+		   (cffi:with-foreign-slots ((ws_row ws_col) ptr (:struct winsize))
19 
+		     (list ws_row ws_col))
20 
+		   (format t "~&error~%"))))))
21 
+    (loop with err = nil
22 
+       for x from 0 to 2
23 
+       for res = (handler-case (ioctl-gwinsz x)
24 
+		   (osicat-posix:enotty (c) (setf err c)))
25 
+       finally (if err
26 
+		   (error err)
27 
+		   (return res)))))
28 
+
29 
+(eval-when (:compile-toplevel :load-toplevel :execute)
30 
+  (defun symbol-concat (start end)
31 
+    (serapeum:concat
32 
+     (symbol-name start)
33 
+     (symbol-name end))))
34 
+
35 
+(defmacro define-codecs (name () &body mappings)
36 
+  `(progn
37 
+     (defun ,(intern (symbol-concat '#:decode- name)) (,name)
38 
+       (ecase ,name
39 
+	 ,@mappings))
40 
+     (defun ,(intern (symbol-concat '#:encode- name)) (,name)
41 
+       (string-case:string-case ((string-downcase ,name))
42 
+	 ,@(mapcar #'reverse mappings)))))
43 
+
44 
+(cl-ansi-term:update-style-sheet
45 
+ '((:emergency :black :b-red :bold)
46 
+   (:alert :black :b-red)
47 
+   (:critical :red :bold)
48 
+   (:error :red)
49 
+   (:warning :yellow :bold)
50 
+   (:notice :yellow)
51 
+   (:info :green)))
52 
+