Minimal safari driver logging

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
 * https://github.com/clj-commons/etaoin/issues/604[#604]: Add support for shadow DOM
 (https://github.com/dgr[@dgr])
 * https://github.com/clj-commons/etaoin/issues/603[#603]: Add :fn/index as alias for :index in map syntax

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}}}

doc/01-user-guide.adoc

@@ -2338,6 +2338,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`]
@@ -2354,6 +2359,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
 

script/fake_driver.clj

@@ -0,0 +1,51 @@
+(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]))
+
+(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}
+               :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 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)
+      (when (:start-server opts)
+        (server/run-server (make-handler opts) opts))))
+
+  @(promise))

src/etaoin/api.clj

@@ -147,6 +147,7 @@
   "
   (:require
    [babashka.fs :as fs]
+   [babashka.process :as p]
    [cheshire.core :as json]
    [clojure.java.io :as io]
    [clojure.string :as str]
@@ -2593,7 +2594,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:
@@ -2619,13 +2620,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`.
@@ -3558,6 +3561,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
@@ -3568,7 +3619,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)
@@ -3590,7 +3642,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.
@@ -3646,12 +3707,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.
 
@@ -3756,12 +3820,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]

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/

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