Fetch
view release on metacpan or search on metacpan
rather than one per agent, rebuilt in a child after a fork.
Agents that did not ask for a specific loop therefore multiplex:
awaiting on one drives what the others have in flight.
- Loop adapters gained _ft_await($future), the per-instance form of
what install_await put in the global. Third-party adapters
without it keep working through the old global hook.
- Awaiting on a loop with no watchers and no timers dies with a
diagnostic instead of blocking forever.
0.12 2026-08-12
- A keep-alive connection the server closes at the moment it is reused
no longer fails the request.
0.11 Date/time
- $ua->clone(%overrides): another agent over this one's connection
pool and loop, with the named options replaced. The case it exists
for is a per-request cookie jar - a jar belongs to the agent, so a
jar on a long-lived agent is shared by every request that agent
serves, which is a cross-request leak the moment the cookies
identify an end user rather than the application. Building a fresh
agent per request avoids that but throws away the keep-alive pool
and re-resolves the loop adapter, which is most of what new()
costs; a clone gives the isolation without the bill.
- cookie_jar, headers, agent, timeout, tls_verify, max_redirects,
keep_alive and simple_response are overridable, and
cookie_jar => undef drops an inherited jar. Headers are copied
rather than shared, so a clone cannot write into the parent's
defaults.
0.10 2026-08-05
- Drive Hyperman loops through Hyperman's public C ABI
- Awaiting on a Hyperman loop ($future->get) is also C now: the
AWAIT hook bridges the Fetch::Future to a Hyperman::Future through
the ABI and pumps with run_until
Authorization) are no longer sent across a redirect that changes
origin (scheme, host or port). A token or explicit cookie set for the
original host is dropped when a 3xx points at a different one; jar
cookies were already re-scoped per host. t/17-redirect-auth.t.
- Security: reject a Set-Cookie whose Domain is a bare public suffix /
single label (e.g. "com", ".com", "localhost") - it must carry an
interior dot, so a server cannot scope a cookie to a whole TLD.
- Security: a response carrying both Content-Length and Transfer-
Encoding: chunked is now framed strictly by the chunked encoding
(RFC 7230 3.3.3, TE overrides CL) with the ambiguous Content-Length
dropped - it cannot truncate the body or desync a keep-alive
connection. t/18-cl-te.t.
- Loop watcher callbacks (the per-readiness-event hot path) are now
dispatched directly: the standalone loop recognises its own C
closures and calls the XSUB body straight, skipping pp_entersub.
0.08 2026-08-04
- JSON (the `json =>` request option and Fetch::Response->json) now goes
through File::Raw::JSON's C ABI
- Fetch is now an ExtUtils::Depends provider
- Bodyless responses: 1xx, 204 and 304 never carry a body (RFC 7230
3.3.3), and a server MUST NOT send Content-Length on 1xx/204, so
the h1 parser treated the missing length as read-until-close - a
204 on a keep-alive connection hung until timeout. Those statuses
now complete at the end of headers.
0.07 2026-08-04
- Build and run on perl before 5.14. A new include/fetch/ft_compat.h
supplies fallbacks for perl API the C core used but which predates
the perls Fetch claims (5.8.3+), all guarded by PERL_VERSION so newer
perls are untouched:
- XSPROTO / XS_INTERNAL / XS_EXTERNAL (the closure-callback macros,
added to XSUB.h at 5.16): without them the build failed to compile
("XS_INTERNAL undeclared" / "cv undeclared") before any test ran.
t/01-future.t
t/02-loop.t
t/03-http.t
t/04-chunked.t
t/05-tls.t
t/06-h2.t
t/07-loops.t
t/08-redirect.t
t/09-timeout.t
t/10-stream.t
t/11-keepalive.t
t/12-headers.t
t/13-cookies.t
t/14-websocket.t
t/15-websocket-hyperman.t
t/16-json.t
t/17-redirect-auth.t
t/18-cl-te.t
t/16-timeout-hyperman.t
t/19-clone.t
t/20-stale-keepalive.t
t/21-multi-agent.t
t/22-idle-loop.t
t/23-observer.t
t/24-h2-trailers.t
t/25-tunnel-starttls.t
t/manifest.t
t/pod-coverage.t
t/pod.t
xs/abi.xs
xs/cookiejar.xs
include/fetch/fetch_abi.h view on Meta::CPAN
const char *url, STRLEN ulen,
AV *headers, void *ud);
typedef void (*fetch_obs_done_cb)(pTHX_ void *token, SV *res, SV *err,
void *ud);
typedef struct fetch_abi {
int abi_version; /* == FETCH_ABI_VERSION */
/* Construct a Fetch user agent from flat key/value SV pairs (the same
* options Fetch->new takes: loop, pool_size, tls_verify, timeout, agent,
* headers, cookie_jar, keep_alive, max_redirects, simple_response). kv has
* nkv SVs (nkv even). Returns the blessed Fetch UA SV (+1 owned). */
SV *(*ua_new)(pTHX_ SV **kv, int nkv);
/* Issue one HTTP request on $ua_sv (a Fetch object), building the request
* entirely from C (no Perl option hash on the hot path). method and url are
* NUL-terminated; body may be NULL. max_redirects < 0 means "use the UA's
* own default". When the request settles, `map` shapes the result. Returns
* the derived future SV (a Fetch::Future, +1 owned by the caller) - hand it
* to an awaiting server or call ->get on it. */
SV *(*request)(pTHX_ SV *ua_sv,
include/fetch/fetch_abi.h view on Meta::CPAN
fetch_map_cb map, void *ud);
/* Extract parts from an already-resolved response hashref (a blessed
* Fetch::Response or the raw simple_response hash), no method dispatch.
* Any out-ptr may be NULL; *headers and *body are borrowed. For the
* blocking (non-Hyperman) path. */
void (*res_parts)(pTHX_ SV *res, int *status, AV **headers, SV **body);
/* Like request, but streams the response instead of buffering: on_headers
* fires once up front, on_body per chunk, on_done at completion. Returns
* the request future SV (+1 owned) - keep it alive until on_done fires.
* max_redirects < 0 uses the UA default. */
SV *(*request_stream)(pTHX_ SV *ua_sv, const char *method, const char *url,
const fetch_hdr *hdrs, int nhdrs,
const char *body, STRLEN blen,
double timeout, int max_redirects,
fetch_on_headers on_headers, fetch_on_body on_body,
fetch_on_done on_done, void *ud);
/* Raw blocking upstream connection for an Upgrade/WebSocket tunnel. TLS
* (tls=1) reuses Fetch's client SSL_CTX, so the consumer tunnels to a
include/fetch/ft_abi.h view on Meta::CPAN
int have_maxr = 0, maxr = 5, pool_size = 32, simple = 0;
double timeout = 0.0;
int i;
for (i = 0; i + 1 < nkv; i += 2) {
const char *k = SvPV_nolen(kv[i]);
SV *v = kv[i + 1];
if (strEQ(k, "loop")) loop_arg = v;
else if (strEQ(k, "headers")) headers_arg = v;
else if (strEQ(k, "agent")) agent_arg = v;
else if (strEQ(k, "cookie_jar")) jar_arg = v;
else if (strEQ(k, "keep_alive")) { have_keep = 1; keep = SvTRUE(v) ? 1 : 0; }
else if (strEQ(k, "tls_verify")) { have_verify = 1; verify = SvTRUE(v) ? 1 : 0; }
else if (strEQ(k, "max_redirects")) { have_maxr = 1; maxr = (int)SvIV(v); }
else if (strEQ(k, "timeout")) timeout = SvNV(v);
else if (strEQ(k, "pool_size")) pool_size = (int)SvIV(v);
else if (strEQ(k, "simple_response")) simple = SvTRUE(v) ? 1 : 0;
}
Newxz(ua, 1, ft_ua);
ua->loop = ft_resolve_loop(aTHX_ loop_arg);
if (ft_obj_can(aTHX_ ua->loop, "install_await")) {
dSP;
include/fetch/ft_abi.h view on Meta::CPAN
const hm_abi *A = ft_hm(aTHX);
SV **e = hv_fetchs((HV *)SvRV(ua->loop), "loop", 0);
if (A && e && *e && sv_isobject(*e)
&& sv_derived_from(*e, "Hyperman::Loop")) {
ua->hm_loop = A->loop_of_sv(aTHX_ *e);
ua->hm = A;
/* C await: bridge + run_until instead of the Perl AWAIT sub */
ft_hm_install_await(aTHX_ ua->loop, ua->hm_loop);
}
}
ua->keep_alive = have_keep ? keep : 1;
ua->simple_response = simple;
if (jar_arg && SvOK(jar_arg)) {
if (SvROK(jar_arg)) ua->cookie_jar = SvREFCNT_inc(jar_arg);
else if (SvTRUE(jar_arg)) ua->cookie_jar = ft_load_new(aTHX_ "Fetch::CookieJar", NULL);
}
{
AV *hav = newAV();
if (headers_arg && SvOK(headers_arg))
ft_hdr_pairs_into(aTHX_ hav, headers_arg);
ua->headers = sv_bless(newRV_noinc((SV *)hav),
include/fetch/ft_abi.h view on Meta::CPAN
}
if (agent_arg && SvOK(agent_arg)) {
ua->agent = newSVsv(agent_arg);
} else {
SV *ver = get_sv("Fetch::VERSION", 0);
ua->agent = newSVpvf("Fetch/%s", (ver && SvOK(ver)) ? SvPV_nolen(ver) : "0");
}
ua->tls_verify = have_verify ? verify : 1;
ua->max_redirects = have_maxr ? maxr : 5;
ua->timeout = timeout;
if (ua->keep_alive) {
ft_pool *p = ft_pool_new(pool_size > 0 ? pool_size : 32);
if (!p) { SvREFCNT_dec(ua->loop); Safefree(ua); croak("Fetch: out of memory"); }
ua->pool = sv_bless(newRV_noinc(newSViv(PTR2IV(p))),
gv_stashpv("Fetch::_Pool", GV_ADD));
}
return sv_bless(newRV_noinc(newSViv(PTR2IV(ua))), gv_stashpv(cls, GV_ADD));
}
/* A second agent over this one's connection pool and loop, with some options
* replaced.
*
* The case this exists for is a per-request cookie jar. A jar on a long-lived
* agent is shared by every request that agent serves, which leaks between them
* the moment the cookies identify an end user rather than the application; and
* building a whole fresh agent per request to avoid that throws away the
* keep-alive pool and re-resolves the loop adapter, which is most of what
* new() costs. A clone gives the caller its own jar over the same pool.
*
* Sharing is safe because DESTROY only releases references: the pool and the
* loop live until the last agent holding them goes. `loop` and `pool_size`
* cannot be overridden - they are the things being shared, and a clone on a
* different loop would be driving the parent's parked connections from the
* wrong place. */
static SV *ft_ua_clone(pTHX_ SV *self, SV **kv, int nkv) {
ft_ua *src = ft_ua_of(aTHX_ self);
ft_ua *ua;
include/fetch/ft_abi.h view on Meta::CPAN
if (!(SvROK(self) && SvOBJECT(SvRV(self))))
croak("Fetch->clone: not a Fetch user agent");
cls = HvNAME(SvSTASH(SvRV(self)));
for (i = 0; i + 1 < nkv; i += 2) {
const char *k = SvPV_nolen(kv[i]);
SV *v = kv[i + 1];
if (strEQ(k, "cookie_jar")) { have_jar = 1; jar_arg = v; }
else if (strEQ(k, "headers")) headers_arg = v;
else if (strEQ(k, "agent")) agent_arg = v;
else if (strEQ(k, "keep_alive")) { have_keep = 1; keep = SvTRUE(v) ? 1 : 0; }
else if (strEQ(k, "tls_verify")) { have_verify = 1; verify = SvTRUE(v) ? 1 : 0; }
else if (strEQ(k, "max_redirects")) { have_maxr = 1; maxr = (int)SvIV(v); }
else if (strEQ(k, "timeout")) { have_to = 1; timeout = SvNV(v); }
else if (strEQ(k, "simple_response")){ have_simple = 1; simple = SvTRUE(v) ? 1 : 0; }
else if (strEQ(k, "loop") || strEQ(k, "pool_size"))
croak("Fetch->clone: '%s' cannot be overridden on a clone; the "
"loop and the connection pool are what it shares", k);
}
Newxz(ua, 1, ft_ua);
/* shared with the parent, by reference */
ua->loop = src->loop ? SvREFCNT_inc(src->loop) : NULL;
ua->pool = src->pool ? SvREFCNT_inc(src->pool) : NULL;
ua->hm = src->hm;
ua->hm_loop = src->hm_loop;
/* inherited unless overridden */
ua->keep_alive = have_keep ? keep : src->keep_alive;
ua->tls_verify = have_verify ? verify : src->tls_verify;
ua->max_redirects = have_maxr ? maxr : src->max_redirects;
ua->simple_response = have_simple ? simple : src->simple_response;
ua->timeout = have_to ? timeout : src->timeout;
if (have_jar) {
/* an explicit undef/0 means "no jar", which is how a clone drops one */
if (jar_arg && SvOK(jar_arg)) {
if (SvROK(jar_arg)) ua->cookie_jar = SvREFCNT_inc(jar_arg);
else if (SvTRUE(jar_arg)) ua->cookie_jar =
include/fetch/ft_abi.h view on Meta::CPAN
next = hmf_new(aTHX_ hmf_class_of(aTHX_ f));
Newxz(ctx, 1, ft_abi_ctx);
ctx->map = map;
ctx->ud = ud;
hmf_set_upstream(aTHX_ next, f);
cb = hm_closure(aTHX_ ft_abi_complete_cb, next, NULL, NULL, NULL,
PTR2IV(ctx), 0);
hmf_on_ready(aTHX_ f, cb);
SvREFCNT_dec(cb);
SvREFCNT_dec(f); /* the request keeps f alive */
return next;
}
static void ft_abi_res_parts(pTHX_ SV *res, int *status, AV **headers,
SV **body) {
HV *h;
SV **e;
if (status) *status = 0;
if (headers) *headers = NULL;
if (body) *body = NULL;
include/fetch/ft_http.h view on Meta::CPAN
#ifndef FT_HTTP_H
#define FT_HTTP_H
/* HTTP/1.1 client: a non-blocking connection state machine driven by the loop
* through a C-closure readiness callback (no Perl runs per event). Socket IO
* and response parsing are all in C; the request resolves a Fetch::Future with
* a Fetch::Response. This first cut handles GET/POST with Content-Length or
* Connection: close bodies; chunked decoding and keep-alive pooling follow. */
#include <sys/types.h>
#include <string.h>
#include <stdlib.h>
/* Sockets, netdb, fcntl, unistd and errno come from ft_win.h (which maps to
* Winsock on native Windows and to the POSIX headers everywhere else); the
* socket/IO calls below go through its ft_os_* wrappers. */
typedef enum { FT_CONNECTING, FT_HANDSHAKING, FT_WRITING, FT_READING,
FT_PARKED } ft_http_state;
typedef struct ft_conn {
ft_loop *loop; /* native Standalone loop, or NULL if foreign */
SV *loop_sv; /* foreign loop object (IO::Async/AnyEvent/
* Hyperman); interest is armed by calling its
* _ft_arm method. NULL for the native loop. */
/* Hyperman-direct mode: when the foreign loop is a Fetch::Loop::Hyperman
* and Hyperman's C ABI resolved (ft_hm.h), interest and deadlines go
* straight through the table - no _ft_arm dispatch, no Perl frame per
* readiness event. loop_sv is still held (it keeps the loop alive) but
* its methods are never called while hm is set. */
const hm_abi *hm; /* the resolved table, or NULL */
void *hm_loop; /* opaque Hyperman loop handle */
hm_abi_timer *hm_timer; /* pending deadline handle, or NULL */
int fd;
int armed; /* HM_EV_* currently watched */
ft_http_state state;
SV *future; /* Fetch::Future to resolve */
SV *watcher; /* the C-closure coderef (freed on close) */
/* optional per-request deadline: fires ft_conn_timeout, which fails the
* request and tears the socket down. timer (native) xor timer_h (foreign
* loop handle) is set; timer_cb is our ref to the timeout closure. */
ft_timer *timer;
SV *timer_h;
SV *timer_cb;
/* TLS */
void *ssl; /* SSL* when https, else NULL */
int tls; /* request wants TLS */
int verify; /* verify peer + hostname */
char *host; /* SNI / verify host, and the redial target */
char *port; /* service, kept for the keep-alive redial */
/* HTTP/2 (nghttp2) - populated after ALPN negotiates h2 */
void *h2; /* nghttp2_session* */
int is_h2;
int h2_done; /* stream closed */
/* structured request pieces, kept for the h2 nva (built after ALPN) */
SV *rq_method; /* "GET" ... */
SV *rq_scheme; /* "http"/"https" */
SV *rq_authority;/* host[:port] */
SV *rq_path; /* "/..." */
AV *rq_headers; /* [k,v,...] extra headers */
include/fetch/ft_http.h view on Meta::CPAN
AV *trailers; /* [k,v,...] from a SECOND HEADERS frame (h2) */
long content_len; /* -1 = until close */
int want_close; /* Connection: close */
/* chunked transfer decoding */
int chunked;
size_t cpos; /* decode cursor into rbuf */
long chunk_left; /* bytes left in chunk; -1 = need size line */
int chunk_done; /* terminating 0-chunk seen */
char *dbody; /* decoded body */
size_t dblen, dbcap;
/* keep-alive pooling: when this h1 connection may be reused, it is parked
* (fd + TLS kept open) in the owning pool under poolkey instead of closed,
* and revived for the next request to the same host. */
struct ft_pool *pool; /* owning pool (NULL = close-per-request) */
char *poolkey; /* "tls:host:port" identity for reuse */
struct ft_conn *next_idle; /* pool free-list link while parked */
int reused; /* revived from the pool this request */
int simple; /* resolve with a raw hash, not a blessed
* Fetch::Response (Fetch->new(simple_response)) */
/* WebSocket (RFC 6455): after a verified 101 the connection switches to
* frame mode and stays open, owned by a Fetch::WebSocket object. */
include/fetch/ft_http.h view on Meta::CPAN
SV *ws_waiter; /* pending next_message future */
AV *ws_inbox; /* messages arrived before a waiter */
char *ws_wbuf; /* queued outbound frame bytes */
size_t ws_wlen, ws_wcap, ws_woff;
char *ws_msg; /* inbound message reassembly (fragments) */
size_t ws_mlen, ws_mcap;
int ws_msg_opcode;
size_t ws_pos; /* frame parse cursor into rbuf */
} ft_conn;
/* A per-UA keep-alive pool: a flat list of idle, revivable h1 connections.
* Few distinct hosts in practice, so a linear scan by poolkey is fine. */
typedef struct ft_pool {
ft_conn *idle; /* head of the idle list (via next_idle) */
int count;
int max; /* cap on parked connections */
} ft_pool;
#include "ft_tls.h" /* operates on ft_conn (c->ssl, c->fd) */
static void ft_h2_free(ft_conn *c); /* defined in ft_h2.h */
include/fetch/ft_http.h view on Meta::CPAN
Safefree(c->poolkey);
Safefree(c->ws_key);
Safefree(c->ws_wbuf);
Safefree(c->ws_msg);
Safefree(c->req);
Safefree(c->rbuf);
Safefree(c->dbody);
Safefree(c);
}
/* --- keep-alive pool ------------------------------------------------------ */
static ft_pool *ft_pool_new(int max) {
ft_pool *p = (ft_pool *)calloc(1, sizeof(ft_pool));
if (!p) return NULL;
p->max = max > 0 ? max : 32;
return p;
}
/* Take the first idle connection matching key, unlinking it; NULL if none. */
static ft_conn *ft_pool_take(ft_pool *p, const char *key) {
include/fetch/ft_http.h view on Meta::CPAN
if (!c->pool || c->want_close || c->is_h2) return 0;
if (c->chunked) return c->chunk_done;
return c->content_len >= 0;
}
/* Park a finished connection: stop watching it, drop the request's per-call
* state, keep the fd/TLS/buffers, and hand it to the pool for the next
* request to the same host. */
static void ft_conn_park(pTHX_ ft_conn *c) {
/* Stay armed for READ while idle instead of disarming now and re-arming on
* the next request. A healthy keep-alive socket is quiet, so this costs
* nothing; it saves the disarm+re-arm pair per reuse - two _ft_arm
* crossings on a foreign loop, two epoll/kqueue syscalls on the native
* one. If the server closes the idle connection it becomes readable and
* ft_conn_ready_cb (seeing FT_PARKED) evicts it. */
ft_arm(aTHX_ c, HM_EV_READ); /* no-op: already READ-armed from recv */
ft_conn_cancel_timer(aTHX_ c);
if (c->future) { SvREFCNT_dec(c->future); c->future = NULL; }
if (c->on_body) { SvREFCNT_dec(c->on_body); c->on_body = NULL; }
if (c->on_headers) { SvREFCNT_dec(c->on_headers); c->on_headers = NULL; }
c->headers_fired = 0;
include/fetch/ft_http.h view on Meta::CPAN
c->want_close = 1;
else if (klen == 17 && strncasecmp(p, "Transfer-Encoding", 17) == 0 &&
strncasestr_chunked(vs, ve))
c->chunked = 1;
}
p = eol + 2;
}
/* RFC 7230 3.3.3: Transfer-Encoding overrides Content-Length. A response
* carrying both is a response-smuggling signal; frame strictly by the
* chunked encoding and drop the ambiguous Content-Length so no code path
* (ft_body_complete, keep-alive completion) can ever frame by it. */
if (c->chunked) c->content_len = -1;
/* RFC 7230 3.3.3: 1xx, 204 and 304 responses never carry a body, and a
* server MUST NOT send Content-Length on 1xx/204 - without this a 204 on
* a keep-alive connection would wait for close/timeout that never comes. */
if (c->status == 204 || c->status == 304 ||
(c->status >= 100 && c->status < 200)) {
c->content_len = 0;
c->chunked = 0;
}
c->have_headers = 1;
c->cpos = c->hdr_end; /* body decoding starts here */
if (c->chunked) c->chunk_left = -1;
return 1;
}
include/fetch/ft_http.h view on Meta::CPAN
size_t i = 0, n;
const char *const *m;
while (i < len && req[i] != ' ') i++;
for (m = ok; *m; m++) {
n = strlen(*m);
if (n == i && strncmp(req, *m, n) == 0) return 1;
}
return 0;
}
/* A keep-alive connection revived from the pool can die under the very
* request that revived it: the server had already decided to close it and the
* FIN was still in flight when ft_conn_alive() peeked. That is not a request
* failure, it is a lost race, and every request over a pool has to survive it
* - so redial and send the same bytes again on a fresh socket.
*
* Only ever on a revived connection (c->reused, cleared here so one request
* cannot loop), only while nothing of a response has arrived, and only for an
* idempotent method - if any byte came back the server did answer, and a
* replay would be a second POST rather than a retry.
*
* Returns 1 when the request is back in flight on a new socket. */
static int ft_conn_retry(pTHX_ ft_conn *c) {
include/fetch/ft_http.h view on Meta::CPAN
if (c->hm) { /* precise one-shot kernel timer, C callback, cancellable */
c->hm_timer = c->hm->timer(aTHX_ c->hm_loop, secs, ft_hm_timeout, c);
return;
}
c->timer_cb = hm_closure(aTHX_ ft_conn_timeout_cb, NULL, NULL, NULL, NULL,
PTR2IV(c), 0);
if (c->loop_sv) ft_loop_timer(aTHX_ c, secs);
else c->timer = ft_add_timer(aTHX_ c->loop, secs, c->timer_cb, 1);
}
/* A parked keep-alive connection may have been closed by the server while
* idle. A one-byte MSG_PEEK distinguishes a healthy idle socket (EAGAIN, no
* pending data) from a closed or confused one (0, unexpected data, or error). */
static int ft_conn_alive(ft_conn *c) {
char b;
ssize_t n = ft_os_recv(c->fd, &b, 1, MSG_PEEK);
if (n < 0 && (errno == EAGAIN || errno == EWOULDBLOCK)) return 1;
return 0;
}
/* Revive a parked connection for a new request: swap in the new request bytes,
* future and streaming sink, then send straight away (fd + TLS already up). */
static void ft_conn_revive(pTHX_ ft_conn *c, const char *req_bytes, STRLEN req_len,
double timeout, SV *body, SV *on_body, SV *future) {
include/fetch/ft_http.h view on Meta::CPAN
ft_conn *c;
char poolkey[300];
SV *future = hmf_new(aTHX_ "Fetch::Future");
/* reuse a live parked connection to the same host, if we have one */
if (pool) {
snprintf(poolkey, sizeof(poolkey), "%d:%s:%s", tls ? 1 : 0, host, port);
for (;;) {
ft_conn *k = ft_pool_take(pool, poolkey);
if (!k) break;
if (!ft_conn_alive(k)) { k->pool = NULL; ft_conn_free(aTHX_ k); continue; }
ft_conn_revive(aTHX_ k, req_bytes, req_len, timeout, body, on_body, future);
return future;
}
}
memset(&hints, 0, sizeof(hints));
hints.ai_family = AF_UNSPEC;
hints.ai_socktype = SOCK_STREAM;
gai = getaddrinfo(host, port, &hints, &ai);
if (gai != 0) {
include/fetch/ft_ua.h view on Meta::CPAN
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)));
}
include/fetch/ft_ua.h view on Meta::CPAN
*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);
include/fetch/ft_ua.h view on Meta::CPAN
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);
lib/Fetch.pm view on Meta::CPAN
=head1 DESCRIPTION
Fetch is an HTTP user agent whose socket, TLS, HTTP/2 framing and HTTP/1.1
parsing hot path lives in vendored C, and whose asynchronous results are
L<Fetch::Future> objects that compose with the Hyperman event loop and other
CPAN loops (IO::Async, AnyEvent) - or with nothing at all, since Fetch ships
its own event loop (L<Fetch::Loop::Standalone>) and uses it automatically.
HTTP/1.1 and HTTP/2 (ALPN-negotiated over TLS), over cleartext and TLS, with
keep-alive connection pooling, redirect following, per-request timeouts,
streaming response bodies, a cookie jar, JSON request/response helpers, and
native WebSockets. Every request method returns a
L<Fetch::Future>; C<< ->get >> on one awaits it, pumping whichever event loop
is active (its own if none), so the same code serves both a simple synchronous
call and thousands of requests multiplexed on one loop.
=head1 CONSTRUCTOR
=head2 new(%args)
lib/Fetch.pm view on Meta::CPAN
=item C<timeout>
Default per-request deadline in seconds (fractional allowed). C<0> (the
default) means no timeout. Overridable per request.
=item C<max_redirects>
How many redirects to follow. Default C<5>; C<0> disables following.
Overridable per request.
=item C<keep_alive>
Reuse connections via a keep-alive pool (default true). Set false to close
every connection after one request.
=item C<pool_size>
Maximum idle connections the keep-alive pool parks (default C<32>).
=item C<cookie_jar>
A L<Fetch::CookieJar> to store and send cookies (applied across redirects), or
a true scalar to create a fresh one. Default: no jar.
=item C<simple_response>
Resolve requests to a plain unblessed hashref C<< { status => ..., headers =>
[k, v, ...], content => ... } >> instead of a blessed L<Fetch::Response>. Read
lib/Fetch.pm view on Meta::CPAN
my $shared = Fetch->new; # built once
my $scoped = $shared->clone(cookie_jar => 1); # its own jar, same pool
Another agent over this one's connection pool and event loop, with the given
options replaced. Everything not named is inherited.
The case it exists for is a B<per-request cookie jar>. A jar belongs to the
agent, so a jar on a long-lived agent is shared by every request that agent
serves: fine when the cookies authenticate the application itself, a
cross-request leak the moment they identify an end user. Building a whole fresh
agent per request avoids the leak but throws away the keep-alive pool and
re-resolves the loop adapter, which is most of what C<new> costs. A clone gives
you the isolation without the bill.
C<cookie_jar>, C<headers>, C<agent>, C<timeout>, C<tls_verify>,
C<max_redirects>, C<keep_alive> and C<simple_response> can be overridden;
C<< cookie_jar => undef >> drops an inherited jar. Headers are copied rather
than shared, so a clone cannot write into the parent's defaults.
C<loop> and C<pool_size> cannot be overridden and croak if given: they are what
the clone shares, and an agent on a different loop driving the parent's parked
connections would be reaching into the wrong one.
A clone holds references to the shared pool and loop, so they live until the
last agent using them goes. Keep the parent alive for as long as its clones, as
you would anyway.
=head1 ACCESSORS
=head2 loop
The event-loop adapter this agent runs on.
=head2 cookie_jar
lib/Fetch.pm view on Meta::CPAN
C<fetch_abi> (see C<fetch_abi.h> for the exact signatures and ownership rules)
holds, after C<abi_version>:
=over 4
=item C<ua_new(kv, nkv)>
Construct a Fetch user agent from C<nkv> flat key/value SVs (the same options
C<new> takes: C<loop>, C<pool_size>, C<tls_verify>, C<timeout>, C<agent>,
C<headers>, C<cookie_jar>, C<keep_alive>, C<max_redirects>,
C<simple_response>). Returns the blessed Fetch UA SV (+1 owned). A consumer may
instead call C<< Fetch->new >> from Perl once and cache the object; C<ua_new>
just removes that last Perl call.
=item C<request(ua_sv, method, url, hdrs, nhdrs, body, blen, timeout, max_redirects, map, ud)>
Issue one HTTP request on C<ua_sv>, building it entirely from C. The headers
are a flat C<fetch_hdr> array; C<max_redirects> below zero means "use the UA
default". Returns a L<Fetch::Future> SV (+1 owned) - hand it to an awaiting
server or call C<< ->get >> on it. When the request settles, your C<map>
lib/Fetch.pm view on Meta::CPAN
Pull the status, the flat header AV and the content SV out of an
already-resolved response (a L<Fetch::Response> or a C<simple_response> hash)
with no method dispatch. Any out-pointer may be C<NULL>; the returned C<headers>
and C<body> are borrowed. For the blocking (awaited) path.
=item C<request_stream(ua_sv, method, url, hdrs, nhdrs, body, blen, timeout, max_redirects, on_headers, on_body, on_done, ud)>
Like C<request>, but streams the response instead of buffering it: C<on_headers>
fires once up front with the status and header AV, C<on_body> once per body
chunk, and C<on_done> at completion (with success/failure). Returns the request
future SV (+1 owned) - keep it alive until C<on_done> fires. Lets a consumer
forward a large download or an endless SSE stream with flat memory.
=item C<tunnel_connect(host, port, tls, verify)> and friends
A raw blocking upstream TCP connection Fetch owns, for a proxy's
Upgrade/WebSocket tunnel where the consumer splices bytes both ways itself.
When C<tls> is true the connection reuses Fetch's own client C<SSL_CTX> (SNI,
and hostname/certificate verification when C<verify> is true), so the consumer
tunnels to a C<wss>/C<https> upstream without linking OpenSSL. This is what lets
L<Reverse::Proxy> tunnel to a TLS upstream.
t/11-keepalive.t view on Meta::CPAN
#!perl
use 5.008003;
use strict;
use warnings;
use IO::Socket::INET;
use Test::More;
use File::Spec ();
use Fetch;
# Keep-alive pooling: a persistent server tags every TCP connection with an
# incrementing id and echoes it, so we can see whether requests reuse one
# connection (pooling on) or open a fresh one each time (pooling off). The
# server forks per connection so several may be open at once.
my $srv = IO::Socket::INET->new(
LocalHost => '127.0.0.1', LocalPort => 0, Listen => 128, ReuseAddr => 1,
) or plan skip_all => "cannot listen: $!";
my $port = $srv->sockport;
my $base = "http://127.0.0.1:$port";
t/11-keepalive.t view on Meta::CPAN
exit 0;
}
close $c; # parent keeps accepting
}
exit 0;
}
select(undef, undef, undef, 0.3);
plan tests => 5;
# ---- keep-alive on (default): one connection serves every request --------
{
my $ua = Fetch->new;
my @ids = map { $ua->get("$base/")->get->content } 1 .. 8;
my %seen; $seen{$_}++ for @ids;
is(scalar(keys %seen), 1, 'keep-alive reuses a single connection for 8 GETs');
is($ids[0], $ids[-1], 'first and last request landed on the same connection');
}
# ---- keep-alive off: a fresh connection every time -----------------------
{
my $ua = Fetch->new(keep_alive => 0);
my @ids = map { $ua->get("$base/")->get->content } 1 .. 5;
my %seen; $seen{$_}++ for @ids;
is(scalar(keys %seen), 5, 'keep_alive => 0 opens a new connection per request');
}
# ---- reuse stays correct: bodies are right and status holds --------------
{
my $ua = Fetch->new;
my @res = map { $ua->get("$base/")->get } 1 .. 4;
ok((!grep { $_->status != 200 } @res), 'every reused request is 200');
like($res[-1]->content, qr/^conn\d+$/, 'reused connection still returns a body');
}
t/18-cl-te.t view on Meta::CPAN
use 5.008003;
use strict;
use warnings;
use IO::Socket::INET;
use Test::More;
use File::Spec ();
use Fetch;
# RFC 7230 3.3.3: a response carrying both Content-Length and Transfer-Encoding:
# chunked must be framed by the chunked encoding (TE overrides CL), and the
# lingering Content-Length must not truncate the body or desync a keep-alive
# connection into a response-smuggling situation.
my $srv = IO::Socket::INET->new(
LocalHost => '127.0.0.1', LocalPort => 0, Listen => 32, ReuseAddr => 1,
) or plan skip_all => "cannot listen: $!";
my $port = $srv->sockport;
my $base = "http://127.0.0.1:$port";
my $pid = fork;
plan skip_all => "cannot fork: $!" unless defined $pid;
if (!$pid) {
# Never hold the harness TAP pipe open, and never outlive the run:
# a leaked server child hangs the whole suite after this test is done.
open STDOUT, ">", File::Spec->devnull();
open STDERR, ">", File::Spec->devnull();
alarm 120;
$SIG{TERM} = sub { exit 0 };
# Serve two requests on ONE keep-alive connection. The first response has a
# deliberately-wrong Content-Length: 3 alongside a 12-byte chunked body.
my $c = $srv->accept or exit 0;
my $n = 0;
while (1) {
defined(my $l = <$c>) or last;
while (my $line = <$c>) { last if $line eq "\r\n" }
$n++;
if ($n == 1) {
# CL says 3 bytes; chunked body is "HELLO"+"WORLD!!" = 12 bytes
print $c "HTTP/1.1 200 OK\r\n"
t/18-cl-te.t view on Meta::CPAN
my $b = "second";
print $c "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\n"
. "Content-Length: " . length($b) . "\r\n\r\n" . $b;
last;
}
}
close $c;
exit 0;
}
my $ua = Fetch->new(keep_alive => 1);
my $r1 = $ua->get("$base/one")->get;
is($r1->content, 'HELLOWORLD!!',
'CL+TE: full chunked body decoded, not truncated at Content-Length');
# If the first response had desynced (leftover chunk bytes attributed to the
# next response), this second request on the same keep-alive conn would be
# mis-parsed. It must come back clean.
my $r2 = $ua->get("$base/two")->get;
is($r2->content, 'second', 'keep-alive after CL+TE response is not desynced');
done_testing;
# In an END block, and SIGKILL: a die anywhere above must not leave a server
# child holding the harness's TAP pipe open.
END { local $?; if ($pid) { kill 'KILL', $pid; waitpid $pid, 0 } }
t/19-clone.t view on Meta::CPAN
alarm 120;
# sets a cookie every time, and reports whichever one it was sent
for (1 .. 8) {
accept(my $cl, $srv) or last;
my $req = '';
while (sysread($cl, my $b, 4096)) { $req .= $b; last if $req =~ /\r\n\r\n/ }
my ($seen) = $req =~ /^Cookie:[ \t]*(.*?)\r\n/mi;
my $body = defined $seen ? "saw:$seen" : "saw:none";
# This server closes after every response, so say so: without it
# the client is entitled to pool the connection and the next
# request races the close. Keep-alive reuse is t/20's subject,
# cookie isolation is this one's.
syswrite($cl, "HTTP/1.1 200 OK\r\nSet-Cookie: sid=secret; Path=/\r\n"
. "Connection: close\r\n"
. "Content-Length: " . length($body) . "\r\n\r\n$body");
close $cl;
}
exit 0;
}
close $srv;
t/20-stale-keepalive.t view on Meta::CPAN
#!perl
use strict;
use warnings;
use Test::More;
use File::Spec ();
use Socket ();
use Fetch;
# A pooled keep-alive connection can be closed by the server at the very
# moment it is reused: the FIN is still in flight when the pool peeks at the
# socket, so it looks healthy, and the request goes out onto a socket that is
# already gone. That is a lost race rather than a failed request, and a client
# over a pool has to survive it - so Fetch redials and sends the request
# again. It must only do that when replaying the request is safe.
# The losing side of that race, deterministically: connection 1 answers its
# first request and then hangs up on the second without answering it.
# Connection 2 onwards answers everything.
sub start_server {
xs/fetch.xs view on Meta::CPAN
MODULE = Fetch PACKAGE = Fetch
PROTOTYPES: DISABLE
# ---- user agent ----------------------------------------------------------
# Fetch->new(%args): loop, headers, agent, tls_verify, max_redirects, timeout,
# keep_alive, cookie_jar, pool_size. The object is a blessed IV over an ft_ua.
SV *
new(class, ...)
SV *class
CODE:
{
const char *cls = (SvROK(class) && SvOBJECT(SvRV(class)))
? HvNAME(SvSTASH(SvRV(class))) : SvPV_nolen(class);
RETVAL = ft_ua_new(aTHX_ cls, &ST(1), items - 1); /* shared with the ABI */
}
OUTPUT:
xs/fetch.xs view on Meta::CPAN
void
DESTROY(self)
SV *self
CODE:
{
ft_ua *ua = ft_ua_of(aTHX_ self);
if (ua) {
/* Free the pool before the loop: parked connections stay armed for
* READ (see ft_conn_park), so freeing them unwatches on the loop -
* which must still be alive. A native loop's ft_loop* is owned by
* ua->loop, so releasing it first would leave the pool's connections
* unwatching a freed loop (use-after-free). */
if (ua->pool) SvREFCNT_dec(ua->pool);
if (ua->loop) SvREFCNT_dec(ua->loop);
if (ua->headers) SvREFCNT_dec(ua->headers);
if (ua->agent) SvREFCNT_dec(ua->agent);
if (ua->cookie_jar) SvREFCNT_dec(ua->cookie_jar);
Safefree(ua);
}
}
xs/fetch.xs view on Meta::CPAN
lsv = loop;
bytes = SvPV(req, len);
RETVAL = ft_h1_start(aTHX_ l, lsv, pl, host, port, bytes, len, tls, verify,
timeout, method, scheme, authority, path, headers,
body, on_body, NULL);
hmf_pin_loop(aTHX_ RETVAL, loop); /* only this loop can resolve it */
}
OUTPUT:
RETVAL
# Create a keep-alive connection pool (opaque handle); DESTROY frees it and
# every connection still parked in it.
SV *
_pool_new(max)
int max
CODE:
{
ft_pool *p = ft_pool_new(max);
if (!p) croak("Fetch: out of memory");
RETVAL = sv_bless(newRV_noinc(newSViv(PTR2IV(p))),
gv_stashpv("Fetch::_Pool", GV_ADD));
( run in 1.269 second using v1.01-cache-2.11-cpan-14f38c9f855 )