Fetch
view release on metacpan or search on metacpan
include/fetch/ft_ua.h view on Meta::CPAN
#ifndef FT_UA_H
#define FT_UA_H
/* The Fetch user agent, fully in C. A Fetch object is a blessed IV holding an
* ft_ua*; new() resolves the event-loop adapter and builds the default header
* set / cookie jar / connection pool, and request()/get()/... run the HTTP
* exchange - URL parsing, header merge, cookie application, request
* serialisation, and redirect following (a Future chain built with the C
* Future API in ft_future.h). The foreign event-loop adapters stay in Perl;
* everything else here is C.
*
* Included from Fetch.xs after the ft_loop_from_sv / ft_pool_from_sv /
* ft_obj_can statics it depends on. */
typedef struct {
SV *loop; /* resolved Fetch::Loop adapter */
/* Hyperman-direct mode (ft_hm.h): set at UA build when `loop` is a
* Fetch::Loop::Hyperman and Hyperman's C ABI resolved; connections then
* arm interest/deadlines through the table instead of _ft_arm/_ft_timer.
* The adapter (held in `loop`) owns the Hyperman::Loop SV, which keeps
* hm_loop valid for the UA's lifetime. */
const hm_abi *hm; /* the resolved table, or NULL */
void *hm_loop; /* opaque Hyperman loop handle */
SV *pool; /* Fetch::_Pool, or NULL when keep_alive is off */
SV *headers; /* default headers, a Fetch::Headers */
SV *agent; /* User-Agent string */
SV *cookie_jar; /* Fetch::CookieJar, or NULL */
int tls_verify;
int max_redirects;
int keep_alive;
int simple_response; /* resolve to a raw hash, not a Fetch::Response */
double timeout;
} ft_ua;
static ft_ua *ft_ua_of(pTHX_ SV *sv) {
if (!(SvROK(sv) && SvIOK(SvRV(sv))))
croak("Fetch: not a Fetch user agent");
return INT2PTR(ft_ua *, SvIV(SvRV(sv)));
}
/* ---- URL parsing -------------------------------------------------------- */
typedef struct { char *scheme, *host, *path; int port; } ft_url;
static void ft_url_free(ft_url *u) {
free(u->scheme); free(u->host); free(u->path);
u->scheme = u->host = u->path = NULL;
}
/* Parse scheme://host[:port][path]. Mirrors Fetch::_parse_url; returns 1 on
* success (fields malloc'd), 0 if there is no "://". */
static int ft_parse_url(const char *url, ft_url *u) {
const char *sep = strstr(url, "://");
const char *h, *p, *rest;
size_t i;
memset(u, 0, sizeof *u);
if (!sep) return 0;
u->scheme = ft_lc_dup(url, (STRLEN)(sep - url));
h = sep + 3;
p = h;
while (*p && *p != '/' && *p != ':' && *p != '?' && *p != '#') p++;
u->host = ft_strdup_n(h, (size_t)(p - h));
if (*p == ':') {
p++;
u->port = 0;
while (*p >= '0' && *p <= '9') { u->port = u->port * 10 + (*p - '0'); p++; }
} else {
u->port = 0;
}
if (u->port == 0)
u->port = (strcmp(u->scheme, "https") == 0) ? 443 : 80;
rest = p;
u->path = (*rest) ? ft_strdup0(rest) : ft_strdup0("/");
if (!u->path[0]) { free(u->path); u->path = ft_strdup0("/"); }
(void)i;
return 1;
}
/* authority for the Host header / :authority: host, or host:port off-default */
static char *ft_authority(const char *host, int port, int tls) {
if (port == (tls ? 443 : 80)) return ft_strdup0(host);
{
char buf[300];
snprintf(buf, sizeof buf, "%s:%d", host, port);
return ft_strdup0(buf);
}
}
/* Same origin = same scheme, host (case-insensitive) and effective port.
* Used to decide whether a redirect may carry credential headers along. */
include/fetch/ft_ua.h view on Meta::CPAN
static SV *ft_resolve_location(pTHX_ const char *base, SV *loc_sv) {
STRLEN ll;
const char *loc = SvPV_const(loc_sv, ll);
ft_url u;
char *authority;
SV *out;
/* absolute: scheme://... */
{
const char *s = loc;
if (isALPHA((unsigned char)*s)) {
const char *q = s + 1;
while (*q && (isALNUM((unsigned char)*q) || *q=='+' || *q=='.' || *q=='-')) q++;
if (q[0]==':' && q[1]=='/' && q[2]=='/')
return newSVpvn(loc, ll);
}
}
if (!ft_parse_url(base, &u)) return newSVpvn(loc, ll);
authority = ft_authority(u.host, u.port, strcmp(u.scheme, "https") == 0);
if (ll >= 2 && loc[0]=='/' && loc[1]=='/') { /* scheme-relative */
out = newSVpvf("%s:%.*s", u.scheme, (int)ll, loc);
} else if (ll >= 1 && loc[0]=='/') { /* root-relative */
out = newSVpvf("%s://%s%.*s", u.scheme, authority, (int)ll, loc);
} else { /* path-relative */
/* dir = request path up to and including the last '/' before any '?' */
const char *q = strchr(u.path, '?');
size_t plen = q ? (size_t)(q - u.path) : strlen(u.path);
long last = -1; size_t i;
for (i = 0; i < plen; i++) if (u.path[i] == '/') last = (long)i;
out = newSVpvf("%s://%s", u.scheme, authority);
if (last <= 0) sv_catpvs(out, "/");
else sv_catpvn(out, u.path, (STRLEN)(last + 1));
sv_catpvn(out, loc, ll);
}
free(authority);
ft_url_free(&u);
return out;
}
/* ---- request serialisation --------------------------------------------- */
/* Serialize the HTTP/1.1 request bytes from the merged header list. */
static SV *ft_build_request(pTHX_ ft_ua *ua, const char *method,
const char *host, int port, const char *path,
AV *hav, SV *body) {
SV *req = newSV(256); /* preallocate: most request heads fit, no realloc */
SSize_t n, i;
SvPOK_on(req);
SvCUR_set(req, 0);
*SvPVX(req) = '\0';
sv_catpv(req, method); sv_catpvs(req, " ");
sv_catpv(req, path); sv_catpvs(req, " HTTP/1.1\r\n");
if (!ft_hdr_exists(aTHX_ hav, "Host", 4)) {
if (port == 80 || port == 443) {
sv_catpvs(req, "Host: "); sv_catpv(req, host); sv_catpvs(req, "\r\n");
} else {
sv_catpvf(req, "Host: %s:%d\r\n", host, port);
}
}
if (!ua->keep_alive && !ft_hdr_exists(aTHX_ hav, "Connection", 10))
sv_catpvs(req, "Connection: close\r\n");
if (body && SvOK(body)) {
STRLEN bl; (void)SvPV(body, bl);
if (bl && !ft_hdr_exists(aTHX_ hav, "Content-Length", 14))
sv_catpvf(req, "Content-Length: %lu\r\n", (unsigned long)bl);
}
n = av_len(hav) + 1;
for (i = 0; i + 1 < n; i += 2) {
SV **k = av_fetch(hav, i, 0);
SV **v = av_fetch(hav, i + 1, 0);
STRLEN kl, vl;
const char *ks = (k && *k) ? SvPV_const(*k, kl) : (kl = 0, "");
const char *vs = (v && *v) ? SvPV_const(*v, vl) : (vl = 0, "");
sv_catpvn(req, ks, kl); sv_catpvs(req, ": ");
sv_catpvn(req, vs, vl); sv_catpvs(req, "\r\n");
}
sv_catpvs(req, "\r\n");
if (body && SvOK(body)) sv_catsv(req, body);
return req;
}
/* The settle half of the v2 outbound observer. Attached with on_ready, so it
* runs however the hop ended - resolved, failed, or cancelled - and therefore
* exactly once per ft_obs_start. A timeout, a refused connection and a DNS
* failure all arrive here as a failure rather than as silence, which is the
* whole reason a client observer is worth having. The token travels as an IV
* in the closure because it is a C pointer the consumer owns and no SV should
* ever be holding it. */
XS_INTERNAL(ft_obs_done_cb_xs);
XS_INTERNAL(ft_obs_done_cb_xs) {
dXSARGS;
hm_clos *cl = hm_clos_of(aTHX_ cv);
ft_obs_tokens *t;
SV *f;
if (!cl || items < 1) XSRETURN_EMPTY;
t = INT2PTR(ft_obs_tokens *, cl->i);
f = ST(0);
if (!t) XSRETURN_EMPTY;
{
/* a settled future carries its value in the same place either way:
* the response when it resolved, the error when it did not */
AV *vals = hmf_values_av(aTHX_ f);
SV **vp = (vals && av_len(vals) >= 0) ? av_fetch(vals, 0, 0) : NULL;
SV *v = (vp && *vp) ? *vp : NULL;
if (hmf_state(aTHX_ f) == HMF_DONE) ft_obs_done(aTHX_ t, v, NULL);
else ft_obs_done(aTHX_ t, NULL, v);
}
XSRETURN_EMPTY;
}
/* ---- response peeking (for redirects/cookies) --------------------------- */
static int ft_response_status(pTHX_ SV *res) {
if (res && SvROK(res) && SvTYPE(SvRV(res)) == SVt_PVHV) {
SV **e = hv_fetchs((HV *)SvRV(res), "status", 0);
if (e && *e) return (int)SvIV(*e);
}
return 0;
}
include/fetch/ft_ua.h view on Meta::CPAN
if (!(loc && SvOK(loc) && SvCUR(loc) > 0)) { /* not a redirect */
SV *cp = newSVsv(res);
hmf_settle(aTHX_ next, HMF_DONE, &cp, 1);
SvREFCNT_dec(cp);
XSRETURN_EMPTY;
}
{
int drop_body;
const char *m2 = ft_redirect_method(method, status, &drop_body);
SV *u2 = ft_resolve_location(aTHX_ url, loc);
HV *o2 = newHV();
SV *child, *cb2;
if (opt) {
HE *he;
hv_iterinit(opt);
while ((he = hv_iternext(opt))) {
I32 kl;
char *k = hv_iterkey(he, &kl);
(void)hv_store(o2, k, kl, newSVsv(hv_iterval(opt, he)), 0);
}
}
if (drop_body) (void)hv_delete(o2, "body", 4, G_DISCARD);
/* record the origin we are leaving so ft_request_once can strip
* credential headers if this hop crosses to a different origin */
(void)hv_store(o2, "_redirect_from", 14, newSVpv(url, 0), 0);
child = ft_follow(aTHX_ self_sv, ft_ua_of(aTHX_ self_sv),
m2, SvPV_nolen(u2), o2, left - 1);
cb2 = hm_closure(aTHX_ hm_xs_chain_cb, next, NULL, NULL, NULL, 0, 0);
hm_any_on_ready(aTHX_ child, cb2);
SvREFCNT_dec(cb2);
SvREFCNT_dec(child);
SvREFCNT_dec(u2);
SvREFCNT_dec((SV *)o2);
}
}
XSRETURN_EMPTY;
}
/* ---- follow: request, then chain a redirect if there are hops left ------ */
static SV *ft_follow(pTHX_ SV *self_sv, ft_ua *ua, const char *method,
const char *url, HV *opt, IV left) {
SV *f = ft_request_once(aTHX_ self_sv, ua, method, url, opt);
if (left <= 0) return f;
{
SV *next = hmf_new(aTHX_ hmf_class_of(aTHX_ f));
AV *pack = newAV();
SV *pack_rv, *cb;
av_push(pack, newSVpv(method, 0));
av_push(pack, newSVpv(url, 0));
av_push(pack, opt ? newRV_inc((SV *)opt) : newSV(0));
pack_rv = newRV_noinc((SV *)pack);
hmf_set_upstream(aTHX_ next, f);
cb = hm_closure(aTHX_ ft_redirect_cb, next, self_sv, pack_rv, NULL,
left, 0);
SvREFCNT_dec(pack_rv); /* hm_closure took its own ref */
hmf_on_ready(aTHX_ f, cb);
SvREFCNT_dec(cb);
SvREFCNT_dec(f); /* the connection keeps f alive */
return next;
}
}
/* ---- verb dispatch ------------------------------------------------------ */
static SV *ft_dispatch(pTHX_ SV *self_sv, const char *method, const char *url,
SV **opt_args, int nopt) {
HV *opt = newHV();
ft_ua *ua = ft_ua_of(aTHX_ self_sv);
IV max;
int i;
SV *f;
for (i = 0; i + 1 < nopt; i += 2) {
STRLEN kl;
const char *k = SvPV_const(opt_args[i], kl);
(void)hv_store(opt, k, (I32)kl, newSVsv(opt_args[i + 1]), 0);
}
if (hv_exists(opt, "max_redirects", 13)) {
SV **m = hv_fetchs(opt, "max_redirects", 0);
max = (m && *m && SvOK(*m)) ? SvIV(*m) : 0;
} else {
max = ua->max_redirects;
}
if (max < 0) max = 0;
f = ft_follow(aTHX_ self_sv, ua, method, url, opt, max);
SvREFCNT_dec((SV *)opt);
return f;
}
/* ---- WebSocket ---------------------------------------------------------- */
/* the ft_conn behind a Fetch::WebSocket (a blessed IV over the connection) */
static ft_conn *ft_ws_of(pTHX_ SV *sv) {
if (!(SvROK(sv) && SvIOK(SvRV(sv))))
croak("Fetch::WebSocket: not a websocket");
return INT2PTR(ft_conn *, SvIV(SvRV(sv)));
}
/* Open a WebSocket: send the HTTP/1.1 Upgrade handshake with a fresh key and
* return a Future resolving to a Fetch::WebSocket once the 101 is verified.
* Accepts ws:// wss:// http:// https:// (ws/http cleartext, wss/https TLS). */
static SV *ft_websocket(pTHX_ ft_ua *ua, const char *url, HV *opt) {
ft_url u;
int tls, verify;
double timeout;
AV *hav;
char portbuf[16], wskey[25];
char *authority;
SV *req, *m_sv, *sc_sv, *au_sv, *pa_sv, *empty_rv, *f;
ft_loop *l = NULL; SV *lsv = NULL;
if (!ft_parse_url(url, &u))
croak("Fetch: cannot parse URL '%s'", url);
tls = (strcmp(u.scheme, "wss") == 0 || strcmp(u.scheme, "https") == 0);
if (strcmp(u.scheme, "ws") && strcmp(u.scheme, "wss")
&& strcmp(u.scheme, "http") && strcmp(u.scheme, "https")) {
SV *fu = hmf_new(aTHX_ "Fetch::Future");
SV *e = sv_2mortal(newSVpvf("Fetch: not a websocket URL scheme '%s'\n", u.scheme));
hmf_settle(aTHX_ fu, HMF_FAILED, &e, 1);
( run in 2.589 seconds using v1.01-cache-2.11-cpan-14f38c9f855 )