+;;; snitch-timer.el -*- lexical-binding: t; -*-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; See snitch.el for full details.
+;;
+;; Copyright (C) 2020 Trevor Bentley
+;; Author: Trevor Bentley <snitch.el@x.mrmekon.com>
+;; URL: https://github.com/mrmekon/snitch-el
+;;
+;; This file is not part of GNU Emacs.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This file hooks emacs timers to save backtrace information. It is
+;; used by the snitch-backtrace functions to reproduce full backtraces
+;; for functions initiated by timers. This is required to provide a
+;; more accurate guess as to which function/package originated a call
+;; intercepted by snitch, since functions started by timers lose their
+;; original backtrace.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; 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 2, 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; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(defvar snitch--timer-alist '()
+ "Cache all timers registered with emacs, along with their
+backtrace and a timeout. Stored as a list of (TIMER . METADATA)
+cons cell entries, where each METADATA item is a (BACKTRACE
+. TIMEOUT) cons cell. TIMER is a standard emacs timer object,
+BACKTRACE is a snitch backtrace, and TIMEOUT is a standard emacs
+time object.")
+
+(defvar snitch--timer-removal-queue '()
+ "List of timers to be removed from snitch’s backtrace tracking
+when the timer call stack is empty. Timers are queued to be
+removed instead of removed immediately because of the (likely)
+possibility of recursive removals. If the timer is removed deep
+in a recursive stack, the outer calls are unable to decorate the
+backtraces as the stack unwinds because the timer is already
+gone.")
+
+(defvar snitch--timer-count 0
+ "Total number of timers snitch has saved (timers registered
+with emacs and intercepted by snitch).")
+
+(defvar snitch--timer-removed-count 0
+ "Total number of timers snitch has removed (timers fired or
+cancelled that snitch knew about).")
+
+(defvar snitch--timer-missed-count 0
+ "Total number of timers snitch has missed. This is timers that
+are removed (cancelled or triggered) while not currently tracked
+in snitch--timer-alist. This can happen naturally if snitch is
+started when timers already exist, but could also indicate bugs
+causing snitch to lose track of timers.")
+
+(defvar snitch--wrap-timer-depth 0
+ "Tracks current recursive depth of calls to remove timers.
+Timer handlers often attempt to manually remove themselves,
+resulting in several calls to remove the same timer.")
+
+(defvar snitch--max-timer-backtraces 1000
+ "Maximum number of timer backtraces that snitch should keep
+track of. If more timers than this are started without ending,
+new timers are ignored.")
+
+(defvar snitch--save-unique-timer-fns nil
+ "While t, snitch saves a list of the unique functions
+registered as timers, along with a count of how many times they
+were seen. This allows tracking which high-frequency timers are
+common in your emacs, so they can be added to the timer
+blacklist.")
+
+(defvar snitch--unique-timer-fns '()
+ "A list of unique timer functions encountered, and how many
+times they were seen during the period that
+snitch--save-unique-timer-fns was t.")
+
+(defun snitch-monitor-unique-timer-fns (&optional time no-reset)
+ "Keeps a running count of each unique timer function that
+arrives during time period TIME. After TIME has elapsed, prints
+all timers seen along with the number of times each was seen
+during the monitoring time period.
+
+Each call to this function resets the seen timer list to empty.
+To continue capturing without clearing the list, set NO-RESET to
+t."
+ (interactive)
+ (unless time (setq time 60))
+ (unless no-reset
+ (setq snitch--unique-timer-fns '()))
+ (setq snitch--save-unique-timer-fns t)
+ (run-with-timer
+ time nil
+ (lambda ()
+ (setq snitch--save-unique-timer-fns nil)
+ (message "*** SNITCH -- UNIQUE TIMERS DETECTED IN %d s ***" time)
+ (cl-loop for (timer . count) in snitch--unique-timer-fns
+ do (message "%s: %d" timer count)))))
+
+(defun snitch--timer-test-idle-timeout (time)
+ "Return t if an idle timer has timed out (current idle time
+greater than TIME)."
+ (let ((idle (current-idle-time)))
+ (when idle
+ (time-less-p time idle))))
+
+(defun snitch--timer-test-timeout (time)
+ "Return t if a regular timer has timed out (current absolute time greater than TIME)."
+ (time-less-p time (current-time)))
+
+(defun snitch--timer-timeout (timer)
+ "Calculate a timeout for a timer, a few minutes longer than it
+is originally scheduled to fire."
+ (time-add (timer--time timer) (time-convert (* 60 5))))
+
+(defun snitch--fn-repr (fn)
+ "Encode FN in a semi-human-readable form if it is a compiled
+function."
+ (cond
+ ((byte-code-function-p fn)
+ ;; sxhash would be a nice alternative, but it isn't guaranteed
+ ;; to be consistent across sessions.
+ ;;
+ ;; (base64-encode-string (gnutls-hash-digest "SHA1" (aref fn 1)))
+ ;; (sxhash (aref fn 1))
+ (secure-hash 'sha1 (aref fn 1)))
+ ((and (listp fn)
+ (or (eq (car fn) 'lambda)
+ (eq (car fn) 'closure)))
+ (secure-hash 'sha1 (prin1-to-string fn)))
+ (t fn)))
+
+(defun snitch--save-timer-function (fn)
+ "Save timer function FN in SNITCH--UNIQUE-TIMER-FNS if it does
+not already exist, otherwise increment its counter. Byte
+compiled functions are stored as a hash, since their names are
+unknown."
+ (let* ((fn-rep (snitch--fn-repr fn))
+ (entry (assoc fn-rep snitch--unique-timer-fns)))
+ (if entry
+ (setcdr entry (+ (cdr entry) 1))
+ (setq snitch--unique-timer-fns
+ (cons (cons fn-rep 1) snitch--unique-timer-fns)))))
+
+(defun snitch--save-timer-backtrace (orig-fn &rest args)
+ "Cache a timer and its associated backtrace. This function is
+hooked around all functions that register new timers with emacs.
+It saves the backtrace and a timeout period for when snitch
+should stop listening for it in case the timer is somehow lost.
+It calls the original emacs timer registration function without
+modification and returns the result."
+ (let* ((bt (snitch--backtrace))
+ ;;(bt '()) ;;(snitch--backtrace))
+ (timer (nth 0 args))
+ (idle (nth 3 args))
+ (expire-time (snitch--timer-timeout timer))
+ (timeout-fn
+ (if idle
+ (lambda () (snitch--timer-test-idle-timeout expire-time))
+ (lambda () (snitch--timer-test-timeout expire-time))))
+ (result (apply orig-fn args)))
+ (when snitch--save-unique-timer-fns
+ (snitch--save-timer-function (timer--function timer)))
+ (if (>= (length snitch--timer-alist) snitch--max-timer-backtraces)
+ (when snitch-print-timer-warnings
+ (message "*snitch warning* too many timers, discarding: %s"
+ (timer--function timer)))
+ (progn
+ (setq snitch--timer-alist
+ (cons (cons timer (cons bt timeout-fn)) snitch--timer-alist))
+ (setq snitch--timer-count (+ snitch--timer-count 1))))
+ result))
+
+(defun snitch--remove-timed-out-timers ()
+ "Iterate of all of snitch's saved timer backtraces and remove
+any that have timed out."
+ (cl-loop for (timer . (bt . timeout-fn)) in snitch--timer-alist
+ when (funcall timeout-fn)
+ do
+ (let ((match (assq timer snitch--timer-alist)))
+ (when match
+ (when snitch-print-timer-warnings
+ (message "*snitch warning* timer timed out: %s"
+ (timer--function timer)))
+ (setq snitch--timer-removed-count
+ (+ snitch--timer-removed-count 1))
+ (setq snitch--timer-alist
+ (delq match snitch--timer-alist))))))
+
+(defun snitch--remove-timers (timers)
+ "Remove all timers in TIMERS from the timer backtrace cache, if
+present."
+ (setq total-timers (length timers))
+ (setq removed-timers 0)
+ (cl-loop
+ for timer in timers
+ do (let ((match (assq timer snitch--timer-alist)))
+ (when (and (null match)
+ snitch-print-timer-warnings)
+ (message "*snitch warning* remove unknown timer: %s"
+ (timer--function timer))
+ (setq snitch--timer-missed-count
+ (+ snitch--timer-missed-count 1)))
+ (when match
+ (setq snitch--timer-removed-count
+ (+ snitch--timer-removed-count 1))
+ (setq removed-timers (1+ removed-timers))
+ (setq snitch--timer-alist
+ (delq match snitch--timer-alist)))))
+ ;;(message "removed %d of %d timers" removed-timers total-timers)
+ (list removed-timers total-timers))
+
+(defun snitch--remove-timer-backtrace (orig-fn timer)
+ "Remove a timer from snitch’s cache. This function is wrapped
+around ‘timer-event-handler’ and ‘cancel-timer’, triggering
+whenever a timer either fires or is explicitly cancelled. It
+removes snitch’s decorated copy and calls the originally
+requested function as normal."
+ (setq snitch--wrap-timer-depth (+ snitch--wrap-timer-depth 1))
+ (let* ((result (apply orig-fn (list timer))))
+ ;; TODO: this is probably wrong. What if one timer removed a
+ ;; different timer? That would also be at a lower depth.
+ ;; Disabled depth test for now, but that triggers the ’unknown
+ ;; timer’ warning all the time, so that is also disabled.
+ ;;
+ ;; TODO: reverted back to only removing at top, but need to fix
+ ;; this. When recursive removals are allowed, it gets removed
+ ;; from the alist during a deeper cancel-timer call before the
+ ;; outer logic finishes running and actually triggers the snitch
+ ;; path that needs the backtrace. We should queue up removals in
+ ;; a list and remove them all at once when wrap-depth falls to 0.
+ (add-to-list 'snitch--timer-removal-queue timer)
+ (setq snitch--wrap-timer-depth
+ (- snitch--wrap-timer-depth 1))
+ ;; as we exit the last removal attempt in the potentially
+ ;; recursive stack, actually remove the timers from snitch’s cache
+ ;; and check for any timed out ones
+ (when (eq snitch--wrap-timer-depth 0)
+ (snitch--remove-timers snitch--timer-removal-queue)
+ (setq snitch--timer-removal-queue '())
+ (snitch--remove-timed-out-timers))
+ result))
+
+(defun snitch--get-timer-backtrace (timer)
+ "Return backtrace for TIMER if it is currently known."
+ (let ((match (assq timer snitch--timer-alist)))
+ (when match
+ (car (cdr match)))))
+
+(defun snitch--remove-timer-hooks ()
+ "Remove snitch’s timer hooks, disabling timer backtraces."
+ (remove-function (symbol-function 'timer--activate)
+ #'snitch--save-timer-backtrace)
+ (remove-function (symbol-function 'timer-event-handler)
+ #'snitch--remove-timer-backtrace)
+ (remove-function (symbol-function 'cancel-timer)
+ #'snitch--remove-timer-backtrace)
+ (remove-function (symbol-function 'cancel-timer-internal)
+ #'snitch--remove-timer-backtrace))
+
+(defun snitch--register-timer-hooks ()
+ "Add timer hooks so snitch can provide backtraces all the way
+to the source of whichever function registered the timer."
+ (setq snitch--timer-alist '()
+ snitch--timer-removal-queue '()
+ snitch--wrap-timer-depth 0
+ snitch--timer-count 0
+ snitch--timer-removed-count 0
+ snitch--timer-missed-count 0
+ snitch--unique-timer-fns '())
+ (add-function :around (symbol-function 'timer--activate)
+ #'snitch--save-timer-backtrace)
+ (add-function :around (symbol-function 'timer-event-handler)
+ #'snitch--remove-timer-backtrace)
+ (add-function :around (symbol-function 'cancel-timer)
+ #'snitch--remove-timer-backtrace)
+ (add-function :around (symbol-function 'cancel-timer-internal)
+ #'snitch--remove-timer-backtrace))
+
+(defun snitch--debug-print-timer-state (&optional alist)
+ "Print current state of snitch’s timer tracing to the messages
+log. If ALIST is t, also prints the currently cached timers."
+ (interactive)
+ (message "%s" (current-time-string))
+ (message "timer active: %d" (length snitch--timer-alist))
+ (message "timer saved: %d" snitch--timer-count)
+ (message "timer removed: %d" snitch--timer-removed-count)
+ (message "timer missed: %d" snitch--timer-missed-count)
+ (when alist
+ (message "timer alist: %s" snitch--timer-alist)
+ (cl-loop for (timer . (bt . timeout-fn)) in snitch--timer-alist
+ do (message "timeout? %s" (funcall timeout-fn)))))
+
+(defun snitch--activate-timer-trace ()
+ "Activate snitch timer tracing by hooking the appropriate
+functions."
+ (interactive)
+ (snitch--register-timer-hooks))
+
+(defun snitch--deactivate-timer-trace ()
+ "Deactivate snitch timer tracing."
+ (interactive)
+ (snitch--remove-timer-hooks))
+
+(defun snitch--debug-test-print-timers ()
+ "Print snitch’s cached timers, and all of emacs’ currently
+registered timers."
+ (cl-loop for (timer . meta) in snitch--timer-alist
+ do
+ (message "timer fn: %s" (timer--function timer)))
+ (cl-loop for timer in timer-list
+ do
+ (message "timer fn: %s" (timer--function timer)))
+ (cl-loop for timer in timer-idle-list
+ do
+ (message "timer fn: %s" (timer--function timer))))
+
+
+(provide 'snitch-timer)
+
+;;; snitch-timer.el ends here
;; should be added earlier in the lists.
;;
;;
+;; === TIMER TRACING ===
+;;
+;; Since snitch’s usefulness is highly dependent on the ability to
+;; trace back to the original source that triggered an event, emacs
+;; timers pose a bit of a challenge. Timers are used to trigger
+;; network requests asynchronously, but have the side effect of losing
+;; the stack trace back to the function or package that initiated it.
+;;
+;; To deal with this, snitch optionally supports timer tracing. When
+;; tracing is enabled, by customizing ‘snitch-trace-timers’ to t,
+;; snitch hooks into emacs’s timer functions, and records backtraces
+;; whenever a timer is registered. If a timer later generates a
+;; snitch-relevant event, snitch concatenates the regular backtrace
+;; with the cached timer backtrace to get a full call stack for the
+;; event.
+;;
+;; As an example, here are two snitch log entries when opening RSS
+;; feeds with the elfeed package, which uses timers for web requests:
+;;
+;; With ‘snitch-trace-timers’ set to nil (tracing disabled):
+;;
+;; [2020-12-07 21:32:56] (allowed) -- #s(snitch-network-entry \
+;; 1607373176.6757963 \
+;; timer-event-handler \
+;; /usr/share/emacs/27.1/lisp/emacs-lisp/timer.el \
+;; site-lisp \
+;; www.smbc-comics.com www.smbc-comics.com 443 nil)
+;;
+;; Notice how the source is the function ‘timer-event-handler’ in
+;; ‘timer.el’, part of the special ‘site-lisp’ package? *All*
+;; timer-originated network calls appear to originate from that
+;; function, since it is the lowest level emacs timer dispatch
+;; function. It is impossible to filter on the true source.
+;;
+;; Now with ‘snitch-trace-timers’ set to t (tracing enabled):
+;;
+;; [2020-12-07 21:33:06] (allowed) -- #s(snitch-network-entry \
+;; 1607373186.6863618 \
+;; elfeed-insert-html
+;; /home/trevor/.emacs.d/elpa/elfeed-20200910.239/elfeed-show.el \
+;; elfeed \
+;; www.smbc-comics.com www.smbc-comics.com 443 nil)
+;;
+;; For this event, snitch has successfully traced through the timer to
+;; find the true source, ‘elfeed-insert-html’ in the ‘elfeed’ package!
+;;
+;; Timer tracing comes with a cost: snitch has to generate metadata
+;; for every single timer event. If your emacs usage involves a very
+;; large number of timers, or very high-frequency timers, snitch’s
+;; tracing could lead to delays and inflated memory usage. Consider
+;; carefully whether this is a feature you need, and leave it disabled
+;; if you will not use it, or if you experience any performance issues
+;; while running snitch.
+;;
+;; You can run ‘snitch-monitor-unique-timer-fns’ to get a sense of
+;; which timers are currently active. After running that function,
+;; there will be a 60 second delay, followed by printing the names of
+;; all timers that were active during the minute and the number of
+;; times they fired.
+;;
+;; Similarly, if you run with timer tracing enabled for a while, you
+;; can use ‘snitch--debug-print-timer-state’ to print a summary of how
+;; many timers snitch has intercepted, and how many saved backtraces
+;; are currently active in memory.
+;;
+;;
;; === SECURITY ===
;;
;; snitch provides, effectively, zero security.
;; - interactive prompts?
;; - handle service strings as port numbers
;; - ensure the inverted negation rules make sense
-;; - automated test suite
-;; - publish on gitwhatever
+;; - add blacklist for timer functions
;; - publish on MELPA?
;; - profit!
;;
(require 'eieio) ; class objects
(require 'cl-macs) ; cl loops
(require 'package) ; backtrace package sources
+(require 'backtrace)
(require 'snitch-backtrace)
(require 'snitch-custom)
(require 'snitch-filter)
+(require 'snitch-timer)
(require 'snitch-log)
;;
"Wrap a call to make-process in the snitch firewall decision
engine. ORIG-FUN is called only if the snitch firewall rules
permit it."
- (let* ((bt (snitch--backtrace))
+ (let* ((bt (snitch--backtrace t))
(caller (snitch--responsible-caller bt))
(event (snitch-process-entry
:timestamp (time-to-seconds (current-time))
"Wrap a call to make-network-process in the snitch firewall
decision engine. ORIG-FUN is called only if the snitch firewall
rules permit it."
- (let* ((bt (snitch--backtrace))
+ (let* ((bt (snitch--backtrace t))
(caller (snitch--responsible-caller bt))
(event (snitch-network-entry
:timestamp (time-to-seconds (current-time))
(defun snitch-init ()
"Initialize snitch.el firewall, enabling globally."
(interactive)
+ (when snitch-trace-timers (snitch--activate-timer-trace))
(when (snitch--register-wrapper-fns) t))
(defun snitch-deinit ()
"Unload snitch.el firewall, disabling globally."
(interactive)
+ (snitch--deactivate-timer-trace)
(snitch--stop-log-prune-timer)
(unload-feature 'snitch t)
(when (require 'snitch) t))