# HG changeset patch # User Steve Losh # Date 1651710817 14400 # Node ID f37e47cda7c4e31707ee8dcb0bdd846cec840de1 # Parent b459210557b96a3d70c054fc4d81dc02b13bdb2a More diff -r b459210557b9 -r f37e47cda7c4 Xmodmap --- a/Xmodmap Tue Apr 05 10:54:24 2022 -0400 +++ b/Xmodmap Wed May 04 20:33:37 2022 -0400 @@ -13,6 +13,7 @@ keycode 47 = minus colon keycode 20 = semicolon underscore keycode 108 = Mode_switch +keycode 192 = Multi_key keycode 900 = F16 ! for some reason this fucks up keycode 133. I have no idea why this happens. diff -r b459210557b9 -r f37e47cda7c4 bin/unix-timestamp-seconds --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/bin/unix-timestamp-seconds Wed May 04 20:33:37 2022 -0400 @@ -0,0 +1,3 @@ +#!/usr/bin/env bash + +date '+%s' diff -r b459210557b9 -r f37e47cda7c4 gitconfig --- a/gitconfig Tue Apr 05 10:54:24 2022 -0400 +++ b/gitconfig Wed May 04 20:33:37 2022 -0400 @@ -16,6 +16,8 @@ make-the-fucking-branch-point-at-the-fucking-commit = "!sh -c 'git checkout $1 && git reset --hard $2' -" mtfbpatfc = "!sh -c 'git checkout $1 && git reset --hard $2' -" + repoint = "!sh -c 'git update-ref HEAD $1 && git reset' -" + root = rev-parse --show-toplevel l = log -18 --color=always --all --topo-order --pretty='format:%Cgreen%h%Creset %s%Cred%d%Creset %C(black bold)(by %an)%Creset' diff -r b459210557b9 -r f37e47cda7c4 gnuplot --- a/gnuplot Tue Apr 05 10:54:24 2022 -0400 +++ b/gnuplot Wed May 04 20:33:37 2022 -0400 @@ -23,8 +23,8 @@ tau = 2 * pi e = 2.71828182845905 r2 = sqrt(2.0) -rfc3339 = "%Y-%m-%d %H:%M:%S." -iso8601 = "%Y-%m-%dT%H:%M:%S." +rfc3339 = "%Y-%m-%dT%H:%M:%S" +iso8601 = "%Y-%m-%dT%H:%M:%S" # }}} # Utility Functions ------------------------------------------------------- {{{ @@ -53,6 +53,7 @@ # }}} # Convenience Wrappers ---------------------------------------------------- {{{ +# usage: @xrfc3339 csvinput = 'set datafile separator ","' xrfc3339 = "set xdata time; set timefmt rfc3339" @@ -88,7 +89,7 @@ set boxwidth histogram_bin_width*0.9 set style fill solid 0.5 -plot 'sizes' using (histogram_bin($1,histogram_bin_width)):(1.0) smooth freq with boxes +# plot 'sizes' using (histogram_bin($1,histogram_bin_width)):(1.0) smooth freq with boxes # }}} # Other ------------------------------------------------------------------- {{{ diff -r b459210557b9 -r f37e47cda7c4 lisp/bucket.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/bucket.lisp Wed May 04 20:33:37 2022 -0400 @@ -0,0 +1,247 @@ +(eval-when (:compile-toplevel :load-toplevel :execute) + (ql:quickload '(:adopt :alexandria :cl-ppcre :with-user-abort :local-time) + :silent t)) + +(defpackage :bucket + (:use :cl) + (:export :toplevel :*ui*)) + +(in-package :bucket) + +;;;; Configuration ------------------------------------------------------------ +(setf local-time:*default-timezone* local-time:+utc-zone+) + + +;;;; Functionality ------------------------------------------------------------ +(defun collect-values (time-mode path) + (flet ((collect (stream) + (loop :for line = (read-line stream nil nil) + :while line + :for value = (if time-mode + (local-time:parse-rfc3339-timestring line) + (parse-integer line :junk-allowed t)) + :when value :collect value))) + (if (string= path "-") + (collect *standard-input*) + (with-open-file (s path) + (collect s))))) + + +(defun floor-to-nearest (n divisor) + (* divisor (floor n divisor))) + +(declaim (inline in-range-p in-time-p)) +(defun in-range-p (val start end) + (and (<= start val) + (< val end))) + +(defun in-time-p (val start end) + (and (local-time:timestamp<= start val) + (local-time:timestamp< val end))) + +(defun bucket-numeric (data width skip-empty output) + (loop :with data = (sort (coerce data 'vector) #'<) + :with len = (length data) + :with i = 0 + :for bs :from (floor-to-nearest (aref data 0) width) :by width + :for be = (+ bs width) + :while (< i len) + :for count = (loop :while (< i len) + :while (in-range-p (aref data i) bs be) + :sum 1 + :do (incf i)) + :do (unless (and skip-empty (zerop count)) + (format t "~12F ~10D~%" + (ecase output + (:lower bs) + (:upper be) + (:mid (/ (+ bs bs width) 2.0d0))) + count)))) + +(defun bucket-temporal (data width skip-empty output) + (loop :with data = (sort (coerce data 'vector) #'local-time:timestamp<) + :with len = (length data) + :with i = 0 + :with bs = (local-time:timestamp-minimize-part (aref data 0) :sec) + :for be = (local-time:timestamp+ bs width :sec) + :while (< i len) + :for count = (loop :while (< i len) + :while (in-time-p (aref data i) bs be) + :sum 1 + :do (incf i)) + :do (unless (and skip-empty (zerop count)) + (format t "~A ~10D~%" + (local-time:format-rfc3339-timestring + nil + (ecase output + (:lower bs) + (:upper be) + (:mid (local-time:timestamp+ bs (truncate (* width 1000000000) 2) :nsec)))) ; hack + count)) + :do (setf bs (local-time:timestamp+ bs width :sec)))) + +(defun run (paths &key time-mode width skip-empty (output :mid)) + (when (null width) + (error "Bucket width must be specified.")) + (let ((data (mapcan (alexandria:curry #'collect-values time-mode) + (or paths '("-"))))) + (when (null data) + (error "No data found.")) + (if time-mode + (bucket-temporal data width skip-empty output) + (bucket-numeric data width skip-empty output)))) + + +;;;; User Interface ----------------------------------------------------------- +(defparameter *option/help* + (adopt:make-option 'help + :help "Display help and exit." + :long "help" + :short #\h + :reduce (constantly t))) + +(adopt:defparameters (*option/time* *option/no-time*) + (adopt:make-boolean-options 'time + :help "Bucket in timestamp (RFC3339) mode." + :help-no "Bucket in numeric mode (the default)." + :long "time" + :short #\t)) + +(adopt:defparameters (*option/skip-empty* *option/no-skip-empty*) + (adopt:make-boolean-options 'skip-empty + :help "Skip outputting empty buckets." + :help-no "Include empty buckets (the default)." + :long "skip-empty" + :short #\e)) + + +(defparameter *option/output/lower* + (adopt:make-option 'output/lower + :result-key 'output + :help "Output the lower bound of the bucket." + :long "lower" + :short #\l + :reduce (constantly :lower))) + +(defparameter *option/output/mid* + (adopt:make-option 'output/mid + :result-key 'output + :help "Output the midpoint of the bucket (the default)." + :long "mid" + :short #\m + :initial-value :mid + :reduce (constantly :mid))) + +(defparameter *option/output/upper* + (adopt:make-option 'output/upper + :result-key 'output + :help "Output the upper bound of the bucket." + :long "upper" + :short #\u + :reduce (constantly :upper))) + + +(defparameter *option/width* + (adopt:make-option 'width + :result-key 'width + :help "Set bucket width to N." + :parameter "N" + :long "width" + :short #\W + :initial-value nil + :key #'parse-integer + :reduce #'adopt:last)) + +(defparameter *option/width/seconds* + (adopt:make-option 'width/seconds + :result-key 'width + :help "Set bucket width to N seconds." + :parameter "N" + :long "seconds" + :short #\S + :key (lambda (n) + (parse-integer n)) + :reduce #'adopt:last)) + +(defparameter *option/width/minutes* + (adopt:make-option 'width/minutes + :result-key 'width + :help "Set bucket width to N minutes." + :parameter "N" + :long "minutes" + :short #\M + :key (lambda (n) + (* 60 (parse-integer n))) + :reduce #'adopt:last)) + +(defparameter *option/width/hours* + (adopt:make-option 'width/hours + :result-key 'width + :help "Set bucket width to N hours." + :parameter "N" + :long "hours" + :short #\H + :key (lambda (n) + (* 60 60 (parse-integer n))) + :reduce #'adopt:last)) + + +(adopt:define-string *help-text* + "bucket groups lines into histogrammy buckets.~@ + ~@ + This is handy if you have some non-bucketed data that you want to graph as ~ + a histogram with gnuplot, because gnuplot unbelievably does not have built-in ~ + histogramming.") + +(defparameter *examples* + '()) + + +(defparameter *ui* + (adopt:make-interface + :name "bucket" + :usage "[OPTIONS] [FILE...]" + :summary "bucket things for easier histogramming" + :help *help-text* + :examples *examples* + :contents (list *option/help* + *option/time* + *option/no-time* + *option/skip-empty* + *option/no-skip-empty* + (adopt:make-group 'bucket-width + :title "Bucket Widths" + :options (list + *option/width* + *option/width/seconds* + *option/width/minutes* + *option/width/hours*)) + (adopt:make-group 'bucket-labels + :title "Bucket Labels" + :options (list + *option/output/lower* + *option/output/mid* + *option/output/upper*))))) + + +(defun toplevel () + ;; #+sbcl (sb-ext:disable-debugger) + (handler-case + (adopt::quit-on-ctrl-c () + (multiple-value-bind (arguments options) (adopt:parse-options-or-exit *ui*) + (cond + ((gethash 'help options) (adopt:print-help-and-exit *ui*)) + (t (progn (local-time:reread-timezone-repository) + (run arguments + :time-mode (gethash 'time options) + :width (gethash 'width options) + :skip-empty (gethash 'skip-empty options) + :output (gethash 'output options))))))) + (error (c) (adopt:print-error-and-exit c)))) + + +#; Scratch -------------------------------------------------------------------- + + +(ppcre:scan "(\\d{4})-(\\d{2})-(\\d{2})[ T](\\d{2}):(\\d{2}):(\\d{2})(?:\\.\\d+)?([+-]\\d{2}:\\d{2}|Z)?" + "2022-04-25T17:00:41.289049Z") diff -r b459210557b9 -r f37e47cda7c4 lisp/gtp.lisp --- a/lisp/gtp.lisp Tue Apr 05 10:54:24 2022 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,351 +0,0 @@ -(eval-when (:compile-toplevel :load-toplevel :execute) - (ql:quickload '(:adopt :alexandria :cl-ppcre :with-user-abort :local-time) - :silent t)) - -(defpackage :gtp - (:use :cl) - (:export :toplevel :*ui*)) - -(in-package :gtp) - -;;;; Configuration ------------------------------------------------------------ -(defparameter *version* "1.0.0") -(setf local-time:*default-timezone* local-time:+utc-zone+) - -(defparameter *time-formats* - `((:rfc-3339 . ("(\\d{4})-(\\d{2})-(\\d{2})[ T](\\d{2}):(\\d{2}):(\\d{2})(?:[.]\\d{4-})?([+-]\\d{2}:\\d{2}|Z)?" - ,local-time:+rfc3339-format+)) - (:iso-8601 . ("(\\d{4})-(\\d{2})-(\\d{2})T(\\d{2}):(\\d{2}):(\\d{2})(?:,\\d{4-})?([+-]\\d{2}:\\d{2}|Z)?" - ,local-time:+iso-8601-format+)) - (:simple . ("(\\d{4})/(\\d{2})/(\\d{2}) (\\d{2}):(\\d{2}):(\\d{2})()" - ((:year 4) #\/ (:month 2) #\/ (:day 2) #\space (:hour 2) #\: (:min 2) #\: (:sec 2)))) - (:gnuplot . ("(\\d{2})/(\\d{2})/(\\d{2}),(\\d{2}):(\\d{2})" - ((:day 2) #\/ (:month 2) #\/ #\Y #\, (:hour 2) #\: (:min 2)))) - (:unix-milliseconds . ("(\\d{13,14})" nil)) - (:unix-seconds . ("(\\d{10,11})" nil)))) - - -;;;; Utilities ---------------------------------------------------------------- -(defmacro match ((register-vars (start end) (regex target)) &body body) - (alexandria:with-gensyms (rs re) - (alexandria:once-only (regex target) - `(multiple-value-bind (,start ,end ,rs ,re) (ppcre:scan ,regex ,target) - (when ,start - (let (,@(loop :for r :from 0 - :for var :in register-vars - :collect `(,var (when (aref ,rs ,r) - (subseq ,target (aref ,rs ,r) (aref ,re ,r)))))) - ,@body)))))) - -(defun i (s) - (parse-integer s)) - -(defun keywordize (s) - (alexandria:make-keyword (string-upcase s))) - - -;;;; Time Formats ------------------------------------------------------------- - -(defun get-format (format) - (or (alexandria:assoc-value *time-formats* format) - (error "Unknown time format ~S" format))) - -(defun get-regex (format) - (first (get-format format))) - -(defun get-local-time-format (format) - (second (get-format format))) - -(defun parse-timezone (string) - (if (member string '(nil "" "Z" "UTC" "+00:00" "-00:00") :test #'equal) - local-time:+utc-zone+ - (or (local-time:find-timezone-by-location-name string) - (error "TODO: handle timezone ~S" string)))) - - -(defgeneric make-parser (format)) - -(defmethod make-parser (format) - (let ((scanner (ppcre:create-scanner (get-regex format)))) - (lambda (s) - (match ((year month day hour minute second timezone) - (start end) - (scanner s)) - (values - (local-time:encode-timestamp - 0 (i second) (i minute) (i hour) (i day) (i month) (i year) - :timezone (parse-timezone timezone)) - start end))))) - -(defmethod make-parser ((format (eql :gnuplot))) - (let ((scanner (ppcre:create-scanner (get-regex format)))) - (lambda (s) - (match ((day month year hour minute) - (start end) - (scanner s)) - (values (local-time:encode-timestamp - 0 0 (i minute) (i hour) (i day) (i month) (+ 2000 (i year))) - start end))))) - -(defmethod make-parser ((format (eql :unix-seconds))) - (let ((scanner (ppcre:create-scanner (get-regex format)))) - (lambda (s) - (match ((unix) - (start end) - (scanner s)) - (when unix ; shut up sbcl - (values (local-time:unix-to-timestamp (parse-integer unix)) start end)))))) - -(defmethod make-parser ((format (eql :unix-milliseconds))) - (let ((scanner (ppcre:create-scanner (get-regex format)))) - (lambda (s) - (match ((unix) - (start end) - (scanner s)) - (when unix ; shut up sbcl - (multiple-value-bind (sec ms) (truncate (parse-integer unix) 1000) - (values (local-time:unix-to-timestamp sec :nsec (* ms 1000 1000)) - start end))))))) - - -(defun make-predicate (format start end) - (let ((parser (make-parser format))) - (lambda (line) - (multiple-value-bind (line-time s e) (funcall parser line) - (when (and line-time - (or (null start) (local-time:timestamp<= start line-time)) - (or (null end) (local-time:timestamp<= line-time end))) - (values line-time s e)))))) - - -(defgeneric make-formatter (format)) - -(defmethod make-formatter (format) - (let ((local-time-format (get-local-time-format format))) - (lambda (time stream) - (local-time:format-timestring stream time :format local-time-format)))) - -(defmethod make-formatter ((format (eql :gnuplot))) - (let ((local-time-format (get-local-time-format :gnuplot))) - (lambda (time stream) - (let ((s (local-time:format-timestring nil time :format local-time-format))) - ;; "16/07/Y,15:05" - (write-string s stream :start 0 :end 6) - (format stream "~2,'0D" (mod (local-time:timestamp-year time) 100)) - (write-string s stream :start 7))))) - -(defmethod make-formatter ((format (eql :unix-seconds))) - (lambda (time stream) - (format stream "~D" (local-time:timestamp-to-unix time)))) - -(defmethod make-formatter ((format (eql :unix-milliseconds))) - (lambda (time stream) - (format stream "~D" (+ (* 1000 (local-time:timestamp-to-unix time)) - (local-time:timestamp-millisecond time))))) - - -(defun parse-time-flexibly (string) - ;; todo optimize this - (loop :for format :in *time-formats* - :for parser = (make-parser (car format)) - :for result = (funcall parser string) - :when result :do (return-from parse-time-flexibly result)) - (error "Don't know how to parse ~S as a time." string)) - - -;;;; Run ---------------------------------------------------------------------- -(defun run% (predicate in out path prefix reformat) - (loop - :for line = (read-line in nil) - :while line - :do (multiple-value-bind (time start end) (funcall predicate line) - (when time - (when prefix - (write-string path out) - (write-char #\: out)) - (if reformat - (progn (write-string line out :start 0 :end start) - (funcall reformat time out) - (write-line line out :start end)) - (write-line line out)))))) - -(defun run (paths &key format start end prefix reformat) - (when (null paths) - (setf paths '("-"))) - (when (and start end (local-time:timestamp< end start)) - (error "Start ~S is after end ~S." start end)) - (when reformat - (setf reformat (make-formatter reformat))) - (let ((pred (make-predicate format start end))) - (dolist (path paths) - (if (string= "-" path) - (run% pred *standard-input* *standard-output* path prefix reformat) - (with-open-file (stream path :direction :input) - (run% pred stream *standard-output* path prefix reformat)))))) - - -;;;; User Interface ----------------------------------------------------------- -(defparameter *option-help* - (adopt:make-option 'help - :help "Display help and exit." - :long "help" - :short #\h - :reduce (constantly t))) - -(defparameter *option-version* - (adopt:make-option 'version - :help "Display version information and exit." - :long "version" - :reduce (constantly t))) - - -(defparameter *option-prefix* - (adopt:make-option 'prefix - :help "Prefix output lines with their path." - :short #\p - :long "prefix" - :reduce (constantly t))) - -(defparameter *option-no-prefix* - (adopt:make-option 'no-prefix - :result-key 'prefix - :help "Do not prefix output lines with their path (default)." - :short #\P - :long "no-prefix" - :reduce (constantly nil))) - - -(defparameter *option-format* - (adopt:make-option 'format - :help "The time format used to parse times from lines." - :parameter "FORMAT" - :long "format" - :short #\f - :initial-value :simple - :key #'keywordize - :reduce #'adopt:last)) - -(defparameter *option-reformat* - (adopt:make-option 'reformat - :help "Reformat parsed timestamps into FORMAT before outputting them." - :parameter "FORMAT" - :long "reformat" - :short #\r - :initial-value nil - :key #'keywordize - :reduce #'adopt:last)) - -(defparameter *option-no-reformat* - (adopt:make-option 'reformat - :help "Do not reformat parsed timestamps (default)." - :long "no-reformat" - :short #\R - :reduce (constantly nil))) - - -(defparameter *option-start* - (adopt:make-option 'start - :help "Only show lines at or after START." - :parameter "START" - :long "start" - :short #\s - :initial-value nil - :key #'parse-time-flexibly - :reduce #'adopt:last)) - -(defparameter *option-end* - (adopt:make-option 'end - :help "Only show lines at or before END." - :parameter "END" - :long "end" - :short #\e - :initial-value nil - :key #'parse-time-flexibly - :reduce #'adopt:last)) - - -(adopt:define-string *help-text* - "gtp filters lines by time. Instead of g/re/p it's g/time/p.~@ - ~@ - gtp will only print lines that have a timestamp somewhere in them. Use ~ - --format to select the timestamp format. Supported formats:~@ - ~@ - ~: - * simple: 2020/11/23 18:55:30 (default) - * rfc-3339: 2020-11-23 18:55:30Z - * iso-8601: 2020-11-23T18:55:30Z - * gnuplot: 11/23/20,18:55~@ - ~@ - You can additionally filter based on a time range using --start and/or --end. ~ - For convenience, these parameters can be given in any supported timestamp ~ - format, they don't have to match --format.") - -(defparameter *examples* - '(("Filter standard input and only print lines with an RFC-3339 time:" - . "gtp --format rfc-3339") - ("Print log lines after a particular time, and prefix each output line with its source filename:" - . "gtp **.log --prefix --after '2020/06/14 12:22:01'") - ("Print RFC-3339 log lines starting now, with now given in a different format:" - . "tail -f foo | gtp --format rfc-3339 --after \"$(date --utc --iso-8601=sec)\""))) - - -(defparameter *ui* - (adopt:make-interface - :name "gtp" - :usage "[OPTIONS] [FILE...]" - :summary "filter lines by timestamp" - :help *help-text* - :examples *examples* - :contents (list *option-help* - *option-version* - *option-format* - *option-reformat* - *option-no-reformat* - *option-start* - *option-end* - *option-prefix* - *option-no-prefix*))) - - -(defmacro exit-on-error (&body body) - `(handler-case (progn ,@body) - (error (c) (adopt:print-error-and-exit c)))) - -(defmacro exit-on-ctrl-c (&body body) - `(handler-case - (with-user-abort:with-user-abort (progn ,@body)) - (with-user-abort:user-abort () (adopt:exit 130)))) - - -(defun toplevel () - #+sbcl (sb-ext:disable-debugger) - (exit-on-error - (exit-on-ctrl-c - (multiple-value-bind (arguments options) (adopt:parse-options-or-exit *ui*) - (cond - ((gethash 'help options) (adopt:print-help-and-exit *ui*)) - ((gethash 'version options) (write-line *version*) (adopt:exit)) - (t (progn (local-time:reread-timezone-repository) - (run arguments - :format (gethash 'format options) - :start (gethash 'start options) - :end (gethash 'end options) - :prefix (gethash 'prefix options) - :reformat (gethash 'reformat options))))))))) - - -#; Scratch -------------------------------------------------------------------- - -(run - '("/home/sjl/scratch/logs/test/passport/passport.172.24.20.49.log") - :format :simple - :start (parse-time-flexibly "2020-07-15T17:31:00.000000") - :end (parse-time-flexibly "2020-07-15T17:31:55") - :prefix nil - :reformat :iso-8601) - -(parse-time-flexibly "2020-07-15 16:08:15.0000Z") - -(local-time:find-timezone-by-location-name "EDT") - -(local-time:reread-timezone-repository) diff -r b459210557b9 -r f37e47cda7c4 lisp/twizzle.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/twizzle.lisp Wed May 04 20:33:37 2022 -0400 @@ -0,0 +1,394 @@ +(eval-when (:compile-toplevel :load-toplevel :execute) + (ql:quickload '(:adopt :alexandria :cl-ppcre :with-user-abort :local-time) + :silent t)) + +(defpackage :twizzle + (:use :cl) + (:export :toplevel :*ui*)) + +(in-package :twizzle) + +;;;; Configuration ------------------------------------------------------------ +(setf local-time:*default-timezone* local-time:+utc-zone+) + +(defparameter *time-formats* + ;; An alist of (name . (parse-regex local-time-format-spec)), or (name . nil) + ;; for more complicated formats. + `((:rfc-3339 . ("(\\d{4})-(\\d{2})-(\\d{2})[ T](\\d{2}):(\\d{2}):(\\d{2})(?:[.]\\d+)?([+-]\\d{2}:\\d{2}|Z)?" + ,local-time:+rfc3339-format+)) + (:iso-8601 . ("(\\d{4})-(\\d{2})-(\\d{2})T(\\d{2}):(\\d{2}):(\\d{2})(?:,\\d+)?([+-]\\d{2}:\\d{2}|Z)?" + ,local-time:+iso-8601-format+)) + (:simple . ("(\\d{4})/(\\d{2})/(\\d{2}) (\\d{2}):(\\d{2}):(\\d{2})()" + ((:year 4) #\/ (:month 2) #\/ (:day 2) #\space (:hour 2) #\: (:min 2) #\: (:sec 2)))) + (:gnuplot . nil) + (:golang . nil) + (:unix-seconds . nil) + (:unix-milliseconds . nil))) + + +;;;; Utilities ---------------------------------------------------------------- +(defmacro match ((register-vars (start end) (regex target)) &body body) + (alexandria:with-gensyms (rs re) + (alexandria:once-only (regex target) + `(multiple-value-bind (,start ,end ,rs ,re) (ppcre:scan ,regex ,target) + (when ,start + (let (,@(loop :for r :from 0 + :for var :in register-vars + :collect `(,var (when (aref ,rs ,r) + (subseq ,target (aref ,rs ,r) (aref ,re ,r)))))) + ,@body)))))) + +(defun i (s) + (parse-integer s)) + +(defun keywordize (s) + (alexandria:make-keyword (string-upcase s))) + + +;;;; Time Formats ------------------------------------------------------------- +(defun microseconds->nanoseconds (msec) + (* msec 1000)) + +(defun milliseconds->nanoseconds (msec) + (* msec 1000 1000)) + + +(defun get-format (format) + (or (alexandria:assoc-value *time-formats* format) + (error "Unknown time format ~S" format))) + +(defun get-regex (format) + (first (get-format format))) + +(defun get-local-time-format (format) + (second (get-format format))) + + +(defun parse-timezone (string) + (if (member string '(nil "" "Z" "UTC" "+00:00" "-00:00") :test #'equal) + local-time:+utc-zone+ + (or (local-time:find-timezone-by-location-name string) + (error "TODO: handle timezone ~S" string)))) + + +(defgeneric make-parser (format) + (:documentation "Return a parsing function for the given format.")) + +(defmethod make-parser (format) + (let ((scanner (ppcre:create-scanner (get-regex format)))) + (lambda (s) + (match ((year month day hour minute second timezone) + (start end) + (scanner s)) + (values + (local-time:encode-timestamp + 0 (i second) (i minute) (i hour) (i day) (i month) (i year) + :timezone (parse-timezone timezone)) + start end))))) + +(defmethod make-parser ((format (eql :golang))) + (let ((scanner (ppcre:create-scanner "(\\d{4})/(\\d{2})/(\\d{2}) (\\d{2}):(\\d{2}):(\\d{2})(?:\\.(\\d{6}))?"))) + (lambda (s) + (match ((year month day hour minute seconds microseconds) + (start end) + (scanner s)) + (values (local-time:encode-timestamp + (microseconds->nanoseconds (i microseconds)) + (i seconds) (i minute) (i hour) (i day) (i month) (i year)) + start end))))) + +(defmethod make-parser ((format (eql :gnuplot))) + (let ((scanner (ppcre:create-scanner "(\\d{2})/(\\d{2})/(\\d{2}),(\\d{2}):(\\d{2})"))) + (lambda (s) + (match ((day month year hour minute) + (start end) + (scanner s)) + (values (local-time:encode-timestamp + 0 0 (i minute) (i hour) (i day) (i month) (+ 2000 (i year))) + start end))))) + +(defmethod make-parser ((format (eql :unix-seconds))) + (let ((scanner (ppcre:create-scanner "(\\d{13,14})"))) + (lambda (s) + (match ((unix) + (start end) + (scanner s)) + (when unix ; shut up sbcl + (values (local-time:unix-to-timestamp (i unix)) start end)))))) + +(defmethod make-parser ((format (eql :unix-milliseconds))) + (let ((scanner (ppcre:create-scanner "(\\d{10,11})"))) + (lambda (s) + (match ((unix) + (start end) + (scanner s)) + (when unix ; shut up sbcl + (multiple-value-bind (sec ms) (truncate (i unix) 1000) + (values (local-time:unix-to-timestamp sec :nsec (milliseconds->nanoseconds ms)) + start end))))))) + + +(defun make-predicate (format start end) + "Return a matching predicate for the user's query. + + This predicate will taka a line and return four values: + + * The timestamp found, if any. + * Whether the timestamp is inside the filtering bounds, if any. + * The start of the timestamp in the string, if any. + * The end of the timestamp in the string, if any. + + " + (let ((parser (make-parser format))) + (lambda (line) + (multiple-value-bind (line-time s e) (funcall parser line) + (values line-time + (and line-time + (or (null start) (local-time:timestamp<= start line-time)) + (or (null end) (local-time:timestamp<= line-time end))) + s + e))))) + + +(defgeneric make-formatter (format)) + +(defmethod make-formatter (format) + (let ((local-time-format (get-local-time-format format))) + (lambda (time stream) + (local-time:format-timestring stream time :format local-time-format)))) + +(defmethod make-formatter ((format (eql :golang))) + (lambda (time stream) + (local-time:format-timestring + stream time + :format '((:year 4) #\/ (:month 2) #\/ (:day 2) #\space (:hour 2) #\: (:min 2) #\: (:sec 2))))) + +(defmethod make-formatter ((format (eql :gnuplot))) + (lambda (time stream) + (let* ((f '((:day 2) #\/ (:month 2) #\/ #\Y #\, (:hour 2) #\: (:min 2))) + (s (local-time:format-timestring nil time :format f))) + ;; "16/07/Y,15:05" + (write-string s stream :start 0 :end 6) + (format stream "~2,'0D" (mod (local-time:timestamp-year time) 100)) + (write-string s stream :start 7)))) + +(defmethod make-formatter ((format (eql :unix-seconds))) + (lambda (time stream) + (format stream "~D" (local-time:timestamp-to-unix time)))) + +(defmethod make-formatter ((format (eql :unix-milliseconds))) + (lambda (time stream) + (format stream "~D" (+ (* 1000 (local-time:timestamp-to-unix time)) + (local-time:timestamp-millisecond time))))) + + +(defun parse-time-flexibly (string) + ;; todo optimize this + (loop :for format :in *time-formats* + :for parser = (make-parser (car format)) + :for result = (funcall parser string) + :when result :do (return-from parse-time-flexibly result)) + (error "Don't know how to parse ~S as a time." string)) + + +;;;; Run ---------------------------------------------------------------------- +(defun run% (predicate in out path prefix reformat only) + (loop + :for line = (read-line in nil) + :while line + ; todo support multiple timestamps per line + :do (multiple-value-bind (time in-bounds start end) (funcall predicate line) + (if (null time) + (unless only + (write-line line out)) + (when in-bounds + (when prefix + (write-string path out) + (write-char #\: out)) + (if reformat + (progn (write-string line out :start 0 :end start) + (funcall reformat time out) + (write-line line out :start end)) + (write-line line out))))))) + +(defun run (paths &key format start end prefix reformat only) + (when (null paths) + (setf paths '("-"))) + (when (and start end (local-time:timestamp< end start)) + (error "Start ~S is after end ~S." start end)) + (when reformat + (setf reformat (make-formatter reformat))) + (let ((pred (make-predicate format start end))) + (dolist (path paths) + (if (string= "-" path) + (run% pred *standard-input* *standard-output* path prefix reformat only) + (with-open-file (stream path :direction :input) + (run% pred stream *standard-output* path prefix reformat only)))))) + + +;;;; User Interface ----------------------------------------------------------- +(defparameter *option-help* + (adopt:make-option 'help + :help "Display help and exit." + :long "help" + :short #\h + :reduce (constantly t))) + + +(adopt:defparameters (*option-prefix* *option-no-prefix*) + (adopt:make-boolean-options 'prefix + :help "Prefix output lines with their path." + :help-no "Do not prefix output lines with their path (default)." + :short #\p + :long "prefix")) + + +(adopt:defparameters (*option-only* *option-all*) + (adopt:make-boolean-options 'only + :help "Only output lines containing a timestamp." + :help-no "Output all lines, even those without a timestamp (default)." + :short #\o + :short-no #\a + :long "only" + :long-no "all")) + + +(defparameter *option-format* + (adopt:make-option 'format + :help "The time format used to parse times from lines." + :parameter "FORMAT" + :long "format" + :short #\f + :initial-value :simple + :key #'keywordize + :reduce #'adopt:last)) + +(defparameter *option-reformat* + (adopt:make-option 'reformat + :help "Reformat parsed timestamps into FORMAT before outputting them." + :parameter "FORMAT" + :long "reformat" + :short #\r + :initial-value nil + :key #'keywordize + :reduce #'adopt:last)) + +(defparameter *option-no-reformat* + (adopt:make-option 'reformat + :help "Do not reformat parsed timestamps (default)." + :long "no-reformat" + :short #\R + :reduce (constantly nil))) + + +(defparameter *option-start* + (adopt:make-option 'start + :help "Only show lines at or after START." + :parameter "START" + :long "start" + :short #\s + :initial-value nil + :key #'parse-time-flexibly + :reduce #'adopt:last)) + +(defparameter *option-end* + (adopt:make-option 'end + :help "Only show lines at or before END." + :parameter "END" + :long "end" + :short #\e + :initial-value nil + :key #'parse-time-flexibly + :reduce #'adopt:last)) + + +(adopt:define-string *help-text* + "twizzle lets you swizzle timestamps.~@ + ~@ + Use --format to select the incoming timestamp format, and --reformat to ~ + swizzle them into a different format if desired. Supported formats:~@ + ~@ + ~: + * simple: 2020/11/23 18:55:30 (default) + * rfc-3339: 2020-11-23 18:55:30Z + * iso-8601: 2020-11-23T18:55:30Z + * gnuplot: 11/23/20,18:55~@ + ~@ + You can additionally filter based on a time range using --start and/or --end. ~ + For convenience, these parameters can be given in any supported timestamp ~ + format, they don't have to match --format.~@ + ~@ + Currently only the first timestamp per line is considered.") + +(defparameter *examples* + '(("Filter standard input and only print lines with an RFC-3339 time:" + . "twizzle --format rfc-3339") + ("Print log lines after a particular time, and prefix each output line with its source filename:" + . "twizzle **.log --prefix --after '2020/06/14 12:22:01'") + ("Print RFC-3339 log lines starting now, with now given in a different format:" + . "tail -f foo | twizzle --format rfc-3339 --after \"$(date --utc --iso-8601=sec)\""))) + + +(defparameter *ui* + (adopt:make-interface + :name "twizzle" + :usage "[OPTIONS] [FILE...]" + :summary "swizzle timestamps" + :help *help-text* + :examples *examples* + :contents (list *option-help* + (adopt:make-group 'timestamp-formats + :title "Timestamp Formats" + :options (list *option-format* + *option-reformat* + *option-no-reformat*)) + (adopt:make-group 'output-filtering + :title "Output Control" + :options (list *option-only* + *option-all* + *option-start* + *option-end* + *option-prefix* + *option-no-prefix*))))) + + +(defmacro exit-on-error (&body body) + `(handler-case (progn ,@body) + (error (c) (adopt:print-error-and-exit c)))) + +(defmacro exit-on-ctrl-c (&body body) + `(handler-case + (with-user-abort:with-user-abort (progn ,@body)) + (with-user-abort:user-abort () (adopt:exit 130)))) + + +(defun toplevel () + #+sbcl (sb-ext:disable-debugger) + (exit-on-error + (exit-on-ctrl-c + (multiple-value-bind (arguments options) (adopt:parse-options-or-exit *ui*) + (cond + ((gethash 'help options) (adopt:print-help-and-exit *ui*)) + (t (progn (local-time:reread-timezone-repository) + (run arguments + :format (gethash 'format options) + :start (gethash 'start options) + :end (gethash 'end options) + :prefix (gethash 'prefix options) + :only (gethash 'only options) + :reformat (gethash 'reformat options))))))))) + + +#; Scratch -------------------------------------------------------------------- + +(run + '("/home/sjl/scratch/logs/logs/prod/saas-warehouse-i-06b0ea6fe4e6dd3fd.log") + :format :golang + :prefix nil + :reformat :rfc-3339) + +(parse-time-flexibly "2020-07-15 16:08:15.0000Z") + +(local-time:find-timezone-by-location-name "EDT") + +(local-time:reread-timezone-repository) diff -r b459210557b9 -r f37e47cda7c4 lispwords --- a/lispwords Tue Apr 05 10:54:24 2022 -0400 +++ b/lispwords Wed May 04 20:33:37 2022 -0400 @@ -126,7 +126,7 @@ ; adopt (2 define-interface) -(1 make-option make-boolean-options) +(1 make-option make-boolean-options make-group) (1 quit-on-ctrl-c) diff -r b459210557b9 -r f37e47cda7c4 stumpwmrc --- a/stumpwmrc Tue Apr 05 10:54:24 2022 -0400 +++ b/stumpwmrc Wed May 04 20:33:37 2022 -0400 @@ -520,6 +520,61 @@ ((:integer "Seconds: ")) (run-shell-command (format nil "tea ~D" seconds))) +;;;; Isk ---------------------------------------------------------------------- +(defcommand send-key (key &optional (win (current-window))) (:key) + "Send key press and key release events for KEY to window WIN." + ;; from https://github.com/alezost/stumpwm-config/blob/master/utils.lisp + (let ((xwin (window-xwin win))) + (multiple-value-bind (code state) (stumpwm::key-to-keycode+state key) + (flet ((send (event) + (xlib:send-event xwin event (xlib:make-event-mask event) + :display *display* + :root (screen-root (window-screen win)) + :x 0 :y 0 :root-x 0 :root-y 0 + :window xwin :event-window xwin + :code code + :state state))) + (send :key-press) + (send :key-release) + (xlib:display-finish-output *display*))))) + +(defun send-keys (keys &key (win (current-window)) (sleep 0)) + (dolist (k keys) + (send-key (kbd k) win) + (sleep sleep))) + +(defmacro defmultikey (name key compose-keys) + ;; Unfortunately we can't reliably autogen the name with something like + ;; (symb 'mk- compose-key) here because things like đ (th) and Đ (TH) would + ;; case fold to the same name. + `(progn + (defcommand ,name () () + (send-keys '("Multi_key" ,@(map 'list #'string compose-keys)))) + (define-key *top-map* + (kbd ,key) ,(string name)))) + +(defmacro defmultikeys (&rest bindings) + `(progn ,@(loop for binding :in bindings :collect `(defmultikey ,@binding)))) + +(defmultikeys + (isk-l-á "M-a" "'a") + (isk-u-Á "M-A" "'A") + (isk-l-é "M-e" "'e") + (isk-u-É "M-E" "'E") + (isk-l-í "M-i" "'i") + (isk-u-Í "M-I" "'I") + (isk-l-ó "M-o" "'o") + (isk-u-Ó "M-O" "'O") + (isk-l-ú "M-u" "'u") + (isk-u-Ú "M-U" "'U") + (isk-l-ý "M-y" "'y") + (isk-u-Ý "M-Y" "'Y") + (isk-l-þ "M-t" "th") + (isk-u-Þ "M-T" "TH") + (isk-l-đ "M-d" "dh") + (isk-u-Đ "M-D" "DH")) + + ;;;; Key Mapping -------------------------------------------------------------- ;;; Conventions: @@ -652,6 +707,7 @@ ("H-F12" "refresh-heads")) + ;; (stumpwm::unbind-remapped-keys) (define-remapped-keys '(("st-256color" diff -r b459210557b9 -r f37e47cda7c4 vim/custom-dictionary.utf-8.add --- a/vim/custom-dictionary.utf-8.add Tue Apr 05 10:54:24 2022 -0400 +++ b/vim/custom-dictionary.utf-8.add Wed May 04 20:33:37 2022 -0400 @@ -315,3 +315,4 @@ UUIDs metaclass async +Greatshield diff -r b459210557b9 -r f37e47cda7c4 vim/vimrc --- a/vim/vimrc Tue Apr 05 10:54:24 2022 -0400 +++ b/vim/vimrc Wed May 04 20:33:37 2022 -0400 @@ -1461,6 +1461,11 @@ return '=' endfunction +func Eatchar(pat) + let c = nr2char(getchar(0)) + return (c =~ a:pat) ? '' : c +endfunc + augroup ft_go au! @@ -1481,6 +1486,18 @@ au FileType go iabbrev enil if err != nil au FileType go iabbrev rete return err au FileType go iabbrev retne return nil, err + au FileType go iabbrev retse return "", err + au FileType go iabbrev retze return "", err + + au FileType go iabbrev enilre if err != nil {return err + au FileType go iabbrev enilrn if err != nil {return nil, err + au FileType go iabbrev enilrs if err != nil {return "", err + au FileType go iabbrev enilrz if err != nil {return 0, err + + au FileType go iabbrev enilrw if err != nil {return fmt.Errorf(": %w", err=Eatchar('\s') + au FileType go iabbrev enilrwn if err != nil {return nil, fmt.Errorf(": %w", err=Eatchar('\s') + au FileType go iabbrev enilrws if err != nil {return "", fmt.Errorf(": %w", err=Eatchar('\s') + au FileType go iabbrev enilrwz if err != nil {return 0, fmt.Errorf(": %w", err=Eatchar('\s') au FileType gohtmltmpl setlocal shiftwidth=4 augroup END @@ -2431,6 +2448,18 @@ \ "SPEED": 1 \ } +let g:vlime_contribs = [ + \ "SWANK-ASDF", + \ "SWANK-PACKAGE-FU", + \ "SWANK-PRESENTATIONS", + \ "SWANK-FANCY-INSPECTOR", + \ "SWANK-C-P-C", + \ "SWANK-ARGLISTS", + \ "SWANK-REPL", + \ "SWANK-FUZZY", + \ "SWANK-TRACE-DIALOG" + \ ] + " let g:vlime_indent_keywords = {"defsystem": 1} function! CleanVlimeWindows()