cleanup
parent
24cf53329d
commit
fa733853c3
|
|
@ -1,5 +1,7 @@
|
|||
USING: kernel http http.client http.server io.sockets io.streams.byte-array io.pathnames io.encodings.binary io.encodings.string io.encodings.utf8 io.launcher accessors urls parser effects.parser words arrays sequences quotations json.reader json.writer formatting assocs namespaces present hashtables words.symbol combinators lexer calendar prettyprint.backend base64 images.png destructors math.parser threads continuations ;
|
||||
USING: kernel accessors urls parser effects.parser words arrays sequences quotations json formatting assocs namespaces present hashtables words.symbol combinators lexer calendar prettyprint.backend base64 images.png destructors math.parser threads continuations ;
|
||||
USING: http http.client http.server ;
|
||||
USING: libc classes ;
|
||||
USING: io io.sockets io.streams.byte-array io.pathnames io.encodings.binary io.encodings.string io.encodings.utf8 io.launcher ;
|
||||
|
||||
USING: prettyprint ;
|
||||
|
||||
|
|
@ -16,7 +18,7 @@ CONSTANT: xpath-location-strategy "xpath"
|
|||
|
||||
SYMBOLS: current-web-driver current-web-driver-session ;
|
||||
|
||||
TUPLE: web-driver remote-url process ;
|
||||
TUPLE: web-driver process remote-url ;
|
||||
TUPLE: web-driver-session session-id capabilities ;
|
||||
TUPLE: session-status message ready? ;
|
||||
|
||||
|
|
@ -73,10 +75,15 @@ TUPLE: session-status message ready? ;
|
|||
|
||||
! Capabilities
|
||||
! https://www.w3.org/webdriver/#capabilities
|
||||
TUPLE: capabilities { always-match hashtable } { first-match hashtable } ;
|
||||
TUPLE: capabilities { always-match hashtable } { first-match sequence } ;
|
||||
|
||||
: <capabilities> ( always-match first-match -- capabilities )
|
||||
[ [ H{ } ] unless* ] bi@ capabilities boa ;
|
||||
[ [ H{ } ] unless* ]
|
||||
[ [ { } ] unless* ] bi*
|
||||
capabilities boa ;
|
||||
|
||||
: <no-capabilities> ( -- capabilities )
|
||||
f f <capabilities> ;
|
||||
|
||||
: capabilities>json ( capabilities -- string )
|
||||
[ always-match>> ] [ first-match>> ] bi
|
||||
|
|
@ -84,9 +91,8 @@ TUPLE: capabilities { always-match hashtable } { first-match hashtable } ;
|
|||
|
||||
: <headless-firefox-capabilities> ( -- hash )
|
||||
H{
|
||||
{ "browserName" "firefox" }
|
||||
{ "moz:firefoxOptions" { "args" { "-headless" } } }
|
||||
} ;
|
||||
{ "moz:firefoxOptions" H{ { "args" { "-headless" } } } }
|
||||
} f <capabilities> capabilities>json ;
|
||||
|
||||
! Timeouts
|
||||
! https://www.w3.org/TR/webdriver/#timeouts
|
||||
|
|
@ -249,32 +255,44 @@ TUPLE: rect x y width height ;
|
|||
: execute-async-script ( script arguments -- return )
|
||||
'H{ { "script" _ } { "args" _ } } "execute/async" <session-post-request> http-web-driver-request ;
|
||||
|
||||
! cooHkies
|
||||
! cookies
|
||||
|
||||
! TODO: samesite?
|
||||
TUPLE: cookie name value path domain secure? http-only? expiry same-site ;
|
||||
|
||||
: web-driver-cookie>cookie ( hashtable -- cookie )
|
||||
: parse-cookie ( hashtable -- cookie )
|
||||
{
|
||||
[ "name" of ] [ "value" of f f ] [ "path" of ] [ "domain" of ]
|
||||
[ "expiry" of f swap unix-time>timestamp ] [ "httpOnly" of ] [ "secure" of ]
|
||||
[ "name" of ]
|
||||
[ "value" of ]
|
||||
[ "path" of [ "/" ] unless* ]
|
||||
[ "domain" of ]
|
||||
[ "secure" of ]
|
||||
[ "httpOnly" of ]
|
||||
[ "expiry" of [ unix-time>timestamp ] [ f ] if* ]
|
||||
[ "sameSite" of ]
|
||||
} cleave cookie boa ;
|
||||
|
||||
: cookie>web-driver-cookie ( cookie -- hashtable )
|
||||
tuple>assoc >hashtable [
|
||||
[ "httpOnly" "http-only" rot rename-at ]
|
||||
[ "expiry" "max-age" rot rename-at ] bi
|
||||
] keep ;
|
||||
{
|
||||
[ "secure" "secure?" rot rename-at ]
|
||||
[ "httpOnly" "http-only?" rot rename-at ]
|
||||
[ "sameSite" "same-site" rot rename-at ]
|
||||
} cleave
|
||||
] keep 'H{ { "cookie" _ } } ;
|
||||
|
||||
: get-all-cookies ( -- cookies )
|
||||
"cookie" <session-get-request> http-web-driver-request
|
||||
[ web-driver-cookie>cookie ] map ;
|
||||
[ parse-cookie ] map ;
|
||||
|
||||
: get-named-cookie ( name -- value )
|
||||
"cookie" prepend-path <session-get-request> http-web-driver-request web-driver-cookie>cookie ;
|
||||
"cookie" prepend-path <session-get-request> http-web-driver-request parse-cookie ;
|
||||
|
||||
: add-cookie ( cookie -- )
|
||||
cookie>web-driver-cookie "cookie" <session-post-request> http-web-driver-request drop ;
|
||||
|
||||
: add-cookies ( seq -- )
|
||||
[ add-cookie ] each ;
|
||||
|
||||
: delete-cookie ( name -- )
|
||||
"cookie" prepend-path <session-delete-request> http-web-driver-request drop ;
|
||||
|
||||
|
|
@ -308,19 +326,18 @@ TUPLE: rect x y width height ;
|
|||
|
||||
! TODO: Actions
|
||||
|
||||
! TODO: handle driver processes better
|
||||
|
||||
! Sessions
|
||||
! https://www.w3.org/TR/webdriver/#sessions
|
||||
|
||||
: status ( -- session-status )
|
||||
[
|
||||
! [
|
||||
"status" <web-driver-get-request> http-web-driver-request
|
||||
[ "message" of dup "" = [ drop f ] when ] [ "ready" of ] bi session-status boa
|
||||
]
|
||||
[ \ libc-error instance? ] ignore-error/f f session-status boa ;
|
||||
[ "message" of dup "" = [ drop f ] when ] [ "ready" of ] bi session-status boa ;
|
||||
! ]
|
||||
! [ \ libc-error instance? ] ignore-error/f "SUP" session-status boa ;
|
||||
|
||||
: <web-driver-session> ( capabilities -- json )
|
||||
dup .
|
||||
"session" <web-driver-post-request> http-web-driver-request
|
||||
[ "sessionId" of ] [ "capabilities" of ] bi web-driver-session boa ;
|
||||
|
||||
|
|
@ -331,61 +348,60 @@ TUPLE: rect x y width height ;
|
|||
<any-port-local-inet4> utf8 <server>
|
||||
[ addr>> port>> ] [ dispose ] bi number>string ;
|
||||
|
||||
: <web-driver-process> ( host port command -- process )
|
||||
-rot '{ _ "--host" _ "--port" _ } utf8 <process-reader> ;
|
||||
: build-url ( host port -- url )
|
||||
":" prepend append "http://" prepend "/" append >url ;
|
||||
|
||||
: <gecko-driver> ( host port -- gecko-driver )
|
||||
[ ":" prepend append "http://" prepend "/" append >url ]
|
||||
[ "geckodriver" <web-driver-process> ] 2bi
|
||||
web-driver boa ;
|
||||
! TODO: handle missing binary
|
||||
|
||||
: with-gecko-driver ( host port quote -- )
|
||||
[ [ ready?>> ] [ 1 seconds sleep status ] do until ] prepose
|
||||
[ <gecko-driver> current-web-driver ] dip with-variable ; inline
|
||||
: <gecko-driver-command-desc> ( -- desc )
|
||||
{ "geckodriver" "--log" "fatal" } ;
|
||||
|
||||
: <chrome-driver-command-desc> ( -- desc )
|
||||
{ "chromedriver" "--silent" } ;
|
||||
|
||||
: <web-driver-process> ( desc host port -- process )
|
||||
"--port=" prepend
|
||||
'{ "--host" _ _ } append utf8 <process-reader> ;
|
||||
|
||||
: <web-driver> ( command host port -- process )
|
||||
[ <web-driver-process> ] 2keep build-url web-driver boa ;
|
||||
|
||||
: default-host/port ( -- host port )
|
||||
"localhost" get-free-listen-port ;
|
||||
|
||||
: <gecko-driver> ( host port -- web-driver )
|
||||
[ <gecko-driver-command-desc> ] 2dip <web-driver> ;
|
||||
|
||||
: <default-gecko-driver> ( -- web-driver )
|
||||
default-host/port <gecko-driver> ;
|
||||
|
||||
: <chrome-driver> ( host port -- web-driver )
|
||||
[ <chrome-driver-command-desc> ] 2dip <web-driver> ;
|
||||
|
||||
: <default-chrome-driver> ( -- web-driver )
|
||||
default-host/port <chrome-driver> ;
|
||||
|
||||
: with-web-driver ( driver quote -- )
|
||||
current-web-driver swap with-variable ; inline
|
||||
|
||||
: with-default-gecko-driver ( quote -- )
|
||||
[ "127.0.0.1" get-free-listen-port ] dip with-gecko-driver ; inline
|
||||
|
||||
: <chrome-driver> ( host port -- process )
|
||||
[ ":" prepend append "http://" prepend "/" append >url ]
|
||||
[ "chromedriver" <web-driver-process> ] 2bi
|
||||
web-driver boa ;
|
||||
|
||||
: with-chrome-driver ( host port quote -- )
|
||||
[ <chrome-driver> current-web-driver ] dip with-variable ; inline
|
||||
<default-gecko-driver> swap with-web-driver ; inline
|
||||
|
||||
: with-default-chrome-driver ( quote -- )
|
||||
[ "127.0.0.1" get-free-listen-port ] dip with-chrome-driver ; inline
|
||||
<default-chrome-driver> swap with-web-driver ; inline
|
||||
|
||||
! : with-default-gecko-session ( caps quote -- )
|
||||
! [
|
||||
! 2drop
|
||||
! [ ready?>> ] [ 1 seconds sleep status ] do until
|
||||
! [ <web-driver-session> current-web-driver-session ] dip with-variable
|
||||
! delete-session
|
||||
! ] with-default-gecko-driver ;
|
||||
: with-web-driver-session ( capabilities driver quote -- )
|
||||
[
|
||||
dup current-web-driver [
|
||||
[ ready?>> ] [ 1 seconds sleep status ] do until
|
||||
swap <web-driver-session>
|
||||
'H{ { current-web-driver _ } { current-web-driver-session _ } }
|
||||
] with-variable
|
||||
] dip
|
||||
with-variables ; inline
|
||||
|
||||
! : <web-driver-session> ( host port capabilities -- session )
|
||||
! [
|
||||
! [ <gecko-driver-process> ]
|
||||
! [ ":" prepend append "http://" prepend "/" append ] 2bi
|
||||
! ] dip
|
||||
!
|
||||
! [
|
||||
! [ ready?>> ] [ 1 seconds sleep status ] do until
|
||||
! ] dip
|
||||
!
|
||||
! 2dup new-session new-session [ "sessionId" of ] [ "capabilities" of ] bi
|
||||
!
|
||||
! : init-driver-session ( -- )
|
||||
! f f web-driver-session boa
|
||||
: with-default-gecko-driver-session ( capabilities quote -- )
|
||||
<default-gecko-driver> swap with-web-driver-session ; inline
|
||||
|
||||
! : <web-driver-session> ( capabilities -- session )
|
||||
! init-driver-session
|
||||
!
|
||||
! [ ready?>> ] [ 1 seconds sleep status ] do until
|
||||
!
|
||||
! new-session [ "sessionId" of ] [ "capabilities" of ] bi
|
||||
!
|
||||
! current-web-driver-session> swap >>capabilities swap >>session-id
|
||||
! >current-web-driver-session ;
|
||||
: with-default-chrome-driver-session ( capabilities quote -- )
|
||||
<default-chrome-driver> swap with-web-driver-session ; inline
|
||||
|
|
|
|||
Loading…
Reference in New Issue