aboutsummaryrefslogtreecommitdiffstats
path: root/l/src
diff options
context:
space:
mode:
Diffstat (limited to 'l/src')
-rw-r--r--l/src/call-id.lisp15
-rw-r--r--l/src/config.lisp54
-rw-r--r--l/src/devtools-protocol.lisp45
-rw-r--r--l/src/macro.lisp14
-rw-r--r--l/src/main.lisp141
-rw-r--r--l/src/option.lisp82
-rw-r--r--l/src/package.lisp3
7 files changed, 0 insertions, 354 deletions
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))