Minimal safari driver logging

Safaridriver logging is relatively odd. It only has debug level logging, only logs to a file, and discovering that file is somewhat tricky. This change adds minimal support to discover and dump safaridriver logs. I'm not sure how many folks bother with safaridriver testing, so this change might be mostly a favour to myself when diagnosing safaridriver issues that arise from time to time. Closes #563 Incidentally fixes #517
clj-commons · Jul 9, 2024 · 7f31fea · 7f31fea
1 parent da66c37
commit 7f31fea
Show file tree

Hide file tree

Showing 9 changed files with 359 additions and 37 deletions.
diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc
@@ -10,6 +10,8 @@ A release with an intentional breaking changes is marked with:
 * https://github.com/clj-commons/etaoin/pull/552[#552]: Add support for wide characters to input fill functions
 (https://github.com/tupini07[@tupini07])
 * https://github.com/clj-commons/etaoin/issues/566[#566]: Recognize `:driver-log-level` for Edge
+* https://github.com/clj-commons/etaoin/issues/563[#563]: Support `"debug"` `:driver-log-level` for Safari
+* https://github.com/clj-commons/etaoin/issues/517[#517]: Properly cleanup after failed webdriver launch
 * bump all deps to current versions
 * tests
 ** https://github.com/clj-commons/etaoin/issues/572[#572]: stop using chrome `--no-sandbox` option, it has become problematic on Windows (and we did not need it anyway)

diff --git a/bb.edn b/bb.edn
@@ -22,13 +22,12 @@
                                       :default "localhost"}}
                               :restrict true}]
                 (cli/parse-opts args cli-spec))))
-  :enter (let [{:keys [name]} (current-task)]
-           (when-not (string/starts-with? name "-")
-             (status/line :head "TASK %s %s" name (string/join " " *command-line-args*))))
-  :leave (let [{:keys [name]} (current-task)]
-           (when-not (string/starts-with? name "-")
+  :enter (let [{:keys [name task-decoration] :as f} (current-task)]
+           (when-not (= :none task-decoration)
+             (status/line :head "TASK %s" name)))
+  :leave (let [{:keys [name task-decoration] :as f} (current-task)]
+           (when-not (= :none task-decoration)
              (status/line :detail "\nTASK %s done." name)))
-
   ;; commands
   dev:jvm        {:doc "start a Clojure nrepl server/prompt"
                   :task (let [opts (parse-repl-args *command-line-args*)
@@ -47,6 +46,7 @@
   test:jvm       {:doc "Runs tests under JVM Clojure [--help]"
                   :task test/test-jvm}
   -test:bb       {:doc "bb test runner, invoked within script/test.clj"
+                  :task-decoration :none
                   :requires ([taoensso.timbre :as timbre])
                   ;; repeat :test paths from deps.edn
                   :extra-paths ["test" "env/test/resources"]
@@ -98,6 +98,7 @@
   docker-build   {:doc "build etaoin docker image"
                   :task (shell/command "docker build --no-cache -t etaoin:latest .")}
   -docker-install {:doc "helper to setup docker image"
+                   :task-decoration :none
                    :task docker-install/-main}
   docker-run     {:doc "run etaoin docker image (specify no commmands for interactive)"
                   :task (let [{:keys [exit]} (apply shell/command {:continue true}
@@ -106,5 +107,8 @@
                                                     "etaoin:latest"
                                                     *command-line-args*)]
                           (System/exit exit))}
+  fake-driver {:doc "Fake driver to support testing"
+               :task-decoration :none
+               :task fake-driver/-main}
   ci-release     {:doc "release tasks, use --help for args"
                   :task ci-release/-main}}}
diff --git a/doc/01-user-guide.adoc b/doc/01-user-guide.adoc
@@ -2196,6 +2196,11 @@ values vary by browser driver vendor:
 
 * chrome & edge `"OFF"` `"SEVERE"` `"WARNING"` `"INFO"` or `"DEBUG"`
 * firefox `"fatal"` `"error"` `"warn"` `"info"` `"config"` `"debug"` or `"trace"`
+* safari `"debug"` - safaridriver
+** has only one detailed log level which we enable via its `--diagnose` option and abstract via `"debug"`
+** only logs to a log file which Etaion automatically discovers and populates as <<opt-driver-log-file>> in the `driver` map
+** see <<opt-post-stop-fns>> for one way to dump this log file
+* phantomjs "ERROR"` `"WARN"` `"INFO"` `"DEBUG"`
 
 [id=opt-log-stdout,reftext=`:log-stdout`]
 [id=opt-log-stderr,reftext=`:log-sterr`]
@@ -2212,6 +2217,36 @@ _Example:_
 
 Specify `:inherit` to have WebDriver process output destination inherit from its calling process (for example, the console or some existing redirection to a file).
 
+[id=opt-driver-log-file,reftext=`:driver-log-file`]
+=== `:driver-log-file` for discovered WebDriver log file
+
+_Default:_ `<not set>` Etaoin will set this value for you
+
+_Example:_ `<n/a>` Not set by user
+
+Only populated for safaridriver when <<opt-driver-log-level>> set to `"debug"`.
+
+[id=opt-post-stop-fns,reftext=`:post-stop-fns`]
+=== `:post-stop-fns` to hook in behaviour at driver stop
+
+_Default:_ `<not set>`
+
+_Example:_
+One usage is to dump safaridriver <<opt-driver-log-file>>.
+
+//:test-doc-blocks/skip
+[source,clojure]
+----
+:post-stop-fns [(fn dump-discovered-log [driver]
+                  (if-let [log (:driver-log-file driver)]
+                    (do
+                      (println "-[start]-safaridriver log file" log)
+                      (with-open [in (io/input-stream log)]
+                        (io/copy in *out*))
+                      (println "-[end]-safaridriver log file" log))
+                    (println "-no safaridriver log file discovered-")))]
+----
+
 [id=opt-profile,reftext=`:profile`]
 === `:profile` path to web browser profile
 

diff --git a/script/fake_driver.clj b/script/fake_driver.clj
@@ -0,0 +1,67 @@
+(ns fake-driver
+  "A fake WebDriver to support testing, adapt as necessary for tests"
+  (:require [babashka.cli :as cli]
+            [cheshire.core :as json]
+            [lread.status-line :as status]
+            [org.httpkit.server :as server])
+  (:import [sun.misc Signal SignalHandler]))
+
+(def cli-spec {:help {:desc "This usage help" :alias :h}
+               :port {:ref "<port>"
+                      :desc "Expose server on this port"
+                      :coerce :int
+                      :default 8888
+                      :alias :p}
+               :sigterm-filename {:ref "<filename>"
+                                  :desc "Log a line to this filename when quit via sig term"}
+               :start-server {:ref "<boolean>"
+                              :desc "Start a fake webdriver request handler"
+                              :default true}})
+
+(defn- usage-help []
+  (status/line :head "Usage help")
+  (status/line :detail (cli/format-opts {:spec cli-spec :order [:port :sigterm-filename :start-server :help]})) )
+
+(defn- usage-fail [msg]
+  (status/line :error msg)
+  (usage-help)
+  (System/exit 1))
+
+(defn signal-handler [signal-id handler-fn]
+  (let [signal (Signal. signal-id)
+        handler (reify SignalHandler
+                  (handle [_ _] (handler-fn)))]
+    (Signal/handle signal handler)))
+
+(defn make-handler [_opts]
+  (fn handle-request [{:keys [request-method uri] :as _req}]
+    (cond
+      (and (= :post request-method) (= "/session" uri))
+      {:status 200
+       :headers {"Content-Type" "application/json"}
+       :body (json/generate-string {:sessionId (random-uuid)})}
+      (and (= :get request-method) (= "/status" uri))
+      {:status 200
+       :headers {"Content-Type" "application/json"}
+       :body (json/generate-string {:ready true})}
+      :else
+      {:status 404})))
+
+(defn -main [& args]
+  (let [opts (cli/parse-opts args {:spec cli-spec
+                                   :restrict true
+                                   :error-fn (fn [{:keys [msg]}]
+                                               (usage-fail msg))})]
+    (if (:help opts)
+      (usage-help)
+      (do
+        (when-let [log (:sigterm-filename opts)]
+          (signal-handler "TERM" (fn sigterm-handler []
+                                   ;; I don't think we need to worry about concurrency for our use case
+                                   (spit log "SIGTERM received, quitting" :append true)
+                                   (System/exit 0))))
+
+        (when (:start-server opts)
+          (server/run-server (make-handler opts) opts)))))
+
+  @(promise))
diff --git a/src/etaoin/api.clj b/src/etaoin/api.clj
@@ -144,6 +144,7 @@
   "
   (:require
    [babashka.fs :as fs]
+   [babashka.process :as p]
    [cheshire.core :as json]
    [clojure.java.io :as io]
    [clojure.string :as str]
@@ -2475,7 +2476,7 @@
 
 (defn wait-predicate
   "Wakes up every `:interval` seconds to call `pred`.
-  Keeps this up until either `pred` returns true or `:timeout` has elapsed.
+  Keeps this up until either `pred` returns truthy or `:timeout` has elapsed.
   When `:timeout` has elapsed a slingshot exception is throws with `:message`.
 
   Arguments:
@@ -2501,13 +2502,15 @@
                 :interval  interval
                 :times     times
                 :predicate pred}))
-     (when-not (with-http-error
-                 (pred))
-       (wait interval)
-       (recur pred (assoc
-                     opts
-                     :time-rest (- time-rest interval)
-                     :times (inc times)))))))
+     (let [res (with-http-error
+                 (pred))]
+       (or res
+           (do
+             (wait interval)
+             (recur pred (assoc
+                           opts
+                           :time-rest (- time-rest interval)
+                           :times (inc times)))))))))
 
 (defn wait-exists
   "Waits until `driver` finds element [[exists?]] via `q`.
@@ -3440,6 +3443,54 @@
       http (assoc :http http)
       ssl  (assoc :ssl ssl))))
 
+(defn- discover-safari-webdriver-log-pid [port]
+  ;; The safaridriver docs mislead, the pid in the filename is not the pid of safaridriver,
+  ;; it is of com.apple.WebDriver.HTTPService get the pid of whatever is listening to
+  ;; specified safaridriver port, this is macOS specific, but so is safari
+  (let [{:keys [exit out]} (p/shell {:out :string} "lsof -ti" (str ":" port))]
+    (when (zero? exit)
+      (str/trim out))))
+
+(defn- discover-safari-webdriver-log [{:keys [port created-epoch-ms] :as driver}]
+  (let [pid (wait-predicate #(discover-safari-webdriver-log-pid port)
+                            {:timeout 0
+                             :interval 0.2
+                             :message (format "Cannot discover safaridriver log file pid for port %s" port)})]
+    ;; force some output so that log file is created
+    (get-status driver)
+    (let [dir (fs/file (fs/home) "Library/Logs/com.apple.WebDriver")
+          glob (format "safaridriver.%s.*.txt" pid)
+          log-files (->> (fs/glob dir glob)
+                         ;; use last modified instead of fs/creation-time it is more reliable
+                         ;; creation-time was returning time in second resolution, not millisecond resolution
+                         (filter #(>= (-> % fs/last-modified-time fs/file-time->millis)
+                                      created-epoch-ms))
+                         (sort-by #(fs/last-modified-time %))
+                         (mapv str))]
+      (cond
+        (zero? (count log-files))
+        (log/warnf "Safaridriver log file not found for pid %s." pid)
+
+        (not= 1 (count log-files))
+        (let [candidates (->> log-files
+                              (mapv #(format " %s %s"
+                                             (-> % fs/last-modified-time fs/file-time->instant)
+                                             %)))]
+          (log/warnf "Found multiple matching safaridriver log file candidates, assuming latest from:\n%s"
+                     (str/join "\n" candidates))))
+      (if-let [log-file (last log-files)]
+        (do (log/infof "Safaridriver log file discovered %s" log-file)
+            (assoc driver :driver-log-file log-file))
+        driver))))
+
+(defn stop-driver
+  "Returns new `driver` after killing its WebDriver process."
+  [driver]
+  (proc/kill (:process driver))
+  (doseq [f (:post-stop-fns driver)]
+    (f driver))
+  (dissoc driver :process :args :env :capabilities :pre-stop-fns))
+
 (defn- -run-driver*
   [driver & [{:keys [dev
                      env
@@ -3450,7 +3501,8 @@
                      path-driver
                      download-dir
                      path-browser
-                     driver-log-level]}]]
+                     driver-log-level
+                     post-stop-fns]}]]
   (let [{:keys [port host]} driver
 
         _ (when (util/connectable? host port)
@@ -3472,7 +3524,16 @@
         process   (proc/run proc-args {:log-stdout log-stdout
                                        :log-stderr log-stderr
                                        :env        env})]
-    (util/assoc-some driver :env env :process process)))
+    (util/assoc-some driver
+                     :env env
+                     :process process
+                     :post-stop-fns post-stop-fns
+                     :created-epoch-ms (System/currentTimeMillis))))
+
+(defn- driver-action [driver action]
+  (case action
+    :discover-safari-webdriver-log (discover-safari-webdriver-log driver)
+    (throw (ex-info (str "Internal error: unrecognized action " action) {}))))
 
 (defn- -run-driver
   "Runs a driver process locally.
@@ -3528,12 +3589,15 @@
                 res (try
                       (wait-running driver)
                       (catch Exception e
+                        (stop-driver driver)
                         {:exception e}))]
             (if (not (:exception res))
-              driver
+              (reduce (fn [driver action]
+                        (driver-action driver action))
+                      driver
+                      (:post-run-actions driver))
               (recur (inc try-num) (:exception res)))))))))
 
-
 (defn- -connect-driver
   "Connects to a running Webdriver server.
 
@@ -3638,12 +3702,6 @@
 
   (dissoc driver :session))
 
-(defn stop-driver
-  "Returns new `driver` after killing its WebDriver process."
-  [driver]
-  (proc/kill (:process driver))
-  (dissoc driver :process :args :env :capabilities))
-
 (defn quit
   "Have `driver` close the current session, then, if Etaoin launched it, kill the WebDriver process."
   [driver]

diff --git a/src/etaoin/impl/driver.clj b/src/etaoin/impl/driver.clj
@@ -485,12 +485,19 @@
   [driver log-level]
   (set-args driver ["--log" log-level]))
 
+(defmethod set-driver-log-level
+  :safari
+  [driver log-level]
+  (when-not (= "debug" (string/lower-case log-level))
+    (throw (ex-info "Safari Driver only supports debug level logging" {})))
+  (-> (set-args driver ["--diagnose"])
+      (update :post-run-actions (fnil conj []) :discover-safari-webdriver-log)))
+
 (defmethod set-driver-log-level
   :phantom
   [driver log-level]
   (set-args driver [(format "--webdriver-loglevel=%s" log-level)]))
 
-
 ;;
 ;; User-Agent
 ;; https://stackoverflow.com/questions/29916054/

diff --git a/test/etaoin/api_test.clj b/test/etaoin/api_test.clj
@@ -50,11 +50,19 @@
                                                 :log-stderr :inherit
                                                 :driver-log-level "info"}))
    :safari (cond-> {}
-             ;; add logging for kind flaky CI scenario (maybe we'll answer why we need
+             ;; add logging for kind of flaky CI scenario (maybe we'll answer why we need
              ;; to retry launching safaridriver automatically)
-             ;; safaridriver only logs details to a somewhat obscure file, will follow up
-             ;; with some technique to discover/dump this file
-             (ci?) (merge {:log-stdout :inherit :log-stderr :inherit}))
+             (ci?) (merge {:log-stdout :inherit
+                           :log-stderr :inherit
+                           :driver-log-level "debug"
+                           :post-stop-fns [(fn dump-discovered-log [driver]
+                                             (if-let [log (:driver-log-file driver)]
+                                               (do
+                                                 (println "-[start]-safaridriver log file" log)
+                                                 (with-open [in (io/input-stream log)]
+                                                   (io/copy in *out*))
+                                                 (println "-[end]-safaridriver log file" log))
+                                               (println "-no safaridriver log file discovered-")))]}))
    :edge    {:args ["--headless"]}})
 
 (def drivers