EV-WebKit

 view release on metacpan or  search on metacpan

lib/EV/WebKit.pm  view on Meta::CPAN

        # alone. window.open does NOT arrive here -- see the 'create' handler.
        if (($type_nick // '') eq 'new-window-action'
            && $self->{popups} eq 'follow' && !$self->{on_policy}) {
            my $nu = eval { $decision->get_navigation_action->get_request->get_uri };
            if (defined $nu && length $nu) {
                $decision->ignore;
                weaken(my $ws = $self);
                $self->_defer(sub { my ($u) = @_; my $b = $ws or return; $b->go($u) }, $nu);
                return 1;
            }
        }
        return 0 unless $self->{on_policy};   # not handled -- WebKit applies its own default (allow)
        # WebKitNavigationPolicyDecision (navigation-action/new-window-action) only
        # exposes get_navigation_action; WebKitResponsePolicyDecision (response) only
        # exposes get_request directly -- try the navigation path first, fall back
        # to the response path (each ->can/eval-guarded since the two are siblings,
        # not a subtype chain, so the "wrong" accessor is simply absent).
        my $uri = eval { $decision->get_navigation_action->get_request->get_uri }
               // eval { $decision->get_request->get_uri };
        my $info = EV::WebKit::Policy->_new($decision, $type_nick, $uri);
        # A throw here would escape into GI's dispatch, which merely prints it
        # and ignores it -- so neither allow nor block would run and WebKit
        # would apply its OWN default, which is allow. on_policy is a gate: a
        # page that can make the handler die (a uri that breaks its parsing)
        # would then walk straight through it. Fail CLOSED, loudly. A handler
        # that decided BEFORE it died keeps its decision.
        unless (eval { $self->{on_policy}->($info); 1 }) {
            warn "EV::WebKit: on_policy callback died (blocking the navigation): $@";
            $info->block unless $info->{done};
            return 1;
        }
        $info->allow unless $info->{done};   # default allow if handler didn't decide
        return 1;   # handled
    });

    # window.open() is not a policy decision in WebKitGTK: decide-policy never
    # fires for it at all (measured), and WebKit asks for a window through
    # 'create' instead. A one-view browser that answers nothing there leaves the
    # call returning null with no navigation, no error and no event -- so
    # popups => 'follow' has to be honoured here as well as in decide-policy,
    # which only ever saw target=_blank. on_policy is deliberately NOT consulted:
    # there is no decision object to give it, and inventing one would document a
    # policy hook that cannot allow, ignore or download.
    $view->signal_connect(create => sub {
        my (undef, $nav) = @_;
        local $IN_DISPATCH = 1;
        my $self = $wself or return undef;
        return undef if $self->{_dead} || $self->{popups} ne 'follow';
        my $nu = eval { $nav->get_request->get_uri };
        return undef unless defined $nu && length $nu;
        weaken(my $ws = $self);
        $self->_defer(sub { my ($u) = @_; my $b = $ws or return; $b->go($u) }, $nu);
        return undef;   # no second view: the navigation happens in this one
    });

    # HTTP (and proxy) authentication. WITHOUT this connected at all, a 401
    # challenge is answered by nobody: WebKit waits, the navigation resolves
    # 'timeout' after the full instance timeout, and status() is undef -- so the
    # caller cannot even tell a 401 from an unreachable host. Cancelling by
    # default turns that into an immediate, legible failure (the server's own
    # 401 body, with status 401), and a handler can supply credentials instead.
    $self->{on_authenticate} = $o{on_authenticate};
    $view->signal_connect(authenticate => sub {
        my (undef, $req) = @_;
        local $IN_DISPATCH = 1;          # runs nested in WebKit's dispatch frame -- see quit
        my $self = $wself or return 0;   # gone: let WebKit do its default
        return 0 if $self->{_dead};
        my $host = eval { $req->get_host };
        # However the challenge goes unanswered, record WHY: WebKit reports all
        # three the same way, as a bare "Load request cancelled".
        my $note = sub { $self->{_auth_challenge} = { host => $host, why => $_[0] } if defined $host };
        my $cb = $self->{on_authenticate};
        unless ($cb) {
            $note->('no on_authenticate handler answered it');
            eval { $req->cancel };
            return 1;
        }
        my $auth = EV::WebKit::Auth->_new($req);
        # Fail CLOSED, like on_policy and on_file_chooser: a handler that dies
        # must not leave the page waiting on a challenge nobody answered.
        unless (eval { $cb->($auth); 1 }) {
            warn "EV::WebKit: on_authenticate callback died (cancelling the request): $@";
            unless ($auth->{done}) { $note->('the on_authenticate handler died'); eval { $req->cancel } }
            return 1;
        }
        if    (!$auth->{done})              { $note->('the on_authenticate handler answered nothing'); eval { $req->cancel } }
        elsif ($auth->{done} eq 'cancel')   { $note->('the on_authenticate handler cancelled it') }
        return 1;
    });

    # File upload. Without a handler this stays UNhandled (return 0) so WebKit
    # runs its own native GTK file chooser exactly as before -- connecting the
    # signal must not change what an interactive user sees. With a handler, the
    # page's <input type=file> can be driven headlessly, which is otherwise
    # impossible: the value of a file input cannot be set from JavaScript.
    $self->{on_file_chooser} = $o{on_file_chooser};
    $view->signal_connect('run-file-chooser' => sub {
        my (undef, $req) = @_;
        local $IN_DISPATCH = 1;          # runs nested in WebKit's dispatch frame -- see quit
        my $self = $wself or return 0;   # gone: let WebKit do its default
        return 0 if $self->{_dead};
        my $cb = $self->{on_file_chooser} or return 0;   # unhandled -> native dialog
        my $fc = EV::WebKit::FileChooser->_new($req);
        # Fail CLOSED, like on_policy: a handler that dies must not leave the
        # page waiting on a chooser that never resolves. Cancel and report
        # handled, so the upload is refused rather than hanging the form.
        unless (eval { $cb->($fc); 1 }) {
            warn "EV::WebKit: on_file_chooser callback died (cancelling the chooser): $@";
            eval { $req->cancel } unless $fc->{done};
            return 1;
        }
        # A handler that decided nothing gets the same treatment: an unanswered
        # request is a hung page, so make the refusal explicit.
        eval { $req->cancel } unless $fc->{done};
        return 1;
    });

    # Downloads. WebKit asks for a destination via the download's own
    # decide-destination; nothing is written until we answer, so a download with
    # no handler is cancelled rather than landing somewhere unasked.
    $self->{on_download} = $o{on_download};

lib/EV/WebKit.pm  view on Meta::CPAN

        if    ($t eq 'prompt')    { $d->prompt_set_text($text) if defined $text }
        elsif (_is_confirm($t))   { $d->confirm_set_confirmed(1) }
        $s->{answered} = 1;
    }

    sub dismiss {
        my $s = shift;
        my $d = $s->{d};
        my $t = $d->get_dialog_type;
        $d->confirm_set_confirmed(0) if _is_confirm($t);
        $s->{answered} = 1;
    }
}

{
    package EV::WebKit::FileChooser;
    our $VERSION = '0.04';
    # lightweight wrapper around a WebKitFileChooserRequest, valid only for the
    # duration of the run-file-chooser handler that receives it.
    sub _new { bless { r => $_[1] }, $_[0] }

    # What the <input type=file> asked for. mime_types is the accept= list (an
    # empty list means anything); multiple tells you whether more than one file
    # is allowed, so a handler can avoid offering files WebKit will discard.
    sub mime_types { my $m = eval { $_[0]{r}->get_mime_types }; ref $m eq 'ARRAY' ? @$m : () }
    sub multiple   { $_[0]{r}->get_select_multiple ? 1 : 0 }
    sub selected   { my $f = eval { $_[0]{r}->get_selected_files }; ref $f eq 'ARRAY' ? @$f : () }

    sub select {
        my ($s, @files) = @_;
        Carp::croak('select: at least one file path is required') unless @files;
        Carp::croak('select: this chooser accepts a single file only')
            if @files > 1 && !$s->multiple;
        for my $f (@files) {
            Carp::croak('select: file paths must be plain strings') if !defined $f || ref $f;
            # WebKit hands the page whatever we pass without checking, and a
            # missing file becomes an unreadable entry the form then submits as
            # empty -- fail here, where the caller can see why.
            Carp::croak("select: no such file: $f") unless -e $f;
        }
        $s->{r}->select_files(\@files);
        $s->{done} = 1;
        return $s;
    }

    sub cancel { $_[0]{r}->cancel; $_[0]{done} = 1; return $_[0] }
}

{
    package EV::WebKit::Auth;
    our $VERSION = '0.04';
    # A WebKitAuthenticationRequest, valid only for the duration of the
    # on_authenticate handler that receives it.
    sub _new { bless { r => $_[1] }, $_[0] }

    sub host      { eval { $_[0]{r}->get_host } }
    sub port      { eval { $_[0]{r}->get_port } }
    sub realm     { eval { $_[0]{r}->get_realm } }
    sub scheme    { eval { $_[0]{r}->get_scheme } }
    sub for_proxy { eval { $_[0]{r}->is_for_proxy } ? 1 : 0 }
    # True when the credentials just supplied were rejected. A handler that
    # ignores it and answers with the same pair again is a loop, since WebKit
    # re-asks after every rejection.
    sub is_retry  { eval { $_[0]{r}->is_retry } ? 1 : 0 }

    sub login {
        my ($s, $user, $pass) = (shift, shift, shift);
        Carp::croak('login: a username and password are required')
            if !defined $user || ref $user || !defined $pass || ref $pass;
        Carp::croak('login: options must be name => value pairs') if @_ % 2;
        my %o = @_;
        my $persist = $o{persist} // 'for-session';
        Carp::croak("login: persist must be 'for-session', 'permanent' or 'none'")
            unless $persist =~ /\A(?:for-session|permanent|none)\z/;
        if (my @bad = sort grep { $_ ne 'persist' } keys %o) {
            Carp::croak("login: unknown option(s): @bad");
        }
        # The three names ARE WebKitCredentialPersistence's own nicks
        # (none/for-session/permanent) -- an earlier spelling of 'none' as
        # 'no-persistence' made every persist => 'none' call fail at the enum.
        my $cred = eval { WebKit::Credential->new($user, $pass, $persist) };
        Carp::croak('login: cannot build a credential: ' . EV::WebKit::_clean($@)) unless $cred;
        $s->{r}->authenticate($cred);
        $s->{done} = 'login';   # which way it was answered, for the failure message
        return $s;
    }

    sub cancel { eval { $_[0]{r}->cancel }; $_[0]{done} = 'cancel'; return $_[0] }
}

{
    package EV::WebKit::Download;
    our $VERSION = '0.04';
    # A download in progress. Unlike Dialog/FileChooser this OUTLIVES the signal
    # that created it: WebKit reports progress and completion later, so the
    # object is retained by the browser until it finishes or fails.
    my $SEQ = 0;
    sub _new {
        my ($class, $browser, $dl) = @_;
        Scalar::Util::weaken(my $b = $browser);   # the browser owns us; do not own it back
        # `native` is the browser's {_dl_native}/{_dl_want} key -- the identity
        # of the WebKitDownload, which is what download() matches on (its uri
        # is not stable enough; see download()).
        return bless { b => $b, dl => $dl, native => Scalar::Util::refaddr($dl),
                       seq => ++$SEQ, overwrite => 0 }, $class;
    }

    sub uri       { eval { $_[0]{dl}->get_request->get_uri } }
    sub suggested { $_[0]{suggested} }          # only known once decide-destination has fired
    sub destination { $_[0]{dest} }
    sub progress  { eval { $_[0]{dl}->get_estimated_progress } // 0 }
    sub received  { eval { $_[0]{dl}->get_received_data_length } // 0 }

    # Choose where this download lands. Called from on_download; without it the
    # download is cancelled rather than written to WebKit's default directory.
    # Shared with EV::WebKit::download, so a destination that this would reject
    # is rejected THERE -- synchronously, at the caller's own call site -- rather
    # than later, from inside the download-started signal handler where a croak
    # escapes into GLib and takes the caller's callback (and, measured, the
    # process) with it. $what names the caller for the message.
    sub _norm_dest {

lib/EV/WebKit.pm  view on Meta::CPAN


=item C<message>

The dialog's message text.

=item C<accept($text)>

Accept the dialog. For C<prompt>, C<$text> (if defined) becomes the entered
value; for C<confirm>/C<before-unload-confirm>, marks it confirmed;
C<alert> has nothing to set and this just acknowledges it.

=item C<dismiss>

Cancel the dialog (C<confirm>/C<before-unload-confirm> resolve false;
C<alert>/C<prompt> just close).

=back

=head1 EV::WebKit::Policy

Passed to C<on_policy>. Valid only for the duration of that call.

=over 4

=item C<uri>

The request URI for this decision (best-effort; may be C<undef>).

=item C<type>

Nick string: C<navigation-action>, C<new-window-action>, or C<response>.

=item C<allow>

Let the navigation/response proceed.

=item C<block>

Cancel the navigation/response.

=back

=head1 EV::WebKit::Auth

Passed to C<on_authenticate>. Valid only for the duration of that call.

=over 4

=item C<host>, C<port>, C<realm>, C<scheme>

What is being asked for. C<scheme> is WebKit's own nick for the authentication
scheme (C<http-basic>, C<http-digest>, ...); C<realm> is the server's realm
string, which is what distinguishes two challenges from the same host.

=item C<for_proxy>

True when the challenge came from a proxy rather than the origin server.

=item C<is_retry>

True when the credentials you last supplied were B<rejected>. WebKit re-asks
after every rejection, so a handler that answers with the same pair regardless
of this loops forever.

=item C<< login($user, $password, persist =E<gt> $how) >>

Answer the challenge. C<persist> is C<'for-session'> (the default -- remembered
until this instance closes, so the same realm is not asked again on every
request), C<'permanent'> (written to the platform credential store), or
C<'none'>.

=item C<cancel>

Refuse the challenge. This is also what happens if the handler returns without
deciding, dies, or was never set at all.

=back

=head1 EV::WebKit::Download

Passed to C<on_download>. B<Unlike> the dialog and policy objects, this one
outlives the handler that received it: WebKit reports progress and completion
later, so it stays valid until the download finishes, fails, or the browser
closes.

=over 4

=item C<uri>

The URI being downloaded.

=item C<suggested>

The filename the server suggested (from C<Content-Disposition>, else derived
from the URI). Only known once WebKit asks for a destination, which is when
C<on_download> runs -- so it is available there, and C<undef> before.

=item C<save_to($path, overwrite =E<gt> $bool)>

Choose where the download lands. B<Required>: a download whose handler names no
destination is cancelled, because WebKit's own default would write into the
user's Downloads directory behind the caller's back. C<$path> is a plain
filesystem path (a C<file://> URI is accepted and stripped).

=item C<on_finish($cb)>

Register the completion callback: C<< $cb->($path, $err) >>. C<$path> is where
the file landed; on failure C<$path> is C<undef> and C<$err> a message. Fires
exactly once. Registering after the download has already finished still
delivers, so there is no race in setting it late.

=item C<destination>

The path chosen by C<save_to>, or C<undef>.

=item C<progress>

Estimated completion, 0 to 1.

=item C<received>



( run in 1.226 second using v1.01-cache-2.11-cpan-007c89162af )