structlog-el/structlog-mode.el

260 lines
8.7 KiB
EmacsLisp

;;; structlog-mode.el --- Query structured logs -*- lexical-binding: t; -*-
;; Copyright (C) 2020 Jeremy Dormitzer
;; Author: Jeremy Dormitzer <jdormit@Jeremys-MBP>
;; Version: 0.1.0
;; Package-Requires ((dash "2.17.0")
;; (s "1.12.0")
;; (json-navigator "0.1.1")
;; (tree-mode "1.1.1.1"))
;; Keywords: data
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; structlog-mode provides an interface to query structured logs
;; stored in a database. Right now, it only handles logs stored in the
;; format dictated by the pgjson Fluentd plugin.
;;; Code:
(require 'cl-lib)
(require 's)
(require 'dash)
(require 'json-navigator)
(require 'tree-mode)
(defvar structlog-fields nil
"Currently selected structlog fields")
(defvar structlog-logs nil
"Current structlog log lines, formatted as plists")
(defvar structlog-db-username nil
"PostgreSQL username to use for structlog-mode")
(defvar structlog-db-database nil
"PostgreSQL database to use for structlog-mode")
(defvar structlog-db-password nil
"PostgresSQL password to use for structlog-mode")
(defvar structlog-db-table "fluentd"
"PostgresSQL table to use for structlog-mode")
(defvar structlog-db-record-field "record"
"PostgreSQL column used to store the log line records")
(defvar structlog-psql-path (executable-find "psql")
"Path to the psql executable")
(defvar structlog-current-query nil
"Query for the current structlog display")
(defvar structlog-field-default-width 40
"Default width for log lines")
(defvar structlog-field-widths '((time . 25)
(event . 100))
"Widths for specific fields, overrides
`structlog-field-default-width'")
(defvar structlog-default-query
":select [time event] :limit 100"
"Default query for `structlog' command")
(defvar structlog-time-field 'time
"The structlog field designating the log timestamp")
(defun structlog--query-db (query)
"Runs `query' against the database, returning a list of lists"
(dolist (var '(structlog-db-username
structlog-db-database))
(when (or (not (boundp var))
(not (symbol-value var)))
(error "%s must be set" var)))
(let ((raw (shell-command-to-string
(concat (when structlog-db-password
(format "PGPASSWORD=%s " structlog-db-password))
structlog-psql-path " "
"-U " structlog-db-username " "
"-d " structlog-db-database " "
"-F '<>STRUCTLOG_SEP<>' "
"-t -A -P pager "
"-c " (shell-quote-argument query)))))
(->> raw
(s-lines)
(--filter (not (string-empty-p it)))
(mapcar (apply-partially #'s-split "<>STRUCTLOG_SEP<>")))))
(defun structlog--parse-json (raw)
"Parses the string `raw' as JSON and returns an alist"
(if (fboundp 'json-parse-string)
(json-parse-string raw :object-type 'alist)
(require 'json)
(json-read-from-string raw)))
(defun structlog--serialize-json (alist)
"Serializes the `alist' to a JSON string"
(if (fboundp 'json-serialize)
(json-serialize alist)
(require 'json)
(json-encode alist)))
(defun structlog--get-query-fields (query)
"Returns the fields selected by `query'"
(plist-get query :select))
(defun structlog--get-query-sql (query)
"Returns the SQL query to run for `query'"
(let ((base (format "SELECT %s FROM %s"
structlog-db-record-field
structlog-db-table))
(order-by (format "ORDER BY %s->'%s'"
structlog-db-record-field
structlog-time-field))
(limit (plist-get query :limit)))
(concat base " "
order-by " "
(when limit
(format "LIMIT %s" limit)))))
(defun structlog--make-list-entries ()
"Makes the tabulated-list-mode entries list for structlog"
(let* ((fields (structlog--get-query-fields structlog-current-query))
(sql (structlog--get-query-sql structlog-current-query))
(raw (structlog--query-db sql))
(records (->> raw
(-map #'car)
(-map #'structlog--parse-json))))
(setq structlog-fields fields)
(setq structlog-logs records)
(cl-map 'list
(lambda (log-alist)
(list log-alist
(cl-map 'vector
(lambda (field)
(or (alist-get field log-alist) ""))
structlog-fields)))
structlog-logs)))
(defun structlog--query->str (query)
"Converts `query' to a string representation by unwrapping it"
(->> (prin1-to-string query)
(s-chop-prefix "(")
(s-chop-suffix ")")))
(defun structlog--str->query (str)
"Converts `str' into a query list"
(->> str
(s-prepend "(")
(s-append ")")
(read-from-string)
(car)))
(defun structlog--fields->format ()
(cl-map 'vector
(lambda (field)
(list (symbol-name field)
(or (alist-get field structlog-field-widths)
structlog-field-default-width)
t))
structlog-fields))
(defun structlog--revert (&rest _)
(setq structlog-fields (structlog--get-query-fields
structlog-current-query)
tabulated-list-format (structlog--fields->format))
(tabulated-list-revert)
(tabulated-list-init-header))
(defun structlog-query (query)
"Runs `query' and re-renders the table"
(interactive "sQuery: ")
(setq structlog-current-query (structlog--str->query query))
(structlog--revert))
(defun structlog-edit-query ()
(interactive)
(let* ((query-str (structlog--query->str structlog-current-query))
(new-query (read-string "Query: " query-str)))
(structlog-query new-query)))
(defun structlog-view-log-at-point ()
"Opens the log at point in a json-navigator buffer"
(interactive)
(let* ((log (tabulated-list-get-id))
(json (structlog--serialize-json log)))
(json-navigator-display-tree
(json-navigator--read-string json))
(tree-minor-mode)))
(defvar structlog-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map tabulated-list-mode-map)
(define-key map "m" #'structlog-query)
(define-key map "M" #'structlog-edit-query)
(define-key map (kbd "RET") #'structlog-view-log-at-point)
map)
"Local keymap for `structlog-mode' buffers")
(when (fboundp 'evil-define-key)
(evil-define-key 'normal structlog-mode-map
"m" #'structlog-query
"M" #'structlog-edit-query
(kbd "RET") #'structlog-view-log-at-point
"S" #'tabulated-list-sort
"{" #'tabulated-list-narrow-current-column
"}" #'tabulated-list-widen-current-column)
(evil-define-key 'normal tree-mode-map
"D" #'tree-mode-delete-tree
"k" #'tree-mode-previous-node
"j" #'tree-mode-next-node
"l" #'tree-mode-next-sib
"h" #'tree-mode-previous-sib
"u" #'tree-mode-goto-parent
"r" #'tree-mode-goto-root
"gr" #'tree-mode-reflesh
"E" #'tree-mode-expand-level
"e" #'tree-mode-toggle-expand
"s" #'tree-mode-sort-by-tag
"/" #'tree-mode-keep-match
"!" #'tree-mode-collapse-other-except))
(define-derived-mode structlog-mode tabulated-list-mode "structlog"
"Major mode to query structured log lines"
(setq tabulated-list-format (structlog--fields->format)
tabulated-list-entries #'structlog--make-list-entries)
(setq-local revert-buffer-function #'structlog--revert)
(tabulated-list-init-header))
;;;###autoload
(defun structlog ()
(interactive)
(when (get-buffer "*structlog*")
(kill-buffer "*structlog*"))
(with-current-buffer (get-buffer-create "*structlog*")
(setq structlog-current-query (structlog--str->query
(read-string "Query: "
structlog-default-query))
structlog-fields (structlog--get-query-fields
structlog-current-query))
(structlog-mode)
(tabulated-list-print))
(switch-to-buffer "*structlog*"))
(provide 'structlog-mode)
;;; structlog-mode.el ends here