├── .github ├── FUNDING.yml └── workflows │ └── push.yml ├── .gitignore ├── README.md ├── examples ├── frame.html ├── frame.rkt ├── github.rkt ├── page-change-evt.rkt └── pdf.rkt ├── marionette-doc ├── info.rkt └── scribblings │ ├── examples.rktd │ └── marionette.scrbl ├── marionette-lib ├── LICENSE ├── browser.rkt ├── capabilities.rkt ├── element.rkt ├── info.rkt ├── key.rkt ├── main.rkt ├── page.rkt ├── private │ ├── browser.rkt │ ├── executor.rkt │ ├── json.rkt │ ├── marionette.rkt │ └── template.rkt ├── rect.rkt ├── support │ ├── get-page-change-token.js │ ├── set-page-change-token.js │ ├── user.js │ ├── wait-for-element.js │ └── wrap-async-script.js └── timeouts.rkt ├── marionette-test ├── LICENSE ├── info.rkt └── tests │ └── marionette │ └── integration │ ├── browser.rkt │ ├── common.rkt │ ├── element.rkt │ └── page.rkt └── marionette ├── LICENSE └── info.rkt /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: Bogdanp 2 | -------------------------------------------------------------------------------- /.github/workflows/push.yml: -------------------------------------------------------------------------------- 1 | on: [push, pull_request] 2 | jobs: 3 | build: 4 | runs-on: ubuntu-latest 5 | steps: 6 | - uses: actions/checkout@master 7 | - uses: Bogdanp/setup-racket@v1.13 8 | with: 9 | architecture: 'x64' 10 | distribution: 'full' 11 | variant: 'CS' 12 | version: '8.2' 13 | - run: raco pkg install --auto --skip-installed marionette-lib/ marionette-doc/ marionette-test/ marionette/ 14 | - run: raco pkg update marionette-lib/ marionette-doc/ marionette-test/ marionette/ 15 | - run: env PLTSTDERR='error debug@marionette' raco test marionette-test/ 16 | env: 17 | MARIONETTE_INTEGRATION_TESTS: x 18 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | compiled 2 | coverage 3 | doc 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # marionette 2 | 3 | [![.github/workflows/push.yml](https://github.com/Bogdanp/marionette/actions/workflows/push.yml/badge.svg)](https://github.com/Bogdanp/marionette/actions/workflows/push.yml) 4 | 5 | A Racket library that lets you control Firefox via the [Marionette 6 | Protocol]. 7 | 8 | ## Quickstart 9 | 10 | Install marionette: 11 | 12 | $ raco pkg install marionette 13 | 14 | Run `Firefox` with the `-marionette` flag: 15 | 16 | $ /path/to/firefox -headless -marionette -safe-mode 17 | 18 | Run this script: 19 | 20 | ``` racket 21 | #lang racket 22 | 23 | (require marionette) 24 | 25 | (call-with-browser! 26 | (lambda (b) 27 | (call-with-page! b 28 | (lambda (p) 29 | (page-goto! p "https://racket-lang.org") 30 | (call-with-page-screenshot! p 31 | (lambda (data) 32 | (define filename (make-temporary-file "~a.png")) 33 | (with-output-to-file filename 34 | #:exists 'truncate/replace 35 | (lambda () 36 | (write-bytes data))) 37 | 38 | (system* (find-executable-path "open") filename))))))) 39 | ``` 40 | 41 | ## Tips 42 | 43 | To run a headless, marionette-enabled Firefox while you've got another 44 | instance of the browser open, add the `-no-remote` flag: 45 | 46 | $ /path/to/firefox -no-remote -headless -marionette -safe-mode 47 | 48 | It's advisable that you use a separate profile as well: 49 | 50 | $ /path/to/firefox -P marionette -no-remote -headless -marionette -safe-mode 51 | 52 | You can create new profiles by visiting `about:profiles` in the 53 | browser. 54 | 55 | [Marionette Protocol]: https://firefox-source-docs.mozilla.org/testing/marionette/marionette/Protocol.html 56 | -------------------------------------------------------------------------------- /examples/frame.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | iFrame example 5 | 6 | 7 | 8 | 9 | 10 | -------------------------------------------------------------------------------- /examples/frame.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require marionette 4 | racket/runtime-path) 5 | 6 | (define-runtime-path frame.html 7 | "frame.html") 8 | 9 | (call-with-marionette/browser/page! 10 | (lambda (p) 11 | (page-goto! p (format "file:///~a" frame.html)) 12 | (page-switch-to-frame! p (page-query-selector! p "iframe")) 13 | (eprintf "frame h1: ~s~n" (element-text (page-query-selector! p "h1"))) 14 | (page-switch-to-parent-frame! p) 15 | (eprintf "outer h1: ~s~n" (page-query-selector! p "h1")))) 16 | -------------------------------------------------------------------------------- /examples/github.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require marionette 4 | marionette/key) 5 | 6 | (define (save&open data) 7 | (define filename (make-temporary-file "~a.png")) 8 | (with-output-to-file filename 9 | #:exists 'truncate/replace 10 | (lambda () 11 | (write-bytes data))) 12 | (system* (find-executable-path "open") filename)) 13 | 14 | (call-with-marionette/browser/page! 15 | #:headless? #f 16 | (lambda (p) 17 | (page-goto! p "https://github.com") 18 | (element-click! (page-wait-for! p "button.header-search-button")) 19 | 20 | (define search-bar 21 | (page-query-selector! p "[name=query-builder-test]")) 22 | 23 | (element-type! search-bar "Bogdanp/marionette") 24 | (element-type! search-bar (string key:return)) 25 | 26 | (define results-list 27 | (page-wait-for! p "[data-testid=results-list]")) 28 | 29 | (call-with-page-screenshot! p save&open) 30 | (when results-list 31 | (call-with-element-screenshot! results-list save&open)))) 32 | -------------------------------------------------------------------------------- /examples/page-change-evt.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require marionette 4 | web-server/servlet 5 | (only-in xml current-unescaped-tags html-unescaped-tags)) 6 | 7 | (current-unescaped-tags html-unescaped-tags) 8 | 9 | (define ((app n) _req) 10 | (send/suspend/dispatch 11 | (lambda (embed/url) 12 | (sleep 1) 13 | (response/xexpr 14 | #:preamble #"" 15 | `(html 16 | (head 17 | (script ([src "https://cdn.jsdelivr.net/npm/unpoly@3.10.2/unpoly.min.js"]))) 18 | (body 19 | (div.content 20 | (p ,(format "Counter: ~a" n)) 21 | (a 22 | ([class "continue-button"] 23 | [href ,(embed/url (app (add1 n)))] 24 | [up-target ".content"]) 25 | "Continue")))))))) 26 | 27 | (define (run-marionette port) 28 | (call-with-marionette/browser/page! 29 | #:headless? #f 30 | (lambda (p) 31 | (page-goto! p (format "http://127.0.0.1:~a" port)) 32 | (define e (page-change-evt p)) 33 | (element-click! (page-wait-for! p ".continue-button")) 34 | (println (page-url p)) 35 | (println `(sync-result ,(sync e))) 36 | (println (page-url p)) 37 | (println `(sync-result ,(sync e))) 38 | (define e2 (page-change-evt p)) 39 | (abandon-page-change-evt e2) 40 | (println `(timeout-result ,(sync/timeout 1 e2)))))) 41 | 42 | (module+ main 43 | (require racket/async-channel 44 | web-server/servlet-dispatch 45 | web-server/web-server) 46 | 47 | (define port-or-exn-ch 48 | (make-async-channel)) 49 | (define stop 50 | (serve 51 | #:confirmation-channel port-or-exn-ch 52 | #:dispatch (dispatch/servlet (app 1)) 53 | #:port 0)) 54 | (define port-or-exn 55 | (sync port-or-exn-ch)) 56 | (when (exn:fail? port-or-exn) 57 | (raise port-or-exn)) 58 | (define marionette-thd 59 | (thread 60 | (lambda () 61 | (run-marionette port-or-exn)))) 62 | (with-handlers ([exn:break? void]) 63 | (sync/enable-break marionette-thd)) 64 | (stop)) 65 | -------------------------------------------------------------------------------- /examples/pdf.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require marionette) 4 | 5 | (call-with-marionette/browser/page! 6 | #:headless? #f 7 | (lambda (p) 8 | (page-goto! p "https://example.com") 9 | (call-with-page-pdf! p 10 | (lambda (data) 11 | (define filename (make-temporary-file "~a.pdf")) 12 | (with-output-to-file filename 13 | #:exists 'truncate/replace 14 | (lambda () 15 | (write-bytes data))) 16 | (system* (find-executable-path "open") filename))))) 17 | -------------------------------------------------------------------------------- /marionette-doc/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define license 'BSD-3-Clause) 4 | (define collection "marionette") 5 | (define scribblings '(("scribblings/marionette.scrbl" ()))) 6 | 7 | (define deps '("base")) 8 | (define build-deps '("marionette-lib" 9 | "sandbox-lib" 10 | "scribble-lib" 11 | 12 | "net-doc" 13 | "racket-doc")) 14 | (define update-implies '("marionette-lib")) 15 | -------------------------------------------------------------------------------- /marionette-doc/scribblings/examples.rktd: -------------------------------------------------------------------------------- 1 | ;; This file was created by make-log-based-eval 2 | ((require marionette racket/file) 3 | ((3) 0 () 0 () () (c values c (void))) 4 | #"" 5 | #"") 6 | ((define data 7 | (call-with-marionette/browser/page! 8 | (lambda (p) 9 | (page-goto! p "https://racket-lang.org") 10 | (call-with-page-screenshot! p values)))) 11 | ((3) 0 () 0 () () (c values c (void))) 12 | #"" 13 | #"") 14 | ((define filename (make-temporary-file "~a.png")) 15 | ((3) 0 () 0 () () (c values c (void))) 16 | #"" 17 | #"") 18 | ((with-output-to-file 19 | filename 20 | #:exists 21 | 'truncate/replace 22 | (lambda () (write-bytes data))) 23 | ((3) 0 () 0 () () (q values 791931)) 24 | #"" 25 | #"") 26 | ((printf "filename of page screenshot: ~v\n" (path->string filename)) 27 | ((3) 0 () 0 () () (c values c (void))) 28 | #"filename of page screenshot: \"/var/folders/6s/8kt06x656dddy8z5y0jmf_fc0000gn/T/16266838661626683866996.png\"\n" 29 | #"") 30 | -------------------------------------------------------------------------------- /marionette-doc/scribblings/marionette.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require racket/runtime-path 4 | racket/sandbox 5 | scribble/example 6 | (for-label json 7 | marionette 8 | marionette/key 9 | net/url 10 | racket/base 11 | racket/contract/base 12 | racket/file 13 | racket/math 14 | racket/string)) 15 | 16 | @title{Marionette} 17 | @author[(author+email "Bogdan Popa" "bogdan@defn.io")] 18 | @defmodule[marionette] 19 | 20 | @section[#:tag "intro"]{Introduction} 21 | 22 | @(define protocol-link "https://firefox-source-docs.mozilla.org/testing/marionette/marionette/Protocol.html") 23 | 24 | Marionette lets you control the Firefox web browser via the 25 | @hyperlink[protocol-link]{Marionette Protocol}. This is the same 26 | interface used by Selenium, via geckodriver. 27 | 28 | To use this library, you need to have a running Firefox instance with 29 | the marionette protocol enabled. To do this, all you have to do is 30 | run the firefox binary with the @literal{-marionette} flag. 31 | 32 | 33 | @section[#:tag "examples"]{Examples} 34 | 35 | Here are some simple examples of using marionette. The first saves a PNG file 36 | containing an image of the current racket-lang.org webpage: 37 | 38 | @(begin 39 | (define-syntax-rule (interaction e ...) (examples #:label #f e ...)) 40 | (define-runtime-path log-file "examples.rktd") 41 | (define log-mode (if (getenv "MARIONETTE_RECORD") 'record 'replay)) 42 | (define (make-ex-eval log-file) 43 | (make-log-based-eval log-file log-mode)) 44 | (define ex-eval (make-ex-eval log-file))) 45 | 46 | 47 | @interaction[ 48 | #:eval ex-eval 49 | (require marionette 50 | racket/file) 51 | 52 | (code:line) 53 | (define data 54 | (call-with-marionette/browser/page! 55 | (lambda (p) 56 | (page-goto! p "https://racket-lang.org") 57 | (call-with-page-screenshot! p values)))) 58 | 59 | (code:line) 60 | (define filename 61 | (make-temporary-file "~a.png")) 62 | 63 | (code:line) 64 | (with-output-to-file filename 65 | #:exists 'truncate/replace 66 | (lambda () 67 | (write-bytes data))) 68 | 69 | (code:line) 70 | (printf "filename of page screenshot: ~v\n" (path->string filename)) 71 | ] 72 | 73 | This next example dowloads the HTML content of a password-protected 74 | web page: 75 | 76 | @codeblock|{ 77 | #lang racket 78 | 79 | (require marionette) 80 | 81 | (define username "zipnarg") 82 | 83 | (define nextcatalog-csc-minor-url 84 | "https://nextcatalog-admin.calpoly.edu/collegesandprograms/\ 85 | collegeofengineering/computersciencesoftwareengineering/\ 86 | computerscienceminor/") 87 | 88 | (define profile-path 89 | (build-path "/Users/zipnarg/Library/Application Support/" 90 | "Firefox/Profiles/s9y75gtr.wazoo")) 91 | 92 | (define content 93 | (call-with-marionette/browser/page! 94 | #:profile profile-path 95 | (λ (page) 96 | (page-goto! page nextcatalog-csc-minor-url) 97 | (printf "ready? ~v\n" (page-loaded? page)) 98 | (printf "page title: ~v\n" (page-title page)) 99 | (let () 100 | (define username-elt (page-query-selector! page "#username")) 101 | (cond [username-elt 102 | (element-type! username-elt username)] 103 | [else 104 | (error 'login "couldn't find username field.")])) 105 | (let () 106 | (define password-elt (page-query-selector! page "#password")) 107 | (cond [password-elt 108 | (printf "password: ") 109 | (define str (read-line)) 110 | (element-type! password-elt str)] 111 | [else 112 | (error 'login "couldn't find password field.")])) 113 | (let () 114 | (define form-button (page-query-selector! page ".form-button")) 115 | (cond [form-button 116 | (element-click! form-button)] 117 | [else 118 | (error 'login "couldn't find login button.")])) 119 | ;; wait until the page is ready and the title is no longer 120 | ;; that of the login page 121 | (let loop () 122 | (define loaded? (page-loaded? page)) 123 | (cond [loaded? 124 | (define title (page-title page)) 125 | (cond [(equal? title "Cal Poly Web Login Service") 126 | (printf "still login screen title, waiting...\n") 127 | (sleep 1) 128 | (loop)] 129 | [else 'ok])] 130 | [else 131 | (printf "not ready, waiting...\n") 132 | (sleep 1) 133 | (loop)])) 134 | (printf "final page title: ~v\n" (page-title page)) 135 | (page-content page)))) 136 | }| 137 | 138 | @section[#:tag "reference"]{Reference} 139 | 140 | @deftogether[ 141 | (@defproc[(start-marionette! [#:command command absolute-path? "/usr/local/bin/firefox"] 142 | [#:profile profile (or/c #f absolute-path?) #f] 143 | [#:user.js user.js (or/c #f (hash/c string? (or/c boolean? number? string?))) #f] 144 | [#:port port (or/c #f (integer-in 1 65535)) #f] 145 | [#:safe-mode? safe-mode? boolean? #t] 146 | [#:headless? headless? boolean? #t] 147 | [#:timeout timeout exact-nonnegative-integer? 5]) (-> void?)] 148 | @defproc[(call-with-marionette! [p (-> any)]) any] 149 | @defproc[(call-with-marionette/browser! [p (-> browser? any)]) any] 150 | @defproc[(call-with-marionette/browser/page! [p (-> page? any)]) any])]{ 151 | 152 | Start a marionette-enabled instance of the Firefox browser using 153 | @racket[profile]. The return value is a procedure that can be used 154 | to stop the browser. 155 | 156 | The @racket[command] argument controls the path to the firefox 157 | binary. If not provided, the system @exec{PATH} is searched along 158 | with the @exec{/Applications} folder on macOS. 159 | 160 | When the @racket[#:profile] argument is @racket[#f], a temporary 161 | path si created for the profile and it it subsequently removed when 162 | the browser is stopped. 163 | 164 | When the @racket[#:port] argument is provided, the @racket[profile] 165 | will be modified to instruct the marionette server to listen on that 166 | port. 167 | 168 | When the @racket[#:user.js] argument is provided, the contents of 169 | the hash will be set as preferences in the @racket[profile]. 170 | 171 | The @racket[call-with-marionette!] procedure accepts the same 172 | keyword arguments that @racket[start-marionette!] does. It starts 173 | the browser, applies its @racket[p] argument then immediately stops 174 | the browser. 175 | 176 | The @racket[call-with-marionette/browser!] procedure composes 177 | @racket[call-with-marionette!] and @racket[call-with-browser!] 178 | together. Keyword arguments are passed through to 179 | @racket[start-marionette!]. 180 | 181 | The @racket[call-with-marionette/browser/page!] procedure composes 182 | @racket[call-with-marionette/browser!] and @racket[call-with-page!] 183 | together. Keyword arguments are passed through to 184 | @racket[start-marionette!]. 185 | } 186 | 187 | @defproc[(call-with-browser! [p (-> browser? any)] 188 | [#:host host non-empty-string? "127.0.0.1"] 189 | [#:port port (integer-in 1 65535) 2828] 190 | [#:capabilities capabilities capabilities? (make-capabilities)]) any]{ 191 | Calls @racket[p] after initiating a new browser session and 192 | disconnects after @racket[p] finishes executing. 193 | } 194 | 195 | @defproc[(call-with-page! [b browser?] 196 | [p (-> page? any)]) 197 | any]{ 198 | Calls @racket[p] after creating a new page and closes said page 199 | after @racket[p] finishes executing. 200 | } 201 | 202 | @subsection[#:tag "reference/browser"]{Browser} 203 | 204 | @deftech{Browsers} represent a connection to a marionette-driven 205 | instance of Firefox. Browsers are not thread-safe, nor is it safe to 206 | interleave commands against the same marionette server. If you need 207 | concurrency, then create multiple marionettes and control them 208 | separately. 209 | 210 | @defproc[(browser? [b any/c]) boolean?]{ 211 | Returns @racket[#t] when @racket[b] is a @tech{browser}. 212 | } 213 | 214 | @defproc[(browser-connect! [#:host host non-empty-string? "127.0.0.1"] 215 | [#:port port (integer-in 1 65535) 2828] 216 | [#:capabilities capabilities capabilities? (make-capabilities)]) browser?]{ 217 | Connects to the marionette server at @racket[host] and @racket[port] 218 | and returns a @tech{browser} session. 219 | } 220 | 221 | @defproc[(browser-disconnect! [b browser?]) void?]{ 222 | Disconnects @racket[b] from its marionette. 223 | } 224 | 225 | @deftogether[ 226 | (@defproc[(browser-timeouts [b browser?]) timeouts?] 227 | @defproc[(set-browser-timeouts! [b browser?] 228 | [t timeouts?]) void?])]{ 229 | Get or set the @racket[b]'s current timeout settings. 230 | } 231 | 232 | @deftogether[ 233 | (@defproc[(browser-viewport-size [b browser?]) (values exact-nonnegative-integer? 234 | exact-nonnegative-integer?)] 235 | @defproc[(set-browser-viewport-size! [b browser?] 236 | [w exact-nonnegative-integer?] 237 | [h exact-nonnegative-integer?]) void?])]{ 238 | Get or set @racket[b]'s current viewport size. 239 | } 240 | 241 | @defproc[(make-browser-page! [b browser?]) page?]{ 242 | Open a new page in @racket[b] and return it. 243 | } 244 | 245 | @defproc[(browser-capabilities [b browser?]) capabilities?]{ 246 | Retrieve the @racket[capabilities?] for @racket[b]. 247 | } 248 | 249 | @defproc[(browser-pages [b browser?]) (listof page?)]{ 250 | Lists all the pages belonging to @racket[b]. 251 | } 252 | 253 | @defproc[(browser-focus! [b browser?] 254 | [p page?]) void?]{ 255 | Makes @racket[p] the currently active page. 256 | } 257 | 258 | 259 | @subsection[#:tag "reference/page"]{Page} 260 | 261 | @defproc[(page? [p any/c]) boolean?]{ 262 | Returns @racket[#t] when @racket[p] is a page. 263 | } 264 | 265 | @defproc[(page=? [p1 page?] 266 | [p2 page?]) boolean?]{ 267 | Returns @racket[#t] when @racket[p1] and @racket[p2] have the same 268 | handle and belong to the same marionette. 269 | } 270 | 271 | @defproc[(page-close! [p page?]) void?]{ 272 | Tells the browser to close @racket[p]. 273 | } 274 | 275 | @defproc[(page-refresh! [p page?]) void?]{ 276 | Tells the browser to refresh @racket[p]. 277 | } 278 | 279 | @defproc[(page-goto! [p page?] 280 | [location (or/c string? url?)]) void?]{ 281 | Navigates @racket[p] to @racket[location]. 282 | } 283 | 284 | @deftogether[ 285 | (@defproc[(page-go-back! [p page?]) void?] 286 | @defproc[(page-go-forward! [p page?]) void?])]{ 287 | Moves @racket[p] backward and forward through its history. 288 | } 289 | 290 | @defproc[(page-execute-async! [p page?] 291 | [s string?] 292 | [arg any/c] ...) jsexpr?]{ 293 | Executes the script @racket[s] on @racket[p] and returns its result. 294 | } 295 | 296 | @deftogether[ 297 | (@defproc[(page-interactive? [p page?]) boolean?] 298 | @defproc[(page-loaded? [p page?]) boolean?])]{ 299 | Ascertains the current "ready state" of @racket[p]. 300 | } 301 | 302 | @deftogether[ 303 | (@defproc[(page-title [p page?]) string?] 304 | @defproc[(page-url [p page?]) url?])]{ 305 | 306 | Accessors for @racket[p]'s title and url, respectively. 307 | } 308 | 309 | @deftogether[ 310 | (@defproc[(page-content [p page?]) string?] 311 | @defproc[(set-page-content! [p page?] 312 | [s string?]) void?])]{ 313 | Get or set @racket[p]'s HTML content. 314 | } 315 | 316 | @defproc[(page-wait-for! [p page?] 317 | [selector non-empty-string?] 318 | [#:timeout timeout (and/c real? (not/c negative?)) 30] 319 | [#:visible? visible? boolean? #t]) (or/c #f element?)]{ 320 | Waits for an element matching the given CSS @racket[selector] to 321 | appear on @racket[p] or @racket[timeout] milliseconds to pass. If 322 | @racket[visible?] is @racket[#t], then the element must be visible on 323 | the page for it to match. 324 | } 325 | 326 | @deftogether[ 327 | (@defproc[(page-query-selector! [p page?] 328 | [selector non-empty-string?]) (or/c #f element?)] 329 | @defproc[(page-query-selector-all! [p page?] 330 | [selector non-empty-string?]) (listof element?)])]{ 331 | Queries @racket[p] for either the first or all @racket[element?]s 332 | that match the given CSS selector. 333 | } 334 | 335 | @deftogether[( 336 | @defthing[cookie/c contract?] 337 | @defproc[(page-cookies [p page?]) (listof cookie/c)] 338 | @defproc[(page-add-cookie! [p page?] [c cookie/c]) void?] 339 | @defproc[(page-delete-all-cookies! [p page?]) void?] 340 | @defproc[(page-delete-cookie! [p page?] [name string?]) void?] 341 | )]{ 342 | 343 | Accessors and modifiers for a @racket[page]'s cookies. 344 | } 345 | 346 | @deftogether[ 347 | (@defproc[(page-alert-text [p page?]) string?] 348 | @defproc[(page-alert-accept! [p page?]) void?] 349 | @defproc[(page-alert-dismiss! [p page?]) void?] 350 | @defproc[(page-alert-type! [p page?] 351 | [text string?]) void?])]{ 352 | Interacts with the current prompt on @racket[p]. By default, all 353 | prompts are automatically dismissed, so you won't have anything to 354 | interact with. To change this, specify a different unhandled prompt 355 | behavior in your @tech{capabilities}. 356 | } 357 | 358 | @defproc[(page-switch-to-frame! [p page?] 359 | [e element?]) void?]{ 360 | 361 | Switch @racket[p]'s context to the given HTML frame element. 362 | } 363 | 364 | @defproc[(page-switch-to-parent-frame! [p page?]) void?]{ 365 | 366 | Switch @racket[p]'s context to the parent of the current frame. Does 367 | nothing if the current frame is the root frame. 368 | } 369 | 370 | @defproc[(call-with-page-pdf! [page page?] 371 | [proc (-> bytes? any)]) any]{ 372 | 373 | Converts the contents of @racket[page] to a PDF and passes the 374 | resulting bytes to @racket[proc]. 375 | } 376 | 377 | @defproc[(call-with-page-screenshot! [page page?] 378 | [proc (-> bytes? any)] 379 | [#:full? full? boolean? #t]) any]{ 380 | Takes a screenshot of @racket[page] and calls @racket[proc] with the 381 | resulting @racket[bytes?]. @racket[full?] determines whether or not 382 | the entire page is captured. 383 | } 384 | 385 | @defproc[(page-change-evt? [v any/c]) boolean?]{ 386 | Returns @racket[#t] when @racket[v] is a page change event. 387 | } 388 | 389 | @defproc[(page-change-evt [page page?]) (evt/c void?)]{ 390 | Returns a synchronizable event that becomes ready for synchronization 391 | when the page contents have changed (for example, when the user 392 | navigates to another page). The synchronization result of a 393 | @deftech{page change event} is @racket[void]. Once a page change 394 | event has synchronized, a new event must be created in order to 395 | observe further page changes. 396 | 397 | When selected for synchronization, a page change event spawns a 398 | background thread to poll the page for changes. The thread will run 399 | until either the event is abandoned, the page changes, or the page 400 | change event is garbage-collected. When synchronizing with a timeout, 401 | if the synchronization times out, you @emph{must} abandon the page 402 | change event before performing any further page actions to avoid 403 | concurrency issues. 404 | 405 | @history[#:added "1.4"] 406 | } 407 | 408 | @defproc[(abandon-page-change-evt [evt page-change-evt?]) void?]{ 409 | Abandons the page change event @racket[evt]. The event will stop 410 | polling after its next iteration. 411 | 412 | @history[#:added "1.5"] 413 | } 414 | 415 | @defproc[(call-with-page-change-evt [p page?] [proc (-> page-change-evt? any)]) any]{ 416 | Calls @racket[proc] with a @tech{page change event} for @racket[p], 417 | abandoning it when @racket[proc] returns or whenever control escapes 418 | the dynamic extent of the call. Whenever control re-enters the dynamic 419 | extent of a call to @racket[call-with-page-change-evt], a new page 420 | change event is created. 421 | 422 | @history[#:added "1.6"] 423 | } 424 | 425 | @subsection[#:tag "reference/element"]{Element} 426 | 427 | @deftech{Elements} represent individual elements on a specific page. 428 | They are only valid for as long as the page they were queried from 429 | active. That is, if you query an element and then navigate off the page 430 | you got it from, it becomes invalid. 431 | 432 | @defproc[(element? [e any/c]) boolean?]{ 433 | Returns @racket[#t] when @racket[e] is an @tech{element}. 434 | } 435 | 436 | @defproc[(element=? [e1 element?] 437 | [e2 element?]) boolean?]{ 438 | Returns @racket[#t] when @racket[e1] and @racket[e2] have the same 439 | handle and belong to the same page. 440 | } 441 | 442 | @defproc[(element-click! [e element?]) void?]{ 443 | Clicks on @racket[e]. 444 | } 445 | 446 | @defproc[(element-clear! [e element?]) void?]{ 447 | Clears @racket[e]'s contents if it is an HTMLInputElement. 448 | } 449 | 450 | @defproc[(element-type! [e element?] 451 | [text string?]) void]{ 452 | Types @racket[text] into @racket[e]. To type special characters, 453 | such as the ``return'' key, splice the bindings provided by the 454 | @racketmod[marionette/key] module into @racket[text]. 455 | } 456 | 457 | @deftogether[ 458 | (@defproc[(element-query-selector! [e element?] 459 | [selector non-empty-string?]) (or/c #f element?)] 460 | @defproc[(element-query-selector-all! [e element?] 461 | [selector non-empty-string?]) (listof element?)])]{ 462 | Queries @racket[e] for either the first or all @racket[element?]s 463 | belonging to it that match the given CSS selector. 464 | } 465 | 466 | @deftogether[ 467 | (@defproc[(element-enabled? [e element?]) boolean?] 468 | @defproc[(element-selected? [e element?]) boolean?] 469 | @defproc[(element-visible? [e element?]) boolean?])]{ 470 | Returns @racket[#t] if @racket[e] is enabled, selected or visible, 471 | respectively. 472 | 473 | The @racket[element-selected?] predicate only works when @racket[e] is 474 | an @tt{input} element of type @tt{checkbox} or @tt{radio}, or if it is 475 | an @tt{option} element. 476 | } 477 | 478 | @deftogether[ 479 | (@defproc[(element-tag [e element?]) string?] 480 | @defproc[(element-text [e element?]) string?] 481 | @defproc[(element-rect [e element?]) rect?])]{ 482 | Accessors for various @racket[e] fields. 483 | } 484 | 485 | @deftogether[ 486 | (@defproc[(element-attribute [e element?] 487 | [name string?]) (or/c #f string?)] 488 | @defproc[(element-property [e element?] 489 | [name string?]) (or/c #f string?)])]{ 490 | Retrieves @racket[e]'s attribute named @racket[name] statically and 491 | dynamically, respectively. 492 | } 493 | 494 | @defproc[(call-with-element-screenshot! [e element?] 495 | [p (-> bytes? any)]) any]{ 496 | Takes a screenshot of @racket[e] and calls @racket[proc] with the 497 | resulting @racket[bytes?]. 498 | } 499 | 500 | @defstruct[rect ([x real?] 501 | [y real?] 502 | [w real?] 503 | [h real?])]{ 504 | 505 | Represents an @tech{element}'s bounding client rect. 506 | } 507 | 508 | 509 | @subsection[#:tag "reference/capabilities"]{Capabilities} 510 | 511 | @deftogether[ 512 | (@defthing[page-load-strategy/c (or/c 'none 'eager 'normal)] 513 | @defthing[unhandled-prompt-behavior/c (or/c 'dismiss 514 | 'dismiss-and-notify 515 | 'accept 516 | 'accept-and-notify 517 | 'ignore)])]{ 518 | 519 | Contracts used by the functions in this module. 520 | } 521 | 522 | @deftogether[( 523 | @defstruct[ 524 | capabilities 525 | ([timeouts timeouts?] 526 | [page-load-strategy page-load-strategy/c] 527 | [unhandled-prompt-behavior unhandled-prompt-behavior/c] 528 | [accept-insecure-certs? boolean?]) 529 | #:omit-constructor 530 | ] 531 | @defproc[(make-capabilities [#:timeouts timeouts timeouts? (make-timeouts)] 532 | [#:page-load-strategy page-load-strategy page-load-strategy/c 'normal] 533 | [#:unhandled-prompt-behavior unhandled-prompt-behavior unhandled-prompt-behavior/c 'dismiss-and-notify] 534 | [#:accept-insecure-certs? accept-insecure-certs? boolean? #f]) capabilities?] 535 | )]{ 536 | 537 | Represents a session's capabilities. @deftech{Capabilities} control 538 | various settings and behaviors of the sessions created via 539 | @racket[browser-connect!]. 540 | } 541 | 542 | 543 | @subsection[#:tag "reference/timeouts"]{Timeouts} 544 | 545 | @deftogether[( 546 | @defstruct[ 547 | timeouts 548 | ([script exact-nonnegative-integer?] 549 | [page-load exact-nonnegative-integer?] 550 | [implicit exact-nonnegative-integer?]) 551 | #:omit-constructor 552 | ] 553 | @defproc[(make-timeouts [#:script script exact-nonnegative-integer? 30000] 554 | [#:page-load page-load exact-nonnegative-integer? 300000] 555 | [#:implicit implicit exact-nonnegative-integer? 0]) timeouts?] 556 | )]{ 557 | 558 | @deftech{Timeouts} let you control how long the browser will wait 559 | for various operations to finish before raising an exception. 560 | } 561 | 562 | 563 | @subsection[#:tag "reference/keys"]{Keys} 564 | @defmodule[marionette/key] 565 | 566 | This module provides bindings for special control characters that can 567 | be typed into an @tech{element} or alert. Some examples: 568 | 569 | @deftogether[( 570 | @defthing[key:backspace char?] 571 | @defthing[key:command char?] 572 | @defthing[key:control char?] 573 | @defthing[key:enter char?] 574 | @defthing[key:escape char?] 575 | @defthing[key:meta char?] 576 | @defthing[key:shift char?] 577 | @defthing[key:tab char?] 578 | )]{ 579 | 580 | Some of the bindings provided by this module. To see all of them, 581 | run the following code at a REPL: 582 | 583 | @racketblock[ 584 | (require marionette/key) 585 | (map car (call-with-values 586 | (lambda () (module->exports 'marionette/key)) 587 | (compose1 cdaar list))) 588 | ] 589 | 590 | @history[#:added "1.3"] 591 | } 592 | -------------------------------------------------------------------------------- /marionette-lib/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2019-2024 Bogdan Popa 2 | 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions are 5 | met: 6 | 7 | 1. Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | 3. Neither the name of the copyright holder nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 21 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 22 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 23 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 24 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 25 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 26 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /marionette-lib/browser.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract/base 4 | racket/match 5 | racket/string 6 | "capabilities.rkt" 7 | "page.rkt" 8 | "private/browser.rkt" 9 | "private/marionette.rkt" 10 | "timeouts.rkt") 11 | 12 | (provide 13 | (contract-out 14 | [browser? (-> any/c boolean?)] ;; noqa 15 | [browser-connect! (->* [] 16 | [#:host non-empty-string? 17 | #:port (integer-in 1 65535) 18 | #:capabilities capabilities?] 19 | browser?)] 20 | [browser-disconnect! (-> browser? void?)] 21 | [browser-timeouts (-> browser? timeouts?)] 22 | [set-browser-timeouts! (-> browser? timeouts? void?)] 23 | [browser-viewport-size (-> browser? (values exact-nonnegative-integer? 24 | exact-nonnegative-integer?))] 25 | [set-browser-viewport-size! (-> browser? exact-nonnegative-integer? exact-nonnegative-integer? void?)] 26 | [make-browser-page! (-> browser? page?)] 27 | [browser-capabilities (-> browser? capabilities?)] 28 | [browser-pages (-> browser? (listof page?))] 29 | [browser-focus! (-> browser? page? void?)])) 30 | 31 | (define (browser-connect! #:host [host "127.0.0.1"] 32 | #:port [port 2828] 33 | #:capabilities [caps (make-capabilities)]) 34 | (define m (make-marionette host port)) 35 | (marionette-connect! m caps) 36 | (browser m #f)) 37 | 38 | (define (browser-disconnect! b) 39 | (marionette-disconnect! (browser-marionette b))) 40 | 41 | (define (call-with-browser-script! b s [p values]) 42 | (sync 43 | (handle-evt 44 | (marionette-execute-script! (browser-marionette b) s) 45 | (match-lambda 46 | [(hash-table ('value value)) 47 | (p value)])))) 48 | 49 | (define (browser-timeouts b) 50 | (sync 51 | (handle-evt 52 | (marionette-get-timeouts! (browser-marionette b)) 53 | (match-lambda 54 | [(hash-table ('script script) 55 | ('pageLoad page-load) 56 | ('implicit implicit)) 57 | (timeouts script page-load implicit)])))) 58 | 59 | (define (set-browser-timeouts! b timeouts) 60 | (void 61 | (sync 62 | (marionette-set-timeouts! (browser-marionette b) 63 | (timeouts-script timeouts) 64 | (timeouts-page-load timeouts) 65 | (timeouts-implicit timeouts))))) 66 | 67 | (define (browser-viewport-size b) 68 | (call-with-browser-script! b 69 | "return [window.innerWidth, window.innerHeight]" 70 | (λ (size) 71 | (apply values size)))) 72 | 73 | (define (set-browser-viewport-size! b width height) 74 | (define-values (dx dy) 75 | (call-with-browser-script! b 76 | "return [window.outerWidth - window.innerWidth, window.outerHeight - window.innerHeight]" 77 | (λ (size) 78 | (apply values size)))) 79 | 80 | (void 81 | (sync 82 | (marionette-set-window-rect! (browser-marionette b) 83 | (+ width dx) 84 | (+ height dy))))) 85 | 86 | (define (make-browser-page! b) 87 | (sync 88 | (handle-evt 89 | (marionette-new-window! (browser-marionette b)) 90 | (lambda (res) 91 | (define p (make-page b (hash-ref res 'handle))) 92 | (begin0 p 93 | (browser-focus! b p)))))) 94 | 95 | (define (browser-capabilities b) 96 | (sync 97 | (handle-evt 98 | (marionette-get-capabilities! (browser-marionette b)) 99 | (match-lambda 100 | [(or (hash-table ['capabilities caps]) 101 | (hash-table ['value (hash-table ['capabilities caps])])) 102 | (jsexpr->capabilities caps)])))) 103 | 104 | (define (browser-pages b) 105 | (for/list ([id (in-list (sync (marionette-get-window-handles! (browser-marionette b))))]) 106 | (make-page b id))) 107 | 108 | (define (browser-focus! b p) 109 | (void (sync (marionette-switch-to-window! (browser-marionette b) (page-id p)))) 110 | (set-browser-current-page! b p)) 111 | -------------------------------------------------------------------------------- /marionette-lib/capabilities.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require json 4 | racket/contract/base 5 | "timeouts.rkt") 6 | 7 | (provide 8 | page-load-strategy/c 9 | unhandled-prompt-behavior/c 10 | 11 | (contract-out 12 | [struct capabilities ([timeouts timeouts?] 13 | [page-load-strategy page-load-strategy/c] 14 | [unhandled-prompt-behavior unhandled-prompt-behavior/c] 15 | [accept-insecure-certs? boolean?])] 16 | [make-capabilities (->* [] 17 | [#:timeouts timeouts? 18 | #:page-load-strategy page-load-strategy/c 19 | #:unhandled-prompt-behavior unhandled-prompt-behavior/c 20 | #:accept-insecure-certs? boolean?] 21 | capabilities?)] 22 | [jsexpr->capabilities (-> jsexpr? capabilities?)])) 23 | 24 | (define page-load-strategy/c 25 | (or/c 'none 'eager 'normal "none" "eager" "normal")) 26 | 27 | (define unhandled-prompt-behavior/c 28 | (or/c 'dismiss 29 | 'dimsiss-and-notify 30 | 'accept 31 | 'accept-and-notify 32 | 'ignore 33 | "dismiss" 34 | "dismiss and notify" 35 | "accept" 36 | "accept and notify" 37 | "ignore")) 38 | 39 | (struct capabilities 40 | (timeouts 41 | page-load-strategy 42 | unhandled-prompt-behavior 43 | accept-insecure-certs?) 44 | #:transparent) 45 | 46 | (define (make-capabilities #:timeouts [timeouts (make-timeouts)] 47 | #:page-load-strategy [page-load-strategy 'normal] 48 | #:unhandled-prompt-behavior [unhandled-prompt-behavior 'dismiss-and-notify] 49 | #:accept-insecure-certs? [accept-insecure-certs? #f]) 50 | (capabilities timeouts 51 | (pls->string page-load-strategy) 52 | (upb->string unhandled-prompt-behavior) 53 | accept-insecure-certs?)) 54 | 55 | (define (jsexpr->capabilities data) 56 | (define timeouts-data (hash-ref data 'timeouts)) 57 | (make-capabilities #:timeouts (make-timeouts #:script (hash-ref timeouts-data 'script) 58 | #:page-load (hash-ref timeouts-data 'pageLoad) 59 | #:implicit (hash-ref timeouts-data 'implicit)) 60 | #:page-load-strategy (hash-ref data 'pageLoadStrategy) 61 | #:unhandled-prompt-behavior (hash-ref data 'unhandledPromptBehavior) 62 | #:accept-insecure-certs? (hash-ref data 'acceptInsecureCerts))) 63 | 64 | (define (pls->string s) 65 | (if (symbol? s) (symbol->string s) s)) 66 | 67 | (define (upb->string s) 68 | (case s 69 | [(dismiss accept ignore) (symbol->string s)] 70 | [(dismiss-and-notify) "dismiss and notify"] 71 | [(accept-and-notify) "accept and notify"] 72 | [else s])) 73 | -------------------------------------------------------------------------------- /marionette-lib/element.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; For backwards-compatibility in case anyone was requring the module directly. 4 | 5 | (require racket/provide 6 | "page.rkt") 7 | 8 | (provide 9 | (filtered-out 10 | (λ (name) 11 | (and (or (regexp-match? #rx"^element" name) 12 | (regexp-match? #rx"^call-with-element" name)) 13 | name)) 14 | (all-from-out "page.rkt"))) 15 | -------------------------------------------------------------------------------- /marionette-lib/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define license 'BSD-3-Clause) 4 | (define version "1.6") 5 | (define collection "marionette") 6 | (define deps 7 | '("base" 8 | "scribble-text-lib")) 9 | -------------------------------------------------------------------------------- /marionette-lib/key.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | #|review: ignore|# 4 | 5 | (provide (prefix-out key: (all-defined-out))) 6 | 7 | (define null #\uE000) 8 | (define cancel #\uE001) 9 | (define help #\uE002) 10 | (define backspace #\uE003) 11 | (define tab #\uE004) 12 | (define clear #\uE005) 13 | (define return #\uE006) 14 | (define enter #\uE007) 15 | (define shift #\uE008) 16 | (define left-shift #\uE008) 17 | (define control #\uE009) 18 | (define left-control #\uE009) 19 | (define alt #\uE00a) 20 | (define left-alt #\uE00a) 21 | (define pause #\uE00b) 22 | (define escape #\uE00c) 23 | (define space #\uE00d) 24 | (define page-up #\uE00e) 25 | (define page-down #\uE00f) 26 | (define end #\uE010) 27 | (define home #\uE011) 28 | (define left #\uE012) 29 | (define arrow-left #\uE012) 30 | (define up #\uE013) 31 | (define arrow-up #\uE013) 32 | (define right #\uE014) 33 | (define arrow-right #\uE014) 34 | (define down #\uE015) 35 | (define arrow-down #\uE015) 36 | (define insert #\uE016) 37 | (define delete #\uE017) 38 | (define semicolon #\uE018) 39 | (define equals #\uE019) 40 | (define numpad-0 #\uE01a) 41 | (define numpad-1 #\uE01b) 42 | (define numpad-2 #\uE01c) 43 | (define numpad-3 #\uE01d) 44 | (define numpad-4 #\uE01e) 45 | (define numpad-5 #\uE01f) 46 | (define numpad-6 #\uE020) 47 | (define numpad-7 #\uE021) 48 | (define numpad-8 #\uE022) 49 | (define numpad-9 #\uE023) 50 | (define multiply #\uE024) 51 | (define add #\uE025) 52 | (define separator #\uE026) 53 | (define subtract #\uE027) 54 | (define decimal #\uE028) 55 | (define divide #\uE029) 56 | (define f1 #\uE031) 57 | (define f2 #\uE032) 58 | (define f3 #\uE033) 59 | (define f4 #\uE034) 60 | (define f5 #\uE035) 61 | (define f6 #\uE036) 62 | (define f7 #\uE037) 63 | (define f8 #\uE038) 64 | (define f9 #\uE039) 65 | (define f10 #\uE03a) 66 | (define f11 #\uE03b) 67 | (define f12 #\uE03c) 68 | (define meta #\uE03d) 69 | (define command #\uE03d) 70 | -------------------------------------------------------------------------------- /marionette-lib/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract/base 4 | racket/file 5 | racket/format 6 | racket/list 7 | racket/match 8 | racket/string 9 | racket/system 10 | racket/tcp 11 | "browser.rkt" 12 | "capabilities.rkt" 13 | "page.rkt" 14 | "private/marionette.rkt" 15 | "private/template.rkt" 16 | "rect.rkt" 17 | "timeouts.rkt") 18 | 19 | (provide 20 | exn:fail:marionette? 21 | exn:fail:marionette:command? 22 | exn:fail:marionette:command-stacktrace 23 | 24 | (contract-out 25 | [start-marionette! (->* [] 26 | [#:command absolute-path? 27 | #:profile (or/c #f absolute-path?) 28 | #:user.js (or/c #f (hash/c string? (or/c boolean? number? string?))) 29 | #:port (or/c #f (integer-in 1 65535)) 30 | #:safe-mode? boolean? 31 | #:headless? boolean? 32 | #:timeout exact-nonnegative-integer?] 33 | (-> void?))] 34 | [call-with-browser! (->* [(-> browser? any)] 35 | [#:host non-empty-string? 36 | #:port (integer-in 1 65535) 37 | #:capabilities capabilities?] 38 | any)] 39 | [call-with-page! (-> browser? (-> page? any) any)]) 40 | 41 | call-with-marionette! 42 | call-with-marionette/browser! 43 | call-with-marionette/browser/page! 44 | 45 | (all-from-out 46 | "browser.rkt" 47 | "capabilities.rkt" 48 | "page.rkt" 49 | "rect.rkt" 50 | "timeouts.rkt")) 51 | 52 | (define firefox 53 | (or (find-executable-path "firefox") 54 | (find-executable-path "firefox-bin") 55 | (for/first ([path '("/Applications/Firefox Developer Edition.app/Contents/MacOS/firefox" 56 | "/Applications/Firefox.app/Contents/MacOS/firefox")] 57 | #:when (file-exists? path)) 58 | path))) 59 | 60 | (define (start-marionette! 61 | #:command [command firefox] 62 | #:profile [profile #f] 63 | #:user.js [user.js #f] 64 | #:port [port #f] 65 | #:safe-mode? [safe-mode? #t] 66 | #:headless? [headless? #t] 67 | #:timeout [timeout 30]) 68 | (unless command 69 | (raise-user-error 70 | 'start-marionette! 71 | "could not determine path to Firefox executable~n please provide one via #:command")) 72 | 73 | (define deadline (+ (current-seconds) timeout)) 74 | (define delete-profile? (not profile)) 75 | (define profile-path (or profile (make-temporary-file "marionette~a" 'directory))) 76 | 77 | (when (or user.js port) 78 | (unless (directory-exists? profile-path) 79 | (make-directory* profile-path) 80 | (make-fresh-profile! command profile-path)) 81 | 82 | (with-output-to-file (build-path profile-path "user.js") 83 | #:exists 'truncate/replace 84 | (lambda () 85 | (display (template "support/user.js"))))) 86 | 87 | (define command-args 88 | (for/list ([arg (list "--safe-mode" "--headless")] 89 | [enabled? (list safe-mode? headless?)] 90 | #:when enabled?) 91 | arg)) 92 | 93 | (match-define (list _stdout _stdin _pid _stderr control) 94 | (parameterize ([subprocess-group-enabled #t]) 95 | (apply process* 96 | command 97 | "--profile" profile-path 98 | "--no-remote" 99 | "--marionette" 100 | command-args))) 101 | 102 | (wait-for-marionette "127.0.0.1" (or port 2828) deadline) 103 | (lambda () 104 | (sync 105 | (thread 106 | (lambda () 107 | (control 'interrupt) 108 | (control 'wait))) 109 | (handle-evt 110 | (alarm-evt (+ (current-inexact-milliseconds) 5000)) 111 | (lambda (_) 112 | (control 'kill) 113 | (control 'wait)))) 114 | (when delete-profile? 115 | (delete-directory/files profile-path)))) 116 | 117 | (define call-with-marionette! 118 | (make-keyword-procedure 119 | (lambda (kws kw-args p . args) 120 | (define stop-marionette! void) 121 | (dynamic-wind 122 | (lambda () 123 | (set! stop-marionette! (keyword-apply start-marionette! kws kw-args args))) 124 | (lambda () 125 | (p)) 126 | (lambda () 127 | (stop-marionette!)))))) 128 | 129 | (define (call-with-browser! p 130 | #:host [host "127.0.0.1"] 131 | #:port [port 2828] 132 | #:capabilities [capabilities (make-capabilities)]) 133 | (define b #f) 134 | (dynamic-wind 135 | (lambda () 136 | (parameterize-break #t 137 | (set! b (browser-connect! #:host host 138 | #:port port 139 | #:capabilities capabilities)))) 140 | (lambda () 141 | (p b)) 142 | (lambda () 143 | (browser-disconnect! b)))) 144 | 145 | (define (call-with-page! b p) 146 | (define page #f) 147 | (dynamic-wind 148 | (lambda () 149 | (set! page (make-browser-page! b))) 150 | (lambda () 151 | (p page)) 152 | (lambda () 153 | (page-close! page)))) 154 | 155 | 156 | ;; shortcuts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 157 | 158 | (define (kws-ref kws kw-args kw) 159 | (define idx (index-of kws kw)) 160 | (and idx (list-ref kw-args idx))) 161 | 162 | (define call-with-marionette/browser! 163 | (make-keyword-procedure 164 | (lambda (kws kw-args p) 165 | (define host (or (kws-ref kws kw-args '#:host) "127.0.0.1")) 166 | (define port (or (kws-ref kws kw-args '#:port) 2828)) 167 | (define p* 168 | (lambda () 169 | (call-with-browser! #:host host #:port port p))) 170 | 171 | (keyword-apply call-with-marionette! kws kw-args (list p*))))) 172 | 173 | (define call-with-marionette/browser/page! 174 | (make-keyword-procedure 175 | (lambda (kws kw-args p) 176 | (define host (or (kws-ref kws kw-args '#:host) "127.0.0.1")) 177 | (define port (or (kws-ref kws kw-args '#:port) 2828)) 178 | (define p* 179 | (lambda () 180 | (call-with-browser! 181 | #:host host 182 | #:port port 183 | (lambda (b) 184 | (call-with-page! b p))))) 185 | 186 | (keyword-apply call-with-marionette! kws kw-args (list p*))))) 187 | 188 | 189 | ;; help ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 190 | 191 | (define (make-fresh-profile! command path [timeout 5000]) 192 | (define custodian (make-custodian)) 193 | (parameterize ([current-custodian custodian] 194 | [current-subprocess-custodian-mode 'interrupt] 195 | [subprocess-group-enabled #t]) 196 | (define evt (filesystem-change-evt path)) 197 | (match-define (list _stdout _stdin _pid _stderr control) 198 | (process* command 199 | "--headless" 200 | "--profile" path 201 | "--no-remote")) 202 | 203 | (define deadline 204 | (+ (current-inexact-milliseconds) timeout)) 205 | 206 | (let loop ([evt evt]) 207 | (sync 208 | (handle-evt (alarm-evt deadline) void) 209 | (handle-evt 210 | (nack-guard-evt 211 | (λ (nack-evt) 212 | (begin0 evt 213 | (thread 214 | (λ () 215 | (sync nack-evt) 216 | (filesystem-change-evt-cancel evt)))))) 217 | (lambda (_) 218 | (define evt* (filesystem-change-evt path)) 219 | (unless (file-exists? (build-path path "prefs.js")) 220 | (loop evt*)))))) 221 | 222 | (control 'interrupt) 223 | (control 'wait)) 224 | (custodian-shutdown-all custodian)) 225 | 226 | (define (wait-for-marionette host port deadline) 227 | (define t0 (current-inexact-monotonic-milliseconds)) 228 | (let loop ([attempts 0]) 229 | (with-handlers ([exn:fail:network? 230 | (λ (e) 231 | (cond 232 | [(< (current-seconds) deadline) 233 | (define duration (min 0.5 (* 0.05 (expt 2 attempts)))) 234 | (log-marionette-debug "wait-for-marionette: retrying connect after ~s seconds" duration) 235 | (sleep duration) 236 | (loop (add1 attempts))] 237 | 238 | [else 239 | (raise e)]))]) 240 | (define-values (in out) 241 | (tcp-connect host port)) 242 | (close-input-port in) 243 | (close-output-port out) 244 | (log-marionette-debug 245 | "wait-for-marionette: connected after ~sms" 246 | (- (current-inexact-monotonic-milliseconds) t0))))) 247 | 248 | (define (~js v) 249 | (cond 250 | [(boolean? v) (if v "true" "false")] 251 | [(number? v) (~r v)] 252 | [(string? v) (~s v)] 253 | [else (raise-argument-error '~js "(or/c boolean? number? string?)" v)])) 254 | -------------------------------------------------------------------------------- /marionette-lib/page.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require file/sha1 4 | json 5 | net/base64 6 | net/url 7 | racket/contract/base 8 | racket/match 9 | racket/random 10 | racket/string 11 | "private/browser.rkt" 12 | "private/executor.rkt" 13 | "private/json.rkt" 14 | "private/marionette.rkt" 15 | "private/template.rkt" 16 | "rect.rkt") 17 | 18 | 19 | ;; page ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 20 | 21 | (provide 22 | cookie/c 23 | 24 | exn:fail:marionette:page? 25 | exn:fail:marionette:page:script? 26 | exn:fail:marionette:page:script-cause 27 | 28 | (contract-out 29 | [make-page (-> browser? string? page?)] 30 | [page? (-> any/c boolean?)] 31 | [page=? (-> page? page? boolean?)] 32 | [page-id (-> page? string?)] 33 | [page-close! (-> page? void?)] 34 | [page-refresh! (-> page? void?)] 35 | [page-goto! (-> page? (or/c url? string?) void?)] 36 | [page-go-back! (-> page? void?)] 37 | [page-go-forward! (-> page? void?)] 38 | [page-execute! (-> page? string? jsexpr? ... any/c)] 39 | [page-execute-async! (-> page? string? jsexpr? ... any/c)] 40 | [page-wait-for! (->* [page? string?] 41 | [#:timeout (and/c real? (not/c negative?)) 42 | #:visible? boolean?] 43 | (or/c #f element?))] 44 | [page-query-selector! (-> page? string? (or/c #f element?))] 45 | [page-query-selector-all! (-> page? string? (listof element?))] 46 | [page-interactive? (-> page? boolean?)] 47 | [page-loaded? (-> page? boolean?)] 48 | [page-title (-> page? string?)] 49 | [page-url (-> page? url?)] 50 | [page-content (-> page? string?)] 51 | [set-page-content! (-> page? string? void?)] 52 | [page-cookies (-> page? (listof cookie/c))] 53 | [page-add-cookie! (-> page? cookie/c void?)] 54 | [page-delete-all-cookies! (-> page? void?)] 55 | [page-delete-cookie! (-> page? string? void?)] 56 | [page-alert-text (-> page? string?)] 57 | [page-alert-accept! (-> page? void?)] 58 | [page-alert-dismiss! (-> page? void?)] 59 | [page-alert-type! (-> page? string? void?)] 60 | [page-switch-to-frame! (->* [page? element?] 61 | [boolean?] 62 | void?)] 63 | [page-switch-to-parent-frame! (-> page? void?)] 64 | [call-with-page-pdf! (-> page? (-> bytes? any) any)] 65 | [call-with-page-screenshot! (->* [page? (-> bytes? any)] 66 | [#:full? boolean?] 67 | any)])) 68 | 69 | (struct exn:fail:marionette:page exn:fail:marionette ()) 70 | (struct exn:fail:marionette:page:script exn:fail:marionette:page (cause)) 71 | 72 | (struct page (browser id)) 73 | 74 | (define (make-page b id) 75 | (page b id)) 76 | 77 | (define (page=? page-1 page-2) 78 | (and (eq? (page-browser page-1) 79 | (page-browser page-2)) 80 | (equal? (page-id page-1) 81 | (page-id page-2)))) 82 | 83 | (define (page-marionette p) 84 | (browser-marionette (page-browser p))) 85 | 86 | (define (page-focused? p) 87 | (browser-current-page=? (page-browser p) p)) 88 | 89 | (define (call-with-page p proc) ;; noqa 90 | (dynamic-wind 91 | (λ () (unless (page-focused? p) 92 | (sync/enable-break (marionette-switch-to-window! (page-marionette p) (page-id p))) 93 | (set-browser-current-page! (page-browser p) p))) 94 | (λ () (proc)) 95 | (λ () (void)))) 96 | 97 | (define-syntax-rule (with-page p e0 e ...) 98 | (call-with-page p (λ () e0 e ...))) 99 | 100 | (define (page-close! p) 101 | (with-page p 102 | (syncv (marionette-close-window! (page-marionette p))))) 103 | 104 | (define (page-refresh! p) 105 | (with-page p 106 | (syncv (marionette-refresh! (page-marionette p))))) 107 | 108 | (define (page-goto! p u) 109 | (with-page p 110 | (syncv (marionette-navigate! 111 | (page-marionette p) 112 | (if (url? u) (url->string u) u))))) 113 | 114 | (define (page-go-back! p) 115 | (with-page p 116 | (syncv (marionette-back! (page-marionette p))))) 117 | 118 | (define (page-go-forward! p) 119 | (with-page p 120 | (syncv (marionette-forward! (page-marionette p))))) 121 | 122 | (define (page-execute! p s . args) 123 | (with-page p 124 | (sync 125 | (handle-evt 126 | (marionette-execute-script! (page-marionette p) s args) 127 | res-value)))) 128 | 129 | (define (wrap-async-script body) ;; noqa 130 | (template "support/wrap-async-script.js")) 131 | 132 | (define (page-execute-async! p s . args) 133 | (with-page p 134 | (sync 135 | (handle-evt 136 | (marionette-execute-async-script! 137 | (page-marionette p) 138 | (wrap-async-script s) 139 | args) 140 | (λ (res) 141 | (match (hash-ref res 'value) 142 | [(hash-table ('error (js-null)) 143 | ('value value )) 144 | value] 145 | 146 | [(hash-table ('error err)) 147 | (raise (exn:fail:marionette:page:script 148 | (format "async script execution failed: ~a" err) 149 | (current-continuation-marks) 150 | err))] 151 | 152 | [(js-null) 153 | (raise (exn:fail:marionette:page:script 154 | "async script execution aborted" 155 | (current-continuation-marks) 156 | #f))])))))) 157 | 158 | (define (page-title p) 159 | (with-page p 160 | (sync 161 | (handle-evt 162 | (marionette-get-title! (page-marionette p)) 163 | res-value)))) 164 | 165 | (define (page-url p) 166 | (with-page p 167 | (sync 168 | (handle-evt 169 | (marionette-get-current-url! (page-marionette p)) 170 | (compose1 string->url res-value))))) 171 | 172 | (define (page-content p) 173 | (with-page p 174 | (sync 175 | (handle-evt 176 | (marionette-get-page-source! (page-marionette p)) 177 | res-value)))) 178 | 179 | (define (set-page-content! p c) 180 | (void (page-execute! p "document.documentElement.innerHTML = arguments[0]" c))) 181 | 182 | (define (page-readystate p) 183 | (page-execute! p "return document.readyState")) 184 | 185 | (define (page-interactive? p) 186 | (and (member (page-readystate p) '("interactive" "complete")) #t)) 187 | 188 | (define (page-loaded? p) 189 | (and (member (page-readystate p) '("complete")) #t)) 190 | 191 | (define cookie/c jsexpr?) 192 | 193 | (define (page-cookies p) 194 | (with-page p 195 | (sync (marionette-get-cookies! (page-marionette p))))) 196 | 197 | (define (page-add-cookie! p c) 198 | (with-page p 199 | (syncv (marionette-add-cookie! (page-marionette p) c)))) 200 | 201 | (define (page-delete-all-cookies! p) 202 | (with-page p 203 | (syncv (marionette-delete-all-cookies! (page-marionette p))))) 204 | 205 | (define (page-delete-cookie! p name) 206 | (with-page p 207 | (syncv (marionette-delete-cookie! (page-marionette p) name)))) 208 | 209 | (define wait-for-element-script 210 | (template "support/wait-for-element.js")) 211 | 212 | (define (page-wait-for! p selector 213 | #:timeout [timeout 30] 214 | #:visible? [visible? #t]) 215 | (define res-ch 216 | (make-channel)) 217 | 218 | (thread 219 | (λ () 220 | (let loop () 221 | (define handle 222 | (with-handlers ([exn:fail:marionette? 223 | (λ (e) 224 | (cond 225 | [(or (string-contains? (exn-message e) "unloaded") 226 | (string-contains? (exn-message e) "async script execution failed") 227 | (string-contains? (exn-message e) "async script execution aborted") 228 | (string-contains? (exn-message e) "context has been discarded")) 229 | (loop)] 230 | 231 | [else e]))]) 232 | (with-page p 233 | (page-execute-async! p wait-for-element-script selector (* timeout 1000) visible?)))) 234 | 235 | (if (exn:fail? handle) 236 | (channel-put res-ch handle) 237 | (channel-put 238 | res-ch 239 | (and handle (with-page p (page-query-selector! p selector)))))))) 240 | 241 | (sync/timeout 242 | timeout 243 | (handle-evt 244 | res-ch 245 | (λ (res) 246 | (begin0 res 247 | (when (exn:fail? res) 248 | (raise res))))))) 249 | 250 | (define (page-query-selector! p selector) 251 | (with-handlers ([exn:fail:marionette:command? 252 | (λ (e) 253 | (cond 254 | [(string-contains? (exn-message e) "Unable to locate element") #f] 255 | [else (raise e)]))]) 256 | (with-page p 257 | (sync 258 | (handle-evt 259 | (marionette-find-element! (page-marionette p) selector) 260 | (λ (r) 261 | (element p (res-value r)))))))) 262 | 263 | (define (page-query-selector-all! p selector) 264 | (with-page p 265 | (sync 266 | (handle-evt 267 | (marionette-find-elements! (page-marionette p) selector) 268 | (λ (ids) 269 | (for/list ([id (in-list ids)]) 270 | (element p id))))))) 271 | 272 | (define (page-alert-text p) 273 | (sync 274 | (handle-evt 275 | (marionette-get-alert-text! (page-marionette p)) 276 | res-value))) 277 | 278 | (define (page-alert-accept! p) 279 | (with-page p 280 | (syncv (marionette-accept-alert! (page-marionette p))))) 281 | 282 | (define (page-alert-dismiss! p) 283 | (with-page p 284 | (syncv (marionette-dismiss-alert! (page-marionette p))))) 285 | 286 | (define (page-alert-type! p text) 287 | (syncv (marionette-send-alert-text! (page-marionette p) text))) 288 | 289 | (define (page-switch-to-frame! p e [focus? #t]) 290 | (syncv (marionette-switch-to-frame! (page-marionette p) (element-handle e) focus?))) 291 | 292 | (define (page-switch-to-parent-frame! p) 293 | (syncv (marionette-switch-to-parent-frame! (page-marionette p)))) 294 | 295 | (define (call-with-page-pdf! p proc) 296 | (with-page p 297 | (proc 298 | (sync 299 | (handle-evt 300 | (marionette-print! (page-marionette p)) 301 | res-value/decode))))) 302 | 303 | (define (call-with-page-screenshot! p proc #:full? [full? #t]) 304 | (with-page p 305 | (proc 306 | (sync 307 | (handle-evt 308 | (marionette-take-screenshot! (page-marionette p) full?) 309 | res-value/decode))))) 310 | 311 | 312 | ;; page-change-evt ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 313 | 314 | (provide 315 | page-change-evt? 316 | page-change-evt 317 | abandon-page-change-evt 318 | call-with-page-change-evt) 319 | 320 | (struct page-change-evt (p token [abandoned? #:mutable]) 321 | #:name -page-change-evt 322 | #:constructor-name -page-change-evt 323 | #:property prop:evt 324 | (lambda (e) 325 | (match-define (-page-change-evt p token _) e) 326 | (guard-evt 327 | (lambda () 328 | (unless (page-change-evt-abandoned? e) 329 | (thread 330 | (lambda () 331 | (let loop () 332 | (unless (page-change-evt-abandoned? e) 333 | (define current (page-execute! p (template "support/get-page-change-token.js"))) 334 | (log-marionette-debug "get PageChangeToken=~a" current) 335 | (when (equal? current token) 336 | (sleep 0.05) 337 | (loop))))))))))) 338 | 339 | (define (page-change-evt p) 340 | (define token (bytes->hex-string (crypto-random-bytes 32))) 341 | (page-execute! p (template "support/set-page-change-token.js") token) 342 | (log-marionette-debug "set PageChangeToken=~s" token) 343 | (define evt (-page-change-evt p token #f)) 344 | (will-register executor evt abandon-page-change-evt) 345 | evt) 346 | 347 | (define (abandon-page-change-evt e) 348 | (set-page-change-evt-abandoned?! e #t) 349 | (sync/enable-break e)) 350 | 351 | (define (call-with-page-change-evt p proc) 352 | (define e #f) 353 | (dynamic-wind 354 | (lambda () 355 | (set! e (page-change-evt p))) 356 | (lambda () 357 | (proc e)) 358 | (lambda () 359 | (abandon-page-change-evt e)))) 360 | 361 | ;; element ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 362 | 363 | (provide 364 | (contract-out 365 | [element? (-> any/c boolean?)] 366 | [element=? (-> element? element? boolean?)] 367 | [element-click! (-> element? void?)] 368 | [element-clear! (-> element? void?)] 369 | [element-type! (-> element? string? void?)] 370 | [element-query-selector! (-> element? string? (or/c #f element?))] 371 | [element-query-selector-all! (-> element? string? (listof element?))] 372 | [element-enabled? (-> element? boolean?)] 373 | [element-selected? (-> element? boolean?)] 374 | [element-visible? (-> element? boolean?)] 375 | [element-handle (-> element? any/c)] 376 | [element-tag (-> element? string?)] 377 | [element-text (-> element? string?)] 378 | [element-rect (-> element? rect?)] 379 | [element-attribute (-> element? string? (or/c #f string?))] 380 | [element-property (-> element? string? (or/c #f string?))] 381 | [call-with-element-screenshot! (-> element? (-> bytes? any) any)])) 382 | 383 | (struct element (page handle)) 384 | 385 | (define (element=? element-1 element-2) 386 | (and (eq? (element-page element-1) 387 | (element-page element-2)) 388 | (equal? (element-handle element-1) 389 | (element-handle element-2)))) 390 | 391 | (define (element-marionette e) 392 | (page-marionette (element-page e))) 393 | 394 | (define (element-id e) 395 | (for/first ([(_ v) (in-hash (element-handle e))]) 396 | v)) 397 | 398 | (define (element-click! e) 399 | (with-page (element-page e) 400 | (syncv (marionette-element-click! (element-marionette e) (element-id e))))) 401 | 402 | (define (element-clear! e) 403 | (with-page (element-page e) 404 | (syncv (marionette-element-clear! (element-marionette e) (element-id e))))) 405 | 406 | (define (element-type! e text) 407 | (with-page (element-page e) 408 | (syncv (marionette-element-send-keys! (element-marionette e) (element-id e) text)))) 409 | 410 | (define (element-query-selector! e selector) 411 | (with-handlers ([exn:fail:marionette:command? 412 | (lambda (ex) 413 | (cond 414 | [(regexp-match? #rx"Unable to locate element" (exn-message ex)) #f] 415 | [else (raise ex)]))]) 416 | (with-page (element-page e) 417 | (sync 418 | (handle-evt 419 | (marionette-find-element! (element-marionette e) selector (element-id e)) 420 | (lambda (r) 421 | (element 422 | (element-page e) 423 | (res-value r)))))))) 424 | 425 | (define (element-query-selector-all! e selector) 426 | (define p (element-page e)) 427 | (with-page p 428 | (sync 429 | (handle-evt 430 | (marionette-find-elements! (element-marionette e) selector (element-id e)) 431 | (lambda (ids) 432 | (for/list ([id (in-list ids)]) 433 | (element p id))))))) 434 | 435 | (define (element-enabled? e) 436 | (with-page (element-page e) 437 | (sync 438 | (handle-evt 439 | (marionette-is-element-enabled! (element-marionette e) (element-id e)) 440 | res-value)))) 441 | 442 | (define (element-selected? e) 443 | (with-page (element-page e) 444 | (sync 445 | (handle-evt 446 | (marionette-is-element-selected! (element-marionette e) (element-id e)) 447 | res-value)))) 448 | 449 | (define (element-visible? e) 450 | (with-page (element-page e) 451 | (sync 452 | (handle-evt 453 | (marionette-is-element-displayed! (element-marionette e) (element-id e)) 454 | res-value)))) 455 | 456 | (define (element-tag e) 457 | (with-page (element-page e) 458 | (sync 459 | (handle-evt 460 | (marionette-get-element-tag-name! (element-marionette e) (element-id e)) 461 | res-value)))) 462 | 463 | (define (element-text e) 464 | (with-page (element-page e) 465 | (sync 466 | (handle-evt 467 | (marionette-get-element-text! (element-marionette e) (element-id e)) 468 | res-value)))) 469 | 470 | (define (element-rect e) 471 | (with-page (element-page e) 472 | (sync 473 | (handle-evt 474 | (marionette-get-element-rect! (element-marionette e) (element-id e)) 475 | (match-lambda 476 | [(hash-table ('x x) 477 | ('y y) 478 | ('width w) 479 | ('height h)) 480 | (rect x y w h)]))))) 481 | 482 | (define (element-attribute e name) 483 | (with-page (element-page e) 484 | (sync 485 | (handle-evt 486 | (marionette-get-element-attribute! (element-marionette e) (element-id e) name) 487 | (match-lambda 488 | [(hash-table ('value (js-null))) #f ] 489 | [(hash-table ('value value )) value]))))) 490 | 491 | (define (element-property e name) 492 | (with-page (element-page e) 493 | (sync 494 | (handle-evt 495 | (marionette-get-element-property! (element-marionette e) (element-id e) name) 496 | (match-lambda 497 | [(hash-table ('value (js-null))) #f] 498 | [(hash-table ('value value )) value]))))) 499 | 500 | (define (call-with-element-screenshot! e proc) 501 | (with-page (element-page e) 502 | (proc 503 | (sync 504 | (handle-evt 505 | (marionette-take-screenshot! (element-marionette e) #f (element-id e)) 506 | res-value/decode))))) 507 | 508 | 509 | ;; common ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 510 | 511 | (define syncv 512 | (compose1 void sync)) 513 | 514 | (define (res-value r) 515 | (hash-ref r 'value)) 516 | 517 | (define res-value/decode 518 | (compose1 base64-decode string->bytes/utf-8 res-value)) 519 | -------------------------------------------------------------------------------- /marionette-lib/private/browser.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide 4 | (struct-out browser) 5 | browser-current-page=?) 6 | 7 | (struct browser (marionette [current-page #:mutable])) 8 | 9 | (define (browser-current-page=? b p) 10 | (eq? (browser-current-page b) p)) 11 | -------------------------------------------------------------------------------- /marionette-lib/private/executor.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require "marionette.rkt") 4 | 5 | (provide 6 | executor) 7 | 8 | (define executor 9 | (make-will-executor)) 10 | 11 | (void 12 | (parameterize ([current-namespace (make-base-empty-namespace)]) 13 | (thread/suspend-to-kill 14 | (lambda () 15 | (let loop () 16 | (with-handlers ([exn:fail? 17 | (lambda (e) 18 | (log-marionette-error "will executor: ~a" (exn-message e)))]) 19 | (will-execute executor)) 20 | (loop)))))) 21 | -------------------------------------------------------------------------------- /marionette-lib/private/json.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (for-syntax racket/base) 4 | json 5 | racket/match) 6 | 7 | (provide 8 | json-null? 9 | js-null) 10 | 11 | (define (json-null? v) 12 | (eq? v (json-null))) 13 | 14 | (define-match-expander js-null 15 | (lambda (stx) 16 | (syntax-case stx () 17 | [(_) #'(? json-null?)]))) 18 | -------------------------------------------------------------------------------- /marionette-lib/private/marionette.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (for-syntax racket/base 4 | racket/format 5 | racket/syntax 6 | syntax/parse/pre) 7 | json 8 | racket/contract/base 9 | racket/format 10 | racket/list 11 | racket/match 12 | racket/port 13 | racket/string 14 | racket/tcp 15 | "../capabilities.rkt" 16 | "../timeouts.rkt" 17 | "json.rkt") 18 | 19 | (provide 20 | exn:fail:marionette? 21 | exn:fail:marionette 22 | 23 | exn:fail:marionette:command? 24 | exn:fail:marionette:command 25 | exn:fail:marionette:command-stacktrace 26 | 27 | (contract-out 28 | [make-marionette (-> non-empty-string? (integer-in 1 65535) marionette?)] 29 | [marionette? (-> any/c boolean?)] 30 | [marionette-connect! (-> marionette? capabilities? jsexpr?)] 31 | [marionette-disconnect! (-> marionette? void?)] 32 | [marionette-send! (-> marionette? non-empty-string? jsexpr? (evt/c jsexpr?))]) 33 | 34 | log-marionette-debug 35 | log-marionette-info 36 | log-marionette-warning 37 | log-marionette-error) 38 | 39 | 40 | ;; errors ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 41 | 42 | (struct exn:fail:marionette exn:fail ()) 43 | (struct exn:fail:marionette:command exn:fail:marionette (stacktrace)) 44 | 45 | (define (oops who fmt . args) 46 | (exn:fail:marionette 47 | (~a who ": " (apply format fmt args)) 48 | (current-continuation-marks))) 49 | 50 | 51 | ;; impl ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 52 | 53 | (define-logger marionette) 54 | 55 | (struct marionette (ch mgr)) 56 | 57 | (define (make-marionette host port) 58 | (define ch (make-channel)) 59 | (marionette ch (make-manager ch host port))) 60 | 61 | (define (marionette-connect! m c) 62 | (sync (send m connect)) 63 | (sync (marionette-new-session! m 64 | (timeouts->jsexpr (capabilities-timeouts c)) 65 | (capabilities-page-load-strategy c) 66 | (capabilities-unhandled-prompt-behavior c) 67 | (capabilities-accept-insecure-certs? c)))) 68 | 69 | (define (marionette-disconnect! m) 70 | (sync (marionette-delete-session! m)) 71 | (sync (send m disconnect))) 72 | 73 | (define (marionette-send! m command parameters) 74 | (handle-evt 75 | (send m send command parameters) 76 | (lambda (res) 77 | (begin0 res 78 | (when (exn:fail? res) 79 | (raise res)))))) 80 | 81 | (struct Waiter (nack-evt res-ch timestamp)) 82 | (struct Cmd (nack-evt res-ch)) 83 | (struct Connect Cmd (host port)) 84 | (struct Disconnect Cmd ()) 85 | (struct Reply Cmd (id)) 86 | 87 | (define (make-manager command-ch host port) 88 | (thread/suspend-to-kill 89 | (lambda () 90 | (let loop ([in #f] 91 | [out #f] 92 | [cmds null] 93 | [waiters (hasheqv)] 94 | [next-id 0]) 95 | (define connected? 96 | (and in out 97 | (not (port-closed? in)) 98 | (not (port-closed? out)))) 99 | 100 | (apply 101 | sync 102 | (handle-evt 103 | command-ch 104 | (lambda (command) 105 | (match command 106 | [`(connect ,nack-evt ,res-ch) 107 | (cond 108 | [connected? 109 | (loop in out cmds waiters next-id)] 110 | 111 | [else 112 | (define cmd (Connect nack-evt res-ch host port)) 113 | (loop in out (cons cmd cmds) waiters next-id)])] 114 | 115 | [`(disconnect ,nack-evt ,res-ch) 116 | (define cmd (Disconnect nack-evt res-ch)) 117 | (loop in out (cons cmd cmds) waiters next-id)] 118 | 119 | [`(send ,name ,params ,nack-evt ,res-ch) 120 | (cond 121 | [connected? 122 | (with-handlers ([exn:fail? 123 | (lambda (e) 124 | (log-marionette-error "failed to send command ~s~n params: ~.s~n error: ~a" name params (exn-message e)) 125 | (define cmd (Reply nack-evt res-ch e)) 126 | (loop in out (cons cmd cmds) waiters next-id))]) 127 | (define id next-id) 128 | (define ts (current-inexact-milliseconds)) 129 | (log-marionette-debug "sending command ~a~n name: ~a~n params: ~.s" id name params) 130 | (write-data (list 0 id name params) out) 131 | (loop in out cmds (hash-set waiters id (Waiter nack-evt res-ch ts)) (add1 id)))] 132 | 133 | [else 134 | (log-marionette-debug "failed to send command ~s~n params: ~.s~n error: not connected" name params) 135 | (define cmd (Reply nack-evt res-ch (oops 'command "not connected"))) 136 | (loop in out (cons cmd cmds) waiters next-id)])] 137 | 138 | [message 139 | (log-marionette-warning "invalid message: ~.s" message) 140 | (loop in out cmds waiters next-id)]))) 141 | 142 | (handle-evt 143 | (if connected? in never-evt) 144 | (lambda (p) 145 | (match (read-data p) 146 | [(? eof-object?) 147 | (log-marionette-warning "connection closed by remote") 148 | (loop #f #f cmds waiters next-id)] 149 | 150 | [`(1 ,id ,data ,(js-null)) 151 | (cond 152 | [(hash-ref waiters id #f) 153 | => (match-lambda 154 | [(Waiter nack-evt res-ch timestamp) 155 | (define duration-str (~duration (- (current-inexact-milliseconds) timestamp))) 156 | (log-marionette-debug "received error response to command ~s~n data: ~.s~n duration: ~ams" id data duration-str) 157 | (define err 158 | (exn:fail:marionette:command 159 | (hash-ref data 'message "") 160 | (current-continuation-marks) 161 | (hash-ref data 'stacktrace ""))) 162 | (define cmd (Reply nack-evt res-ch err)) 163 | (loop in out (cons cmd cmds) (hash-remove waiters id) next-id)])] 164 | 165 | [else 166 | (log-marionette-warning "received error response to unkown command ~s: ~.s" id data) 167 | (loop in out cmds waiters next-id)])] 168 | 169 | [`(1 ,id ,(js-null) ,data) 170 | (cond 171 | [(hash-ref waiters id #f) 172 | => (match-lambda 173 | [(Waiter nack-evt res-ch timestamp) 174 | (define duration-str (~duration (- (current-inexact-milliseconds) timestamp))) 175 | (log-marionette-debug "received response to command ~s~n data: ~.s~n duration: ~ams" id data duration-str) 176 | (define cmd (Reply nack-evt res-ch data)) 177 | (loop in out (cons cmd cmds) (hash-remove waiters id) next-id)])] 178 | 179 | [else 180 | (log-marionette-warning "received response to unknown command ~s: ~.s" id data) 181 | (loop in out cmds waiters next-id)])] 182 | 183 | [data 184 | (log-marionette-warning "received unexpected data: ~.s" data) 185 | (loop in out cmds waiters next-id)]))) 186 | 187 | (append 188 | (for/list ([cmd (in-list cmds)]) 189 | (match cmd 190 | [(Connect _ res-ch host port) 191 | (cond 192 | [connected? 193 | (handle-evt 194 | (channel-put-evt res-ch (oops 'connect "already connected")) 195 | (lambda (_) 196 | (loop in out (remq cmd cmds) waiters next-id)))] 197 | 198 | [else 199 | (with-handlers ([exn:fail? 200 | (lambda (e) 201 | (handle-evt 202 | (channel-put-evt res-ch e) 203 | (lambda (_) 204 | (loop #f #f (remq cmd cmds) waiters next-id))))]) 205 | (let-values ([(in out) (tcp-connect host port)]) 206 | (log-marionette-debug "connected to ~a:~a" host port) 207 | (define preamble (read-data in)) 208 | (cond 209 | [(eof-object? preamble) 210 | (define err (oops 'connect "the other end hung up")) 211 | (sync/timeout 0 (channel-put-evt res-ch err)) 212 | (loop #f #f (remq cmd cmds) waiters next-id)] 213 | 214 | [(and (equal? (hash-ref preamble 'applicationType #f) "gecko") 215 | (equal? (hash-ref preamble 'marionetteProtocol #f) 3)) 216 | (sync/timeout 0 (channel-put-evt res-ch (void))) 217 | (loop in out (remq cmd cmds) waiters next-id)] 218 | 219 | [else 220 | (close-input-port in) 221 | (close-output-port out) 222 | (define err (oops 'connect "the other end doesn't implement the v3 marionette protocol")) 223 | (sync/timeout 0 (channel-put-evt res-ch err)) 224 | (loop #f #f (remq cmd cmds) waiters next-id)])))])] 225 | 226 | [(Disconnect _ res-ch) 227 | (handle-evt 228 | (channel-put-evt res-ch (void)) 229 | (lambda (_) 230 | (when connected? 231 | (close-input-port in) 232 | (close-output-port out)) 233 | (loop #f #f (remq cmd cmds) waiters next-id)))] 234 | 235 | [(Reply _ res-ch rep) 236 | (handle-evt 237 | (channel-put-evt res-ch rep) 238 | (lambda (_) 239 | (loop in out (remq cmd cmds) waiters next-id)))])) 240 | (for/list ([cmd (in-list cmds)]) 241 | (handle-evt 242 | (Cmd-nack-evt cmd) 243 | (lambda (_) 244 | (loop in out (remq cmd cmds) waiters next-id)))))))))) 245 | 246 | (define (~duration ms) 247 | (~r ms #:precision '(= 2))) 248 | 249 | (define (send* m cmd . args) 250 | (handle-evt 251 | (nack-guard-evt 252 | (lambda (nack-evt) 253 | (define res-ch (make-channel)) 254 | (begin0 res-ch 255 | (thread-resume (marionette-mgr m) (current-thread)) 256 | (channel-put (marionette-ch m) `(,cmd ,@args ,nack-evt ,res-ch))))) 257 | (lambda (msg) 258 | (begin0 msg 259 | (when (exn:fail? msg) 260 | (raise msg)))))) 261 | 262 | (define-syntax-rule (send who cmd arg ...) 263 | (send* who 'cmd arg ...)) 264 | 265 | (define (read-data in) 266 | (match (regexp-match #rx"([1-9][0-9]*):" in) 267 | [`(,_ ,len-str) 268 | (define len (string->number (bytes->string/utf-8 len-str))) 269 | (read-json (make-limited-input-port in len #f))] 270 | 271 | [#f eof])) 272 | 273 | (define (write-data data out) 274 | (define data-bs (jsexpr->bytes data)) 275 | (write-string (number->string (bytes-length data-bs)) out) 276 | (write-bytes #":" out) 277 | (write-bytes data-bs out) 278 | (flush-output out)) 279 | 280 | 281 | ;; commands ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 282 | 283 | (define missing (gensym 'missing)) 284 | (define (missing? v) 285 | (eq? missing v)) 286 | 287 | (define-syntax (define-marionette-command stx) 288 | (define (make-command-name stx name) 289 | (define name:str (symbol->string name)) 290 | (define normalized-name 291 | (string-downcase 292 | (regexp-replace* #rx"[A-Z]+" name:str (λ (s) (~a "-" s))))) 293 | (format-id 294 | #;lctx stx 295 | #;fmt "marionette~a!" 296 | #;... (regexp-replace #rx"[^:]*:" normalized-name "") 297 | #:source stx)) 298 | 299 | (define-syntax-class param 300 | (pattern name:id #:with spec #'name) 301 | (pattern [name:id] #:with spec #'(name missing)) 302 | (pattern [name:id default:expr] #:with spec #'(name default))) 303 | 304 | (syntax-parse stx 305 | [(_ (command-name:id param:param ...)) 306 | (with-syntax ([name (make-command-name #'command-name (syntax-e #'command-name))] 307 | [command-name:str (symbol->string (syntax-e #'command-name))] 308 | [(command-param ...) (map 309 | (lambda (key name) 310 | #`(cons #,key #,name)) 311 | (syntax-e #'('param.name ...)) 312 | (syntax-e #'(param.name ...)))]) 313 | (syntax/loc stx 314 | (begin 315 | (define (name m param.spec ...) 316 | (marionette-send! m 317 | command-name:str 318 | (make-immutable-hasheq 319 | (filter-map 320 | (lambda (pair) 321 | (cond 322 | [(missing? (cdr pair)) #f] 323 | [else pair])) 324 | (list command-param ...))))) 325 | (provide name))))])) 326 | 327 | ;; Supported commands can be found here: 328 | ;; https://searchfox.org/mozilla-central/source/testing/marionette/driver.js#3570 329 | (define-marionette-command (WebDriver:AcceptAlert)) 330 | (define-marionette-command (WebDriver:AddCookie cookie)) 331 | (define-marionette-command (WebDriver:Back)) 332 | (define-marionette-command (WebDriver:CloseChromeWindow)) 333 | (define-marionette-command (WebDriver:CloseWindow)) 334 | (define-marionette-command (WebDriver:DeleteAllCookies)) 335 | (define-marionette-command (WebDriver:DeleteCookie name)) 336 | (define-marionette-command (WebDriver:DeleteSession)) 337 | (define-marionette-command (WebDriver:DismissAlert)) 338 | (define-marionette-command (WebDriver:ElementClear id)) 339 | (define-marionette-command (WebDriver:ElementClick id)) 340 | (define-marionette-command (WebDriver:ElementSendKeys id text)) 341 | (define-marionette-command (WebDriver:ExecuteAsyncScript script [args null])) 342 | (define-marionette-command (WebDriver:ExecuteScript script [args null])) 343 | (define-marionette-command (WebDriver:FindElement value [element] [using "css selector"])) 344 | (define-marionette-command (WebDriver:FindElements value [element] [using "css selector"])) 345 | (define-marionette-command (WebDriver:Forward)) 346 | (define-marionette-command (WebDriver:FullscreenWindow)) 347 | (define-marionette-command (WebDriver:GetActiveElement)) 348 | (define-marionette-command (WebDriver:GetAlertText)) 349 | (define-marionette-command (WebDriver:GetCapabilities)) 350 | (define-marionette-command (WebDriver:GetChromeWindowHandle)) 351 | (define-marionette-command (WebDriver:GetChromeWindowHandles)) 352 | (define-marionette-command (WebDriver:GetCookies)) 353 | (define-marionette-command (WebDriver:GetCurrentChromeWindowHandle)) 354 | (define-marionette-command (WebDriver:GetCurrentURL)) 355 | (define-marionette-command (WebDriver:GetElementAttribute id name)) 356 | (define-marionette-command (WebDriver:GetElementCSSValue id propertyName)) 357 | (define-marionette-command (WebDriver:GetElementProperty id name)) 358 | (define-marionette-command (WebDriver:GetElementRect id)) 359 | (define-marionette-command (WebDriver:GetElementTagName id)) 360 | (define-marionette-command (WebDriver:GetElementText id)) 361 | (define-marionette-command (WebDriver:GetPageSource)) 362 | (define-marionette-command (WebDriver:GetTimeouts)) 363 | (define-marionette-command (WebDriver:GetTitle)) 364 | (define-marionette-command (WebDriver:GetWindowHandle)) 365 | (define-marionette-command (WebDriver:GetWindowHandles)) 366 | (define-marionette-command (WebDriver:GetWindowRect)) 367 | (define-marionette-command (WebDriver:IsElementDisplayed id)) 368 | (define-marionette-command (WebDriver:IsElementEnabled id)) 369 | (define-marionette-command (WebDriver:IsElementSelected id)) 370 | (define-marionette-command (WebDriver:MaximizeWindow)) 371 | (define-marionette-command (WebDriver:MinimizeWindow)) 372 | (define-marionette-command (WebDriver:Navigate url)) 373 | (define-marionette-command (WebDriver:NewSession [timeouts] [pageLoadStrategy] [unhandledPromptBehavior] [acceptInsecureCerts])) 374 | (define-marionette-command (WebDriver:NewWindow [focus #t] [private #f] [type "tab"])) 375 | (define-marionette-command (WebDriver:PerformActions actions)) 376 | (define-marionette-command (WebDriver:Print)) 377 | (define-marionette-command (WebDriver:Refresh)) 378 | (define-marionette-command (WebDriver:ReleaseActions)) 379 | (define-marionette-command (WebDriver:SendAlertText text)) 380 | (define-marionette-command (WebDriver:SetTimeouts script pageLoad implicit)) 381 | (define-marionette-command (WebDriver:SetWindowRect width height)) 382 | (define-marionette-command (WebDriver:Status)) 383 | (define-marionette-command (WebDriver:SwitchToFrame id [focus #t])) 384 | (define-marionette-command (WebDriver:SwitchToParentFrame)) 385 | (define-marionette-command (WebDriver:SwitchToShadowRoot id)) 386 | (define-marionette-command (WebDriver:SwitchToWindow handle [focus #t])) 387 | (define-marionette-command (WebDriver:TakeScreenshot full [id] [hash #f])) 388 | -------------------------------------------------------------------------------- /marionette-lib/private/template.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/port 4 | scribble/text) 5 | 6 | (provide 7 | template in) 8 | 9 | (define-syntax-rule (template path) 10 | (with-output-to-string 11 | (lambda () 12 | (output (include/text path))))) 13 | 14 | (define-syntax in 15 | (syntax-rules () 16 | [(_ x xs e ...) 17 | (add-newlines 18 | (for/list ([x xs]) 19 | (begin/text e ...)))])) 20 | -------------------------------------------------------------------------------- /marionette-lib/rect.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract/base) 4 | 5 | (provide 6 | (contract-out 7 | [struct rect ([x real?] 8 | [y real?] 9 | [w real?] 10 | [h real?])])) 11 | 12 | (struct rect (x y w h) 13 | #:transparent) 14 | -------------------------------------------------------------------------------- /marionette-lib/support/get-page-change-token.js: -------------------------------------------------------------------------------- 1 | return (window.$$marionette || {}).PageChangeToken; 2 | -------------------------------------------------------------------------------- /marionette-lib/support/set-page-change-token.js: -------------------------------------------------------------------------------- 1 | const Marionette = window.$$marionette || {}; 2 | if (Marionette.PageChangeToken === undefined) { 3 | Marionette.PageChangeToken = arguments[0]; 4 | if (Marionette.patchedHistory === undefined) { 5 | Marionette.patchedHistory = true; 6 | for (const method of ["pushState", "replaceState"]) { 7 | window.history[method] = new Proxy(window.history[method], { 8 | apply: (target, self, args) => { 9 | delete Marionette["PageChangeToken"]; 10 | return target.apply(self, args); 11 | }, 12 | }); 13 | } 14 | } 15 | } 16 | window.$$marionette = Marionette; 17 | -------------------------------------------------------------------------------- /marionette-lib/support/user.js: -------------------------------------------------------------------------------- 1 | user_pref("marionette.port", @(or port 2828)); 2 | user_pref("browser.startup.homepage_override.mstone", "ignore"); 3 | user_pref("datareporting.policy.firstRunURL", ""); 4 | 5 | @in[(k v) (in-hash (or user.js (hash)))]{ 6 | user_pref(@~s[k], @~js[v]); 7 | } 8 | -------------------------------------------------------------------------------- /marionette-lib/support/wait-for-element.js: -------------------------------------------------------------------------------- 1 | const [selector, timeout, mustBeVisible] = arguments; 2 | 3 | let node; 4 | let resolve; 5 | let observer; 6 | const res = new Promise(r => resolve = function(res) { 7 | observer && observer.disconnect(); 8 | return r(res); 9 | }); 10 | 11 | window.setTimeout(function() { 12 | return resolve(false); 13 | }, timeout); 14 | 15 | bootstrap(); 16 | return res; 17 | 18 | function bootstrap() { 19 | if (node = findNode()) { 20 | return resolve(node); 21 | } 22 | 23 | observer = new MutationObserver(() => { 24 | if (node = findNode()) { 25 | return resolve(node); 26 | } 27 | }); 28 | 29 | observer.observe(document.body, { 30 | subtree: true, 31 | childList: true, 32 | attributes: true, 33 | }); 34 | 35 | return res; 36 | } 37 | 38 | function isVisible(node) { 39 | const { visibility } = window.getComputedStyle(node) || {}; 40 | const { top, bottom, width, height } = node.getBoundingClientRect(); 41 | return visibility !== "hidden" && top && bottom && width && height; 42 | } 43 | 44 | function findNode() { 45 | const node = document.querySelector(selector); 46 | if (node && (mustBeVisible && isVisible(node) || !mustBeVisible)) { 47 | return node; 48 | } 49 | 50 | return null; 51 | } 52 | -------------------------------------------------------------------------------- /marionette-lib/support/wrap-async-script.js: -------------------------------------------------------------------------------- 1 | const args = Array.prototype.slice.call(arguments, 0, arguments.length - 1); 2 | const resolve = arguments[arguments.length - 1]; 3 | 4 | Promise 5 | .resolve() 6 | .then(() => (function() { @body })(...args)) 7 | .then((value) => resolve({ error: null, value })) 8 | .catch((error) => resolve({ error: error instanceof Error ? error.message : error, value: null })); 9 | -------------------------------------------------------------------------------- /marionette-lib/timeouts.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require json 4 | racket/contract/base) 5 | 6 | (provide 7 | (contract-out 8 | [struct timeouts ([script exact-nonnegative-integer?] 9 | [page-load exact-nonnegative-integer?] 10 | [implicit exact-nonnegative-integer?])] 11 | [make-timeouts (->* [] 12 | [#:script exact-nonnegative-integer? 13 | #:page-load exact-nonnegative-integer? 14 | #:implicit exact-nonnegative-integer?] 15 | timeouts?)] 16 | [timeouts->jsexpr (-> timeouts? jsexpr?)])) 17 | 18 | (struct timeouts (script page-load implicit) 19 | #:transparent) 20 | 21 | (define (make-timeouts #:script [script 30000] 22 | #:page-load [page-load 300000] 23 | #:implicit [implicit 0]) 24 | (timeouts script page-load implicit)) 25 | 26 | (define (timeouts->jsexpr t) 27 | (hasheq 'script (timeouts-script t) 28 | 'pageLoad (timeouts-page-load t) 29 | 'implicit (timeouts-implicit t))) 30 | -------------------------------------------------------------------------------- /marionette-test/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2019-2024 Bogdan Popa 2 | 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions are 5 | met: 6 | 7 | 1. Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | 3. Neither the name of the copyright holder nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 19 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 20 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 21 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 22 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 23 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 24 | TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 25 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 26 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 27 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 28 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /marionette-test/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define license 'BSD-3-Clause) 4 | (define collection 'multi) 5 | (define deps '()) 6 | (define build-deps '("base" 7 | "marionette-lib" 8 | "rackunit-lib")) 9 | (define update-implies '("marionette-lib")) 10 | -------------------------------------------------------------------------------- /marionette-test/tests/marionette/integration/browser.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require marionette 4 | rackunit 5 | "common.rkt") 6 | 7 | (provide 8 | browser-tests) 9 | 10 | (define browser-tests 11 | (test-suite 12 | "browser" 13 | 14 | (test-suite 15 | "browser-{dis,}connect!" 16 | 17 | (test-case "can successfully connect and disconnect from a browser" 18 | (define b (browser-connect!)) 19 | (browser-disconnect! b))) 20 | 21 | (test-suite 22 | "{set-,}browser-timeouts" 23 | 24 | (test-case "can set and retrieve timeouts" 25 | (call-with-browser! 26 | (lambda (b) 27 | (set-browser-timeouts! b (make-timeouts #:script 30000 28 | #:page-load 300000)) 29 | 30 | (define t (browser-timeouts b)) 31 | (check-eq? (timeouts-script t) 30000) 32 | (check-eq? (timeouts-page-load t) 300000) 33 | (check-eq? (timeouts-implicit t) 0))))) 34 | 35 | (test-suite 36 | "browser-viewport-size" 37 | 38 | (test-case "can retrieve the viewport size" 39 | (call-with-browser! 40 | (lambda (b) 41 | (define-values (w h) 42 | (browser-viewport-size b)) 43 | 44 | (check-true (> w 0)) 45 | (check-true (> h 0)))))) 46 | 47 | (test-suite 48 | "set-browser-viewport-size!" 49 | 50 | (test-case "can set the viewport size" 51 | (call-with-browser! 52 | (lambda (b) 53 | (set-browser-viewport-size! b 1400 900) 54 | (let-values ([(w h) (browser-viewport-size b)]) 55 | (check-eq? w 1400) 56 | (check-eq? h 900)) 57 | 58 | (set-browser-viewport-size! b 1920 1080) 59 | (let-values ([(w h) (browser-viewport-size b)]) 60 | (check-eq? w 1920) 61 | (check-eq? h 1080)))))) 62 | 63 | (test-suite 64 | "browser-capabilities" 65 | 66 | (test-case "can set and get capabilities" 67 | (define caps (make-capabilities #:page-load-strategy "none" 68 | #:unhandled-prompt-behavior "ignore")) 69 | (call-with-browser! 70 | #:capabilities caps 71 | (lambda (b) 72 | (check-equal? (browser-capabilities b) caps))))) 73 | 74 | (test-suite 75 | "browser-pages" 76 | 77 | (test-case "can list existing pages" 78 | (call-with-browser! 79 | (lambda (b) 80 | (check-true (> (length (browser-pages b)) 0)))))) 81 | 82 | (test-suite 83 | "make-browser-page!" 84 | 85 | (test-case "can create new pages" 86 | (call-with-browser! 87 | (lambda (b) 88 | (check-not-false (make-browser-page! b)))))))) 89 | 90 | (module+ test 91 | (run-integration-tests browser-tests)) 92 | -------------------------------------------------------------------------------- /marionette-test/tests/marionette/integration/common.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require marionette 4 | rackunit/text-ui) 5 | 6 | (provide 7 | run-integration-tests) 8 | 9 | (define (run-integration-tests . args) 10 | (when (equal? (getenv "MARIONETTE_INTEGRATION_TESTS") "x") 11 | (call-with-marionette! 12 | #:timeout 60 13 | (lambda () 14 | (apply run-tests args))))) 15 | -------------------------------------------------------------------------------- /marionette-test/tests/marionette/integration/element.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require marionette 4 | net/url 5 | rackunit 6 | "common.rkt") 7 | 8 | (provide 9 | element-tests) 10 | 11 | (define element-tests 12 | (test-suite 13 | "element" 14 | 15 | (test-suite 16 | "element-click!" 17 | 18 | (test-case "can click on an element" 19 | (call-with-browser! 20 | (lambda (b) 21 | (call-with-page! b 22 | (lambda (p) 23 | (set-page-content! p "click me") 24 | (define e (page-query-selector! p "a")) 25 | (element-click! e) 26 | (check-equal? (page-url p) (string->url "https://example.com/")))))))) 27 | 28 | (test-suite 29 | "element-type!" 30 | 31 | (test-case "can type inside an element" 32 | (call-with-browser! 33 | (lambda (b) 34 | (call-with-page! b 35 | (lambda (p) 36 | (set-page-content! p "") 37 | (define e (page-query-selector! p "input")) 38 | (element-type! e "hello") 39 | (check-equal? (element-property e "value") "hello"))))))) 40 | 41 | (test-suite 42 | "element-query-selector!" 43 | 44 | (test-case "can fail to retrieve nonexistent elements" 45 | (call-with-browser! 46 | (lambda (b) 47 | (call-with-page! b 48 | (lambda (p) 49 | (set-page-content! p "

Hello!") 50 | (define e (page-query-selector! p "h1")) 51 | (check-false (element-query-selector! e ".idontexist"))))))) 52 | 53 | (test-case "can retrieve elements' children" 54 | (call-with-browser! 55 | (lambda (b) 56 | (call-with-page! b 57 | (lambda (p) 58 | (set-page-content! p "

An anchor: example") 59 | (define e (page-query-selector! p "h1")) 60 | (check-not-false (element-query-selector! e "a")))))))) 61 | 62 | (test-suite 63 | "element-query-selector-all!" 64 | 65 | (test-case "can fail to retrieve any elements" 66 | (call-with-browser! 67 | (lambda (b) 68 | (call-with-page! b 69 | (lambda (p) 70 | (set-page-content! p "

Hi!") 71 | (define e (page-query-selector! p "h1")) 72 | (check-equal? (element-query-selector-all! e ".idontexist") null)))))) 73 | 74 | (test-case "can retrieve elements' children" 75 | (call-with-browser! 76 | (lambda (b) 77 | (call-with-page! b 78 | (lambda (p) 79 | (set-page-content! p "

An anchor: example") 80 | (define e (page-query-selector! p "h1")) 81 | (check-equal? (length (element-query-selector-all! e "a")) 1))))))) 82 | 83 | (test-suite 84 | "element-enabled?" 85 | 86 | (test-case "returns #f if an element is disabled" 87 | (call-with-browser! 88 | (lambda (b) 89 | (call-with-page! b 90 | (lambda (p) 91 | (set-page-content! p "") 92 | (define e (page-query-selector! p "input")) 93 | (check-false (element-enabled? e))))))) 94 | 95 | (test-case "returns #t if an element is enabled" 96 | (call-with-browser! 97 | (lambda (b) 98 | (call-with-page! b 99 | (lambda (p) 100 | (set-page-content! p "

Hello") 101 | (define e (page-query-selector! p "h1")) 102 | (check-true (element-enabled? e)))))))) 103 | 104 | (test-suite 105 | "element-selected?" 106 | 107 | (test-case "returns #f if an element is not selected" 108 | (call-with-browser! 109 | (lambda (b) 110 | (call-with-page! b 111 | (lambda (p) 112 | (set-page-content! p "") 113 | (define e (page-query-selector! p "input")) 114 | (check-false (element-selected? e))))))) 115 | 116 | (test-case "returns #t if an element is selected" 117 | (call-with-browser! 118 | (lambda (b) 119 | (call-with-page! b 120 | (lambda (p) 121 | (set-page-content! p "") 122 | (define e (page-query-selector! p "input")) 123 | (element-click! e) 124 | (check-true (element-selected? e)))))))) 125 | 126 | (test-suite 127 | "element-visible?" 128 | 129 | (test-case "returns #f if an element is invisible" 130 | (call-with-browser! 131 | (lambda (b) 132 | (call-with-page! b 133 | (lambda (p) 134 | (set-page-content! p "

Hello!") 135 | (define e (page-query-selector! p "h1")) 136 | (check-false (element-visible? e))))))) 137 | 138 | (test-case "returns #t if an element is visible" 139 | (call-with-browser! 140 | (lambda (b) 141 | (call-with-page! b 142 | (lambda (p) 143 | (set-page-content! p "

Hello") 144 | (define e (page-query-selector! p "h1")) 145 | (check-true (element-visible? e)))))))) 146 | 147 | (test-suite 148 | "element-tag" 149 | 150 | (test-case "can retrieve an element's tag" 151 | (call-with-browser! 152 | (lambda (b) 153 | (call-with-page! b 154 | (lambda (p) 155 | (set-page-content! p "

Hello") 156 | (define e (page-query-selector! p "h1")) 157 | (check-equal? (element-tag e) "h1"))))))) 158 | 159 | (test-suite 160 | "element-attribute" 161 | 162 | (test-case "can fail to retrieve nonexistent attributes" 163 | (call-with-browser! 164 | (lambda (b) 165 | (call-with-page! b 166 | (lambda (p) 167 | (set-page-content! p "a link") 168 | (define e (page-query-selector! p "a")) 169 | (check-false (element-attribute e "href"))))))) 170 | 171 | (test-suite 172 | "element-text" 173 | 174 | (test-case "can retrieve an element's inner text" 175 | (call-with-browser! 176 | (lambda (b) 177 | (call-with-page! b 178 | (lambda (p) 179 | (set-page-content! p "

Hello") 180 | (define e (page-query-selector! p "h1")) 181 | (check-equal? (element-text e) "Hello"))))))) 182 | 183 | (test-case "can retrieve an existing attribute" 184 | (call-with-browser! 185 | (lambda (b) 186 | (call-with-page! b 187 | (lambda (p) 188 | (set-page-content! p "a link") 189 | (define e (page-query-selector! p "a")) 190 | (check-equal? (element-attribute e "href") "https://example.com"))))))) 191 | 192 | (test-suite 193 | "element-rect" 194 | 195 | (test-case "can retrieve an element's bounding rect" 196 | (call-with-browser! 197 | (lambda (b) 198 | (call-with-page! b 199 | (lambda (p) 200 | (set-page-content! p "

Hello") 201 | (define e (page-query-selector! p "h1")) 202 | (check-true (rect? (element-rect e))))))))) 203 | 204 | (test-suite 205 | "call-with-element-screenshot!" 206 | 207 | (test-case "can screenshot elements on a page" 208 | (call-with-browser! 209 | (lambda (b) 210 | (call-with-page! b 211 | (lambda (p) 212 | (page-goto! p "https://example.com") 213 | (define e (page-query-selector! p "h1")) 214 | (call-with-element-screenshot! e 215 | (lambda (data) 216 | (check-true (> (bytes-length data) 0)))))))))))) 217 | 218 | (module+ test 219 | (run-integration-tests element-tests)) 220 | -------------------------------------------------------------------------------- /marionette-test/tests/marionette/integration/page.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require marionette 4 | net/url 5 | racket/string 6 | rackunit 7 | "common.rkt") 8 | 9 | (provide 10 | page-tests) 11 | 12 | (define page-tests 13 | (test-suite 14 | "page" 15 | 16 | (test-suite 17 | "page-close!" 18 | 19 | (test-case "can close pages" 20 | (call-with-browser! 21 | (lambda (b) 22 | (define p (make-browser-page! b)) 23 | (check-not-false (member p (browser-pages b) page=?)) 24 | (page-close! p) 25 | (check-false (member p (browser-pages b) page=?)))))) 26 | 27 | (test-suite 28 | "page-refresh!" 29 | 30 | (test-case "can refresh the current page" 31 | (call-with-browser! 32 | (lambda (b) 33 | (call-with-page! b 34 | (lambda (p) 35 | (page-refresh! p))))))) 36 | 37 | (test-suite 38 | "page-goto!" 39 | 40 | (test-case "can navigate to urls" 41 | (call-with-browser! 42 | (lambda (b) 43 | (call-with-page! b 44 | (lambda (p) 45 | (page-goto! p "https://example.com") 46 | (check-equal? (page-title p) "Example Domain") 47 | (check-equal? (page-url p) (string->url "https://example.com/")))))))) 48 | 49 | (test-suite 50 | "page-execute-async!" 51 | 52 | (test-case "can execute asynchronous scripts" 53 | (call-with-browser! 54 | (lambda (b) 55 | (call-with-page! b 56 | (lambda (p) 57 | (define val 58 | (page-execute-async! p #<