diff options
Diffstat (limited to 'l')
| -rw-r--r-- | l/.gitignore | 1 | ||||
| -rw-r--r-- | l/Makefile | 25 | ||||
| -rw-r--r-- | l/TODO | 38 | ||||
| -rw-r--r-- | l/extreload.asd | 25 | ||||
| -rw-r--r-- | l/src/call-id.lisp | 15 | ||||
| -rw-r--r-- | l/src/config.lisp | 54 | ||||
| -rw-r--r-- | l/src/devtools-protocol.lisp | 45 | ||||
| -rw-r--r-- | l/src/macro.lisp | 14 | ||||
| -rw-r--r-- | l/src/main.lisp | 141 | ||||
| -rw-r--r-- | l/src/option.lisp | 82 | ||||
| -rw-r--r-- | l/src/package.lisp | 3 |
11 files changed, 0 insertions, 443 deletions
diff --git a/l/.gitignore b/l/.gitignore deleted file mode 100644 index be303db..0000000 --- a/l/.gitignore +++ /dev/null @@ -1 +0,0 @@ -*.fasl diff --git a/l/Makefile b/l/Makefile deleted file mode 100644 index 8cd0743..0000000 --- a/l/Makefile +++ /dev/null @@ -1,25 +0,0 @@ -LISP ?= sbcl - -build: - $(LISP) --load extreload.asd \ - --eval '(ql:quickload :extreload)' \ - --eval '(asdf:make :extreload)' \ - --eval '(quit)' - -release: - # ecl --eval '(require "asdf")' \ - # --load extreload.asd \ - # --eval '(ql:quickload :extreload)' \ - # --eval '(asdf:make :extreload)' \ - # --eval '(quit)' - ecl --eval '(require "asdf")' \ - --eval '(require "uiop")' \ - --load extreload.asd \ - --eval '(ql:quickload :extreload)' \ - --eval '(asdf:make-build :extreload \ - :type :program \ - :move-here #P"./" \ - :epilogue-code '"'"'(progn \ - (extreload:main) \ - (si:exit)))' \ - --eval '(quit)' @@ -1,38 +0,0 @@ -TODO - -2021.01.24: -v WebSockets URL to command line argument (2021.02.03) -v Command line arguments for extension IDs (2021.02.03) -v How to wait until all messages are sent before closing the WS connection (2021.01.31) - -2021.01.30: -v `string=` (2021.01.30) -v `unwind-protect` `with-` macro to close the connection (2021.01.31) -v wait-group (2021.01.31) -v `remove` in `filter` (2021.01.30) -x Release build with ECL (2021.02.27) (Trouble building. The compressed SBCL build is small enough for my liking.) - -2021.01.31: -v sysexits (2021.02.13) -v Timeout (2021.02.14) - -2021.02.02: -v Option to reload current tab (run `chrome.tabs.reload()` in the last target) (2021.02.08) -v Config object (2021.02.02) - -2021.02.03: -v Correct call ID numbering when multiple extensions are given (2021.02.03) -v Catch errors from all signals and print the error message instead of opening the debugger (2021.02.05) - -2021.02.08: -x Find out if we can take a port number only instead of a full WebSocket URL (2021.02.14) - -2021.02.14: -v Clean up code (2021.02.27) -v Documentation (2021.02.27) -v Tab reload not working consistently (2021.02.20) -v Remove or hide debug output (2021.02.27) - -2021.02.27: -- Move Lisp program out of `l/` -- Man page diff --git a/l/extreload.asd b/l/extreload.asd deleted file mode 100644 index 96e076e..0000000 --- a/l/extreload.asd +++ /dev/null @@ -1,25 +0,0 @@ -(asdf:defsystem extreload - :version "0.0.1" - :depends-on (:jsown - :sysexits - :trivial-timeout - :unix-opts - :wait-group - :websocket-driver-client) - :components ((:module "src" - :serial t - :components ((:file "package") - (:file "macro") - (:file "config") - (:file "option") - (:file "call-id") - (:file "devtools-protocol") - (:file "main")))) - - :build-operation "program-op" - :build-pathname "extreload" - :entry-point "extreload:main") - -#+sb-core-compression -(defmethod asdf:perform ((o asdf:image-op) (c asdf:system)) - (uiop:dump-image (asdf:output-file o c) :executable t :compression t)) diff --git a/l/src/call-id.lisp b/l/src/call-id.lisp deleted file mode 100644 index a21e6ab..0000000 --- a/l/src/call-id.lisp +++ /dev/null @@ -1,15 +0,0 @@ -(in-package :extreload) - -(defclass call-id () - ((id - :initform 0 - :reader id - :documentation "Current call ID.")) - - (:documentation "An incrementing identifier.")) - -(defgeneric next-call-id (call-id) - (:documentation "Increment the call ID and return the result.")) - -(defmethod next-call-id ((call-id call-id)) - (incf (slot-value call-id 'id))) diff --git a/l/src/config.lisp b/l/src/config.lisp deleted file mode 100644 index ab973cd..0000000 --- a/l/src/config.lisp +++ /dev/null @@ -1,54 +0,0 @@ -(in-package :extreload) - -(defclass config () - ((socket-url - :initarg :socket-url - :reader socket-url - :documentation "DevTools WebSocket URL") - (extension-ids - :initarg :extension-ids - :reader extension-ids - :documentation "Sequence of extension IDs") - (reload-current-tab - :initarg :reload-current-tab - :initform nil - :reader reload-current-tab - :documentation "True if the current tab should be reloaded") - (debug-output - :initarg :debug-output - :initform nil - :reader debug-output - :documentation "True to enable debug output") - - (ws-client - :reader ws-client - :documentation "WebSocket client"))) - -(defmethod print-object ((object config) stream) - (print-unreadable-object (object stream :type t) - (with-slots (socket-url - extension-ids - reload-current-tab - debug-output - ws-client) - object - (format - stream - ":socket-url ~s :extension-ids ~s :reload-current-tab ~s :debug-output ~s :ws-client ~s" - socket-url extension-ids reload-current-tab debug-output ws-client)))) - -(defun make-config (&key socket-url - extension-ids - reload-current-tab - debug-output) - "Initialise a new config." - (let ((config (make-instance 'config - :socket-url socket-url - :extension-ids extension-ids - :reload-current-tab reload-current-tab - :debug-output debug-output))) - - ;; Initialise a new websocket-driver client - (setf (slot-value config 'ws-client) (wsd:make-client socket-url)) - - config)) diff --git a/l/src/devtools-protocol.lisp b/l/src/devtools-protocol.lisp deleted file mode 100644 index 2d67033..0000000 --- a/l/src/devtools-protocol.lisp +++ /dev/null @@ -1,45 +0,0 @@ -;;;; DevTools Protocol messages. - -(in-package :extreload) - -(defun target-get-targets-msg (call-id) - "DevTools Protocol `Target.getTargets` message." - (jsown:to-json - `(:obj ("id" . ,call-id) - ("method" . "Target.getTargets")))) - -(defun target-attach-to-target-msg (call-id target-id) - "DevTools Protocol `Target.attachToTarget` message." - (jsown:to-json - `(:obj ("id" . ,call-id) - ("method" . "Target.attachToTarget") - ("params" . (:obj ("targetId" . ,target-id) - ("flatten" . t)))))) - -(defun target-attached-to-target-msg-p (message) - "Returns true if `message` is `Target.attachedToTarget`." - (equal - (json-obj-get message "method") - "Target.attachedToTarget")) - -(defun runtime-evaluate-msg (call-id session-id expression) - "DevTools Protocol `Runtime.evaluate` message." - (jsown:to-json - `(:obj ("id" . ,call-id) - ("sessionId" . ,session-id) - ("method" . "Runtime.evaluate") - ("params" . (:obj ("expression" . ,expression)))))) - -(defun runtime-evaluate-msg-p (message) - "Returns true if `message` is a response to `Runtime.evaluate`." - (jsown:keyp (json-obj-get message "result") "sessionId")) - -(defun runtime-evaluate-exception-p (message) - "Returns true if `message` describes a runtime exception" - (jsown:keyp (json-obj-get message "result") "exceptionDetails")) - -(defun parse-get-targets-response (response) - "Parses a list of target info objects from the response to `Target.getTargets`." - (let* ((result (json-obj-get response "result")) - (targetInfos (json-obj-get result "targetInfos"))) - targetInfos)) diff --git a/l/src/macro.lisp b/l/src/macro.lisp deleted file mode 100644 index 18c7d21..0000000 --- a/l/src/macro.lisp +++ /dev/null @@ -1,14 +0,0 @@ -(in-package :extreload) - -(defmacro filter (predicate list-form) - "Returns a sequence that only includes elements of `list-form` that satisfy -the test of `predicate`." - `(remove-if-not ,predicate ,list-form)) - -(defmacro with-websocket-connection ((client) &body body) - "Open a WebSocket connection on `client` and run `body` forms. The connection -is automatically closed at the end of execution." - `(progn - (wsd:start-connection ,client) - (unwind-protect (progn ,@body) - (wsd:close-connection ,client)))) diff --git a/l/src/main.lisp b/l/src/main.lisp deleted file mode 100644 index 5e44158..0000000 --- a/l/src/main.lisp +++ /dev/null @@ -1,141 +0,0 @@ -(in-package :extreload) - -(defvar *wg* (wait-group:make-wait-group)) -(defvar *devtools-root-call-id* (make-instance 'call-id) - "DevTools Protocol call ID.") -(defvar *devtools-secondary-call-id* (make-instance 'call-id) - "DevTools Protocol call ID used for messages to individual target sessions.") - -(defconstant +timeout-seconds+ 5 - "Global timeout. The program will exit at the end of this delay.") - -(defun main () - (handler-bind ((error #'(lambda (e) - (exit-with-error e sysexits:+unavailable+)))) - - ;; Store the config as a global. - (defvar *config* (parse-options)) - - (trivial-timeout:with-timeout (+timeout-seconds+) - (with-websocket-connection ((ws-client *config*)) - (wsd:on :message (ws-client *config*) - #'(lambda (message) - (ws-on-message - message - (extension-ids *config*) - *config*))) - - (websocket-send - (ws-client *config*) - (target-get-targets-msg - (next-call-id *devtools-root-call-id*))) - - (wait-group:wait *wg*))))) - -(defun ws-on-message (message extension-ids config) - "Called when a WebSocket message is received." - (let* ((response (jsown:parse message)) - (targets (parse-get-targets-response response))) - (when (debug-output config) - (format t "Response: ~a~%" response) - (format t "~a~%" *wg*)) - - (when targets - (let ((targets (extension-targets targets))) - - (attach-extensions targets extension-ids))) - - (if (target-attached-to-target-msg-p response) - (reload-extension (json-obj-get - (json-obj-get response "params") - "sessionId"))) - - (when (and (reload-current-tab config) - (runtime-evaluate-msg-p response)) - (reload-tab (json-obj-get - (json-obj-get response "result") - "sessionId"))) - - ;; Failed to reload tab. - (when (runtime-evaluate-exception-p response) - ;; `reload-tab` adds an extra increment to the wait group. If the call - ;; fails, we only receive one message instead of two, so the wait group - ;; must be decremented to match. - (wait-group:done *wg*) - - (reload-tab (json-obj-get response "sessionId"))) - - (wait-group:done *wg*))) - -(defun json-obj-get (obj key) - "Get the value of `key` from `obj` (a `jsown` object). Return nil if `key` is -not defined." - (handler-case - (jsown:val obj key) - (simple-error (e) - (let ((s (format nil "~A" e))) - (if (search "not available" s) - nil))))) - -(defun attach-extensions (targets extension-ids) - "Attach to all extensions in `targets` that match the IDs in -`extension-ids`." - (labels ((requested-extension-p (target) - (find-if - #'(lambda (id) - (uiop:string-prefix-p - (concatenate 'string "chrome-extension://" id) - (json-obj-get target "url"))) - extension-ids))) - - (dolist (extension (filter #'requested-extension-p targets)) - (attach-to-target extension)))) - -(defun attach-to-target (extension) - "Send a message to the target in `extension` asking to attach to the target." - (let ((target-id (json-obj-get extension "targetId"))) - (websocket-send (ws-client *config*) - (target-attach-to-target-msg - (next-call-id *devtools-root-call-id*) - target-id)))) - -(defun reload-extension (session-id) - "Send a message to an extension page corresponding to `session-id`, telling -the target extension to reload itself." - (websocket-send - (ws-client *config*) - (runtime-evaluate-msg - (next-call-id *devtools-secondary-call-id*) - session-id - "chrome.runtime.reload()"))) - -(defun reload-tab (session-id) - "Send a message to an extension page corresponding to `session-id`, telling -the target to reload the current tab." - - ;; Two response messages always come back from the `chrome.tabs.reload()` - ;; messages, so we need to add a second increment to the wait group. - (wait-group:add *wg*) - - (websocket-send - (ws-client *config*) - (runtime-evaluate-msg - (next-call-id *devtools-secondary-call-id*) - session-id - "chrome.tabs.reload()"))) - -(defun extension-targets (targets) - "Filter `targets`, returning a list of targets corresponding to extensions." - (labels ((extensionp (target) - (string= (json-obj-get target "type") - "background_page"))) - - (filter #'extensionp targets))) - -(defun websocket-send (client data) - "Send `data` to WebSocket `client` and increment `*wg*`." - (when (debug-output *config*) - (format t "Sending: ~a~%" data)) - - (wsd:send client data) - (wait-group:add *wg*)) diff --git a/l/src/option.lisp b/l/src/option.lisp deleted file mode 100644 index 6f9129c..0000000 --- a/l/src/option.lisp +++ /dev/null @@ -1,82 +0,0 @@ -;;;; Command line options. - -(in-package :extreload) - -;; Available command line options. -(opts:define-opts - (:name :socket-url - :description "DevTools protocol WebSocket URL" - :long "socket-url" - :arg-parser #'identity - :meta-var "SOCKET_URL") - (:name :reload-current-tab - :description "pass this to reload the active Chrome tab" - :long "reload-current-tab") - (:name :debug - :description "print debug output" - :long "debug") - (:name :help - :description "print this help menu" - :short #\h - :long "help") - (:name :version - :description "show the program version" - :short #\V - :long "version")) - -(defmacro when-option ((options option) &body body) - "When `option` is present in `options`, run `body`." - `(let ((value (getf ,options ,option))) - (when value - ,@body))) - -(defun exit-with-error (condition exit-code) - "Print the error associated with `condition` on standard error, then exit -with code `exit-code`." - (format *error-output* "error: ~a~%" condition) - - (opts:exit exit-code)) - -(defun handle-option-error (condition) - "Handle errors related to command line options. Prints the error specified by -`condition` and exits with EX_USAGE." - (exit-with-error condition sysexits:+usage+)) - -(defun parse-options () - "Parse command line options." - (multiple-value-bind (options free-args) - (handler-bind - ((opts:unknown-option #'handle-option-error) - (opts:missing-arg #'handle-option-error) - (opts:arg-parser-failed #'handle-option-error) - (opts:missing-required-option #'handle-option-error)) - - (opts:get-opts)) - - (when-option (options :help) - (opts:describe - :usage-of "extreload" - :args "EXTENSION_ID...") - - (opts:exit sysexits:+usage+)) - - (when-option (options :version) - (format t "~a~%" (asdf:component-version (asdf:find-system :extreload))) - - (opts:exit sysexits:+ok+)) - - (when (null (getf options :socket-url)) - (format *error-output* "error: '--socket-url' is required~%") - - (opts:exit sysexits:+usage+)) - - ;; Error if no extension IDs were given. - (when (null free-args) - (format *error-output* "error: missing extension IDs~%") - - (opts:exit sysexits:+usage+)) - - (make-config :socket-url (getf options :socket-url) - :reload-current-tab (getf options :reload-current-tab) - :debug-output (getf options :debug) - :extension-ids free-args))) diff --git a/l/src/package.lisp b/l/src/package.lisp deleted file mode 100644 index 03ee677..0000000 --- a/l/src/package.lisp +++ /dev/null @@ -1,3 +0,0 @@ -(defpackage :extreload - (:use :cl) - (:export :main)) |