vndb/fu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

FU: Implement --monitor, add some docs; FU::Util: add fdpass functions

Browse source
This commit is contained in:
Yorhel 2025-02-15 14:58:00 +01:00
parent 09fe50d2a2
commit 3e84a4f4d3
8 changed files with 480 additions and 99 deletions
Download patch file Download diff file Expand all files Collapse all files

313
FU.pm
View file

@ -3,6 +3,7 @@ use v5.36;
use Carp 'confess';
use IO::Socket;
use POSIX;
use FU::Util;
sub import($pkg, @opt) {
@ -21,10 +22,10 @@ our $fu = bless {}, 'FU::obj'; # App request-local data
sub fu() { $fu }
sub debug :lvalue () { state $v = 0 }
sub log_slow_pages :lvalue () { state $v = 0 }
sub log_queries :lvalue () { state $v = 0 }
sub max_request_body :lvalue () { state $v = 10*1024*1024 }
sub debug { state $v = 0; $v = $_[0] if @_; $v }
sub log_slow_pages { state $v = 0; $v = $_[0] if @_; $v }
sub log_queries { state $v = 0; $v = $_[0] if @_; $v }
sub max_request_body { state $v = 10*1024*1024; $v = $_[0] if @_; $v }
sub mime_types() { state $v = {qw{
7z application/x-7z-compressed
@ -151,6 +152,29 @@ my %onerr = (
sub on_error :prototype($&) { $onerr{$_[0]} = $_[1] }
my($monitor_check, @monitor_paths);
sub monitor_path { push @monitor_paths, @_ }
sub monitor_check :prototype(&) { $monitor_check = $_[0] }
sub _monitor {
state %data;
return 1 if $monitor_check && $monitor_check->();
require File::Find;
eval {
File::Find::find({
wanted => sub {
my $m = (stat)[9];
$data{$_} //= $m;
die if $m > $data{$_};
},
no_chdir => 1
}, $0, values %INC, @monitor_paths);
0
} // 1;
}
sub _decode_utf8 {
fu->error(400, 'Invalid UTF-8 in request') if !utf8::decode($_[0]);
# Disallow any control codes, except for x09 (tab), x0a (newline) and x0d (carriage return)
@ -211,7 +235,12 @@ sub _log_err($e) {
}
sub _do_req($c) {
# TODO: check for changes if $c->{monitor}
if ($c->{monitor} && _monitor) {
warn "File change detected, restarting process.\n" if debug;
FU::Util::fdpass_send(fileno($c->{supervisor_sock}), fileno($c->{client_sock}), 'f0000');
exit;
}
local $REQ = {};
local $fu = bless {}, 'FU::obj';
@ -284,16 +313,14 @@ sub _supervisor($c) {
fcntl $c->{listen_sock}, Fcntl::F_SETFD(), 0;
fcntl $wsock, Fcntl::F_SETFD(), 0;
my @child_cmd = (
$^X, (map "-I$_", @INC), $0,
$c->{monitor} ? '--monitor' : '--no-monitor',
$c->{max_reqs} ? "--max-reqs=$c->{max_reqs}" : (),
debug ? '--debug' : '--no-debug',
'--supervisor-fd='.fileno($wsock),
'--listen-fd='.fileno($c->{listen_sock}),
);
$ENV{FU_MONITOR} = $c->{monitor};
$ENV{FU_MAX_REQS} = $c->{max_reqs};
$ENV{FU_DEBUG} = debug;
$ENV{FU_SUPERVISOR_FD} = fileno $wsock;
$ENV{FU_LISTEN_FD} = fileno $c->{listen_sock};
my $err = 0;
my @client_fd;
while (1) {
while ((my $pid = waitpid(-1, POSIX::WNOHANG())) > 0) {
$err = 1 if POSIX::WIFEXITED($?) && POSIX::WEXITSTATUS($?) != 0;
@ -307,72 +334,74 @@ sub _supervisor($c) {
# Don't bother spawning more than 1 at a time while in error state
my $spawn = !$err ? $c->{proc} - keys %childs : (grep $_ == 1, values %childs) ? 0 : 1;
for (1..$spawn) {
my $client = shift @client_fd;
my $pid = fork;
die $! if !defined $pid;
if (!$pid) { # child
$SIG{CHLD} = $SIG{HUP} = $SIG{INT} = $SIG{TERM} = undef;
if ($client) {
$ENV{FU_CLIENT_FD} = $client;
} elsif ($err) {
# In error state, wait with loading the script until we've received a request.
# Otherwise we'll end up in an infinite spawning loop if the script doesn't start properly.
my $sock;
if ($err) {
$sock = $c->{listen_sock}->accept() or die $!;
my $sock = $c->{listen_sock}->accept() or die $!;
fcntl $sock, Fcntl::F_SETFD, 0 if $sock;
$ENV{FU_CLIENT_FD} = fileno $sock;
}
exec @child_cmd, $sock ? '--client-fd='.fileno($sock) : ();
exec $^X, (map "-I$_", @INC), $0;
exit 1;
}
$client && IO::Socket->new_from_fd($client, 'r'); # close() the fd if we have one
$childs{$pid} = 1;
}
next if ($rsock->sysread(my $cmd, 5)//0) != 5;
next if $cmd eq 'c0000'; # child died
# Assumption: we never get short reads.
my ($fd, $msg) = FU::Util::fdpass_recv(fileno($rsock), 5);
push @client_fd, $fd if $fd;
next if !$msg;
next if $msg eq 'c0000'; # child died
next if $msg eq 'f0000'; # child is about to exit and passed a client fd to us
if ($cmd =~ /^r/) { # child ready
my $pid = unpack 'V', substr $cmd, 1;
if ($msg =~ /^r/) { # child ready
my $pid = unpack 'V', substr $msg, 1;
$childs{$pid} = 2 if $childs{$pid};
$err = 0;
}
# TODO: Socket passing thing for autoreloading childs
}
}
sub _spawn {
state %c = (
listen_sock => undef,
client_sock => undef,
supervisor_sock => undef,
init => 0,
state %c;
return if keys %c && !@_; # already checked if we need to spawn
if (!keys %c) {
%c = (
http => $ENV{FU_HTTP} // '127.0.0.1:3000',
fcgi => $ENV{FU_FCGI},
proc => $ENV{FU_PROC} // 1,
monitor => $ENV{FU_MONITOR} // 0,
max_reqs => $ENV{FU_MAX_REQS} // 0,
listen_sock => $ENV{FU_LISTEN_FD} && IO::Socket->new_from_fd($ENV{FU_LISTEN_FD}, 'r'),
client_sock => $ENV{FU_CLIENT_FD} && IO::Socket->new_from_fd($ENV{FU_CLIENT_FD}, 'r+'),
supervisor_sock => $ENV{FU_SUPERVISOR_FD} && IO::Socket->new_from_fd($ENV{FU_SUPERVISOR_FD}, 'w'),
!$ENV{FU_SUPERVISOR_FD} && @_ && defined $_[0] ? @_ : (),
);
return if $c{init} && !@_; # already checked if we need to spawn
debug $ENV{FU_DEBUG} if exists $ENV{FU_DEBUG};
%c = (%c, @_, init => 1) if @_ && defined $_[0];
if (!$c{init}++) {
$c{http} = $ENV{FU_HTTP} // '127.0.0.1:3000';
$c{fcgi} = $ENV{FU_FCGI};
$c{proc} = $ENV{FU_PROC} // 1;
$c{monitor} = $ENV{FU_MONITOR};
$c{max_reqs} = $ENV{FU_MAX_REQS};
debug = 1 if $ENV{FU_DEBUG};
for (@ARGV) {
for (@_ ? () : @ARGV) {
$c{http} = $1 if /^--http=(.+)$/;
$c{fcgi} = $1 if /^--fcgi=(.+)$/;
$c{proc} = $1 if /^--proc=([0-9]+)$/;
$c{monitor} = 1 if /^--monitor$/;
$c{monitor} = 0 if /^--no-monitor$/;
$c{max_reqs} = $1 if /^--max-reqs=([0-9]+)$/;
debug = 1 if /^--debug$/;
debug = 0 if /^--no-debug$/;
$c{listen_sock} = IO::Socket->new_from_fd($1, 'r') if /^--listen-fd=([0-9]+)$/;
$c{client_sock} = IO::Handle->new_from_fd($1, 'r+') if /^--client-fd=([0-9]+)$/;
$c{supervisor_sock} = IO::Handle->new_from_fd($1, 'w') if /^--supervisor-fd=([0-9]+)$/;
debug 1 if /^--debug$/;
debug 0 if /^--no-debug$/;
}
};
# Single process, no need for a supervisor
my $need_supervisor = !$c{supervisor_sock} && !$c{client_sock}
&& ($c{proc} > 1 || $c{monitor} || $c{max_reqs});
my $need_supervisor = !$c{supervisor_sock} && !$c{client_sock} && ($c{proc} > 1 || $c{monitor} || $c{max_reqs});
return if !@_ && !$need_supervisor;
if (!$c{listen_sock}) {
@ -423,7 +452,7 @@ package FU::obj;
use Carp 'confess';
sub fu() { $FU::fu }
sub debug :lvalue { FU::debug }
sub debug { FU::debug }
sub db_conn { $FU::DB || FU::_connect_db }
@ -553,14 +582,194 @@ __END__
=head1 NAME
FU - A collection of awesome modules plus a lean and efficient web framework.
FU - Framework Ultimatum: A Lean and Efficient Zero-Dependency Web Framework.
=head1 SYNOPSIS
use v5.36;
use FU -spawn;
FU::get qr{/hello/(.+)}, sub($who) {
fu->set_body("<h1>Hello, $who!</h1>");
};
FU::run;
=head1 DESCRIPTION
=head2 Properties
=head2 Distribution Overview
- Requires a moderately recent Perl (>= 5.36).
- Only works on 64-bit Linux (and possibly *BSD).
- Assumes that no threading is used; not all modules are thread-safe.
This top-level C<FU> module is a web framework. The C<FU> distribution also
includes a bunch of modules that the framework depends on or which are
otherwise useful when building web backends. These modules are standalone and
can be used independently of the framework:
=over
=item * L<FU::Util> - JSON parsing & formatting.
=item * L<FU::Pg> - PostgreSQL client.
=back
Note that everything in this distribution requires a moderately recent version
of Perl (5.36+), a C compiler and a 64-bit POSIXy system (not Windows, that
is).
=head2 Framework Overview
=head2 Importing FU
You'll usually want to add the following statement somewhere near the top of
your script:
use FU -spawn;
The C<-spawn> option tells C<FU> to read running configuration from environment
variables and command-line arguments during early startup, see L</"Running the
Site"> below.
I<TODO: more import options>
=head2 Framework Configuration
=over
=item FU::monitor_path(@paths)
Add filesystem paths to be monitored for changes when running in monitor mode
(see C<--monitor> in L</"Running the Site">). When given a directory, all files
under the directory are recursively checked. The given paths do not actually
have to exist, errors are silently discarded. Relative paths are resolved to
the current working directory at the time that the paths are checked for
changes, so you may want to pass absolute paths if you ever call C<chdir()>.
You do not have to add the current script or files in C<%INC>, these are
monitored by default.
=item FU::monitor_check($sub)
Register a subroutine to be called in monitor mode. The subroutine should
return a true value to signal that something has changed and the process should
reload, false otherwise. The subroutine is called before any filesystem paths
are checked (as in C<FU::monitor_path>), so if you run any build system things
here, file modifications are properly detected and trigger a reload.
Only one subroutine can be registered at a time. Be careful to ensure that the
subroutine returns a false value at some point, otherwise you may end up in a
restart loop.
=back
=head2 Handlers & Routing
=head2 The 'fu' Object
=head2 Request Information
=head2 Generating Responses
=head2 Running the Site
When your script is done setting L</"Framework Configuration"> and registering
L</"Handlers & Routing">, it should call C<FU::run> to actually start serving
the website:
=over
=item FU::run(%options)
In normal circumstances, this function does not return.
When FU has been loaded with the C<-spawn> flag, C<%options> are read from the
environment variables or command line arguments documented below. Otherwise,
the following corresponding options can be passed instead: I<http>, I<fcgi>,
I<proc>, I<monitor>, I<max_reqs>, I<listen_sock>.
=back
Command-line options are read only when FU has been loaded with C<-spawn>, the
environment variables are always read.
=over
=item FU_HTTP=addr
=item --http=addr
Start a local web server on the given address. I<addr> can be an C<ip:port>
combination to listen on TCP, or a path (optionally prefixed with C<unix:>) to
listen on a UNIX socket. E.g.
./your-script.pl --http=127.0.0.1:8000
./your-script.pl --http=unix:/path/to/socket
B<WARNING:> The built-in HTTP server is only intended for local development
setups, it is NOT suitable for production deployments in its current form. It
does not enforce a limit on request header size, does not support HTTPS and has
no provisions for extracting the client IP address when behind a reverse proxy.
Please use FastCGI instead for internet-facing deployments.
=item FU_FCGI=addr
=item --fcgi=addr
Like the HTTP counterpart above, but listen on a FastCGI socket instead. If
this option is set, it takes precedence over the HTTP option.
=item FU_PROC=n
=item --proc=n
How many worker processes to spawn, defaults to 1.
=item FU_MONITOR=0/1
=item --monitor or --no-monitor
When enabled, worker processes will monitor for file changes and automatically
restart on changes. This is immensely useful during development, but comes at a
significant cost in performance - better not enable this in production.
=item FU_MAX_REQS=n
=item --max-reqs=n
Worker processes can automatically restart after handling a number of requests.
Set to 0 (the default) to disable this feature. This option can be useful when
your worker processes keep accumulating memory over time. A little pruning here
and there can never hurt.
=item FU_DEBUG=0/1
=item --debug or --no-debug
Set the initial value for C<FU::debug>.
=item LISTEN_FD=num
Listen for incoming connections on the given file descriptor instead of
creating a new listen socket. This is mainly useful if you are using an
external process manager.
=back
When C<--monitor> or C<--max-reqs> are set or C<<--proc>> is larger than 1, FU
starts a supervisor process to ensure the requested number of worker processes
are running and that they are restarted when necessary. When FU has been loaded
with the C<-spawn> flag, this supervisor process runs directly from the context
of the C<use FU> statement - that is, before the rest of your script has even
loaded. This saves valuable resources: the supervisor has no need of your
website code nor does it need an active connection to your database to do its
job. Without the C<-spawn> flag, the supervisor has to run from C<FU::run>,
which is less efficient but does allow for more flexible configuration from
within your script.
When not running in supervisor mode, no separate worker processes are started
and requests are instead handled directly in the starting process.
In supervisor mode, sending C<SIGHUP> causes all worker processes to reload
their code. In both modes, C<SIGTERM> or C<SIGINT> can be used to trigger a
clean shutdown.
I<TODO:> Alternate FastCGI spawning options & server config examples.

19
FU.xs
View file

@ -1,8 +1,11 @@
#include <stdio.h>
#include <errno.h>
#include <string.h>
#include <arpa/inet.h>
#include <dlfcn.h>
#include <string.h> /* strerror() */
#include <arpa/inet.h> /* inet_ntop(), inet_ntoa() */
#include <sys/socket.h> /* fd passing */
#include <sys/un.h> /* fd passing */
#include <dlfcn.h> /* dlopen() etc */
#undef PERL_IMPLICIT_SYS
#define PERL_NO_GET_CONTEXT
@ -21,6 +24,7 @@
#include "c/common.c"
#include "c/jsonfmt.c"
#include "c/jsonparse.c"
#include "c/fdpass.c"
#include "c/libpq.h"
#include "c/pgtypes.c"
#include "c/pgconn.c"
@ -81,6 +85,15 @@ void json_parse(SV *val, ...)
CODE:
ST(0) = fujson_parse_xs(aTHX_ ax, items, val);
void fdpass_send(int socket, int fd, SV *data)
CODE:
STRLEN buflen;
const char *buf = SvPVbyte(data, buflen);
ST(0) = sv_2mortal(newSViv(fufdpass_send(socket, fd, buf, buflen)));
void fdpass_recv(int socket, UV len)
CODE:
XSRETURN(fufdpass_recv(aTHX_ ax, socket, len));
MODULE = FU PACKAGE = FU::Pg

78
FU/Pg.pm
View file

@ -42,7 +42,7 @@ directly with C<libpq>.
=over
=item B<< FU::Pg->connect($string) >>
=item FU::Pg->connect($string)
Connect to the PostgreSQL server and return a new C<FU::Pg::conn> object.
C<$string> can either be in key=value format or a URI, refer to L<the
@ -52,17 +52,17 @@ for the full list of supported formats and options. You may also pass an empty
string and leave the configuration up L<environment
variables|https://www.postgresql.org/docs/current/libpq-envars.html>.
=item B<< $conn->server_version >>
=item $conn->server_version
Returns the version of the PostgreSQL server as an integer in the format of
C<$major * 10000 + $minor>. For example, returns 170002 for PostgreSQL 17.2.
=item B<< $conn->lib_version >>
=item $conn->lib_version
Returns the libpq version in the same format as the C<server_version> method.
Also available directly as C<FU::Pg::lib_version()>.
=item B<< $conn->status >>
=item $conn->status
Returns a string indicating the status of the connection. Note that this method
does not verify that the connection is still alive, the status is updated after
@ -95,17 +95,17 @@ Connection is dead or otherwise unusable.
=back
=item B<< $conn->cache($enable) >>
=item $conn->cache($enable)
=item B<< $conn->text_params($enable) >>
=item $conn->text_params($enable)
=item B<< $conn->text_results($enable) >>
=item $conn->text_results($enable)
=item B<< $conn->text($enable) >>
=item $conn->text($enable)
Set the default settings for new statements created with B<< $conn->q() >>.
=item B<< $conn->cache_size($num) >>
=item $conn->cache_size($num)
Set the number of prepared statements to keep in the cache. Defaults to 256.
@ -114,7 +114,7 @@ Prepared statements that still have an active C<$st> object are not counted
towards this number. The cache works as an LRU: when it's full, the statement
that hasn't been used for the longest time is reclaimed.
=item B<< $conn->disconnect >>
=item $conn->disconnect
Close the connection. Any active transactions are rolled back and any further
attempts to use C<$conn> throw an error.
@ -125,13 +125,13 @@ attempts to use C<$conn> throw an error.
=over
=item B<< $conn->exec($sql) >>
=item $conn->exec($sql)
Execute one or more SQL commands, separated by a semicolon. Returns the number
of rows affected by the last statement or I<undef> if that information is not
available for the given command (like with C<CREATE TABLE>).
=item B<< $conn->q($sql, @params) >>
=item $conn->q($sql, @params)
Create a new SQL statement with the given C<$sql> string and an optional list
of bind parameters. C<$sql> can only hold a single statement.
@ -154,19 +154,19 @@ configuration parameters:
=over
=item B<< $st->cache($enable) >>
=item $st->cache($enable)
Enable or disable caching of the prepared statement for this particular query.
=item B<< $st->text_params($enable) >>
=item $st->text_params($enable)
Enable or disable sending bind parameters in the text format.
=item B<< $st->text_results($enable) >>
=item $st->text_results($enable)
Enable or disable receiving query results in the text format.
=item B<< $st->text($enable) >>
=item $st->text($enable)
Shorthand for setting C<text_params> and C<text_results> at the same time.
@ -176,7 +176,7 @@ Statement objects can be inspected with the following two methods:
=over
=item B<< $st->param_types >>
=item $st->param_types
Returns an arrayref of integers indicating the type (as I<oid>) of each
parameter in the given C<$sql> string. Example:
@ -187,7 +187,7 @@ parameter in the given C<$sql> string. Example:
my $oids = $conn->q('SELECT id FROM books')->params;
# $oids = []
=item B<< $st->columns >>
=item $st->columns
Returns an arrayref of hashrefs describing each column that the statement
returns.
@ -206,7 +206,7 @@ how you'd like to obtain the results:
=over
=item B<< $st->exec >>
=item $st->exec
Execute the query and return the number of rows affected. Similar to C<<
$conn->exec >>.
@ -214,7 +214,7 @@ $conn->exec >>.
my $v = $conn->q('UPDATE books SET read = true WHERE id = 1')->exec;
# $v = 1
=item B<< $st->val >>
=item $st->val
Return the first column of the first row. Throws an error if the query does not
return exactly one column, or if multiple rows are returned. Returns I<undef>
@ -223,7 +223,7 @@ if no rows are returned or if its value is I<NULL>.
my $v = $conn->q('SELECT COUNT(*) FROM books')->val;
# $v = 2
=item B<< $st->rowl >>
=item $st->rowl
Return the first row as a list. Throws an error if the query does not return
exactly one row.
@ -231,7 +231,7 @@ exactly one row.
my($id, $title) = $conn->q('SELECT id, title FROM books LIMIT 1')->rowl;
# ($id, $title) = (1, 'Revelation Space');
=item B<< $st->rowa >>
=item $st->rowa
Return the first row as an arrayref, equivalent to C<< [$st->rowl] >> but
might be slightly more efficient.
@ -239,7 +239,7 @@ might be slightly more efficient.
my $row = $conn->q('SELECT id, title FROM books LIMIT 1')->rowa;
# $row = [1, 'Revelation Space'];
=item B<< $st->rowh >>
=item $st->rowh
Return the first row as a hashref. Also throws an error if the query returns
multiple columns with the same name.
@ -247,7 +247,7 @@ multiple columns with the same name.
my $row = $conn->q('SELECT id, title FROM books LIMIT 1')->rowh;
# $row = { id => 1, title => 'Revelation Space' };
=item B<< $st->alla >>
=item $st->alla
Return all rows as an arrayref of arrayrefs.
@ -257,7 +257,7 @@ Return all rows as an arrayref of arrayrefs.
# [ 2, 'The Invincible' ],
# ];
=item B<< $st->allh >>
=item $st->allh
Return all rows as an arrayref of hashrefs. Throws an error if the query
returns multiple columns with the same name.
@ -268,7 +268,7 @@ returns multiple columns with the same name.
# { id => 2, title => 'The Invincible' },
# ];
=item B<< $st->flat >>
=item $st->flat
Return an arrayref with all rows flattened.
@ -278,7 +278,7 @@ Return an arrayref with all rows flattened.
# 2, 'The Invincible',
# ];
=item B<< $st->kvv >>
=item $st->kvv
Return a hashref where the first result column is used as key and the second
column as value. If the query only returns a single column, C<true> is used as
@ -290,7 +290,7 @@ value instead. An error is thrown if the query returns 3 or more columns.
# 2 => 'The Invincible',
# };
=item B<< $st->kva >>
=item $st->kva
Return a hashref where the first result column is used as key and the remaining
columns are stored as arrayref.
@ -301,7 +301,7 @@ columns are stored as arrayref.
# 2 => [ 'The Invincible', false ],
# };
=item B<< $st->kvh >>
=item $st->kvh
Return a hashref where the first result column is used as key and the remaining
columns are stored as hashref.
@ -355,16 +355,16 @@ Transaction methods:
=over
=item B<< $txn->exec(..) >>
=item $txn->exec(..)
=item B<< $txn->q(..) >>
=item $txn->q(..)
Run a query inside the transaction. These work the same as the respective
methods on the parent C<$conn> object.
=item B<< $txn->commit >>
=item $txn->commit
=item B<< $txn->rollback >>
=item $txn->rollback
Commit or abort the transaction. Any attempts to run queries on this
transaction object after this call will throw an error.
@ -372,13 +372,13 @@ transaction object after this call will throw an error.
Calling C<rollback> is optional, the transaction is automatically rolled back
when the object goes out of scope.
=item B<< $txn->cache($enable) >>
=item $txn->cache($enable)
=item B<< $txn->text_params($enable) >>
=item $txn->text_params($enable)
=item B<< $txn->text_results($enable) >>
=item $txn->text_results($enable)
=item B<< $txn->text($enable) >>
=item $txn->text($enable)
Set the default settings for new statements created with B<< $txn->q() >>.
@ -387,13 +387,13 @@ created. Subtransactions inherit these settings from their parent transaction.
Changing these settings within a transaction does not affect the main
connection or any already existing subtransactions.
=item B<< $txn->txn >>
=item $txn->txn
Create a subtransaction within the current transaction. A subtransaction works
exactly the same as a top-level transaction, except any changes remain
invisible to other sessions until the top-level transaction has been committed.
=item B<< $txn->status >>
=item $txn->status
Like C<< $conn->status >>, but with the following status codes:

47
FU/Util.pm
View file

@ -4,7 +4,10 @@ use v5.36;
use FU::XS;
use Exporter 'import';
our @EXPORT_OK = qw/json_format json_parse/;
our @EXPORT_OK = qw/
json_format json_parse
fdpass_send fdpass_recv
/;
1;
__END__
@ -150,3 +153,45 @@ unnecessary features and C<#ifdef>s to support ancient perls and esoteric
configurations. Still, if you need anything not provided by these functions,
L<JSON::PP> and L<Cpanel::JSON::XS> are perfectly fine alternatives.
L<JSON::SIMD> and L<Mojo::JSON> also look like good and maintained candidates.)
=head2 File Descriptor Passing
UNIX sockets (see L<IO::Socket::UNIX>) have the fancy property of letting you
send file descriptors over them, allowing you to pass, for example, a socket
from one process to another. This is a pretty low-level operation and not
something you'll often need, but two functions to use that feature are provided
here anyway because the L<FU> supervisor uses them:
=over
=item fdpass_send($send_fd, $pass_fd, $message)
Send a message and a file descriptor (C<$pass_fd>) over the given socket
(<$send_fd>). C<$message> must not be empty, even if you don't intend to do
anything with it on receipt. Both C<$send_fd> and C<$pass_fd> must be numeric
file descriptors, as obtained by C<fileno()>.
=item ($fd, $message) = fdpass_recv($recv_fd, $max_message_len)
Read a file descriptor and message from the given C<$recv_fd>, which must be
the numeric file descriptor of a socket. This function can be used as a
replacement for C<sysread()>: the returned C<$fd> is undef if no file
descriptor was received. The returned C<$message> is undef on error or an empty
string on EOF.
Like regular socket I/O, a single C<fdpass_send()> message may be split across
multiple C<fdpass_recv()> calls; in that case the C<$fd> will only be received
on the first call.
Don't use this function if the sender may include multiple file descriptors in
a single message, weird things can happen. File descriptors received this way
do not have the C<CLOEXEC> flag and will thus survive a call to C<exec()>.
Refer to L<this wonderful
discussion|https://gist.github.com/kentonv/bc7592af98c68ba2738f4436920868dc>
for more weirdness and edge cases.
=back
See also L<IO::FDPass> for a more portable solution, although that one does not
support passing along regular data.

1
README.md
View file

@ -17,7 +17,6 @@ make install
Things that may or may not happen:
- FU - The website framework, taking inspiration from TUWF.
- FU::HTTPServer / FU::FastCGI - Minimal libs to support the web framework.
- FU::JSON - JSON::{XS,PP,etc}-compatible wrapper around FU::Util's JSON functions? I prolly won't need this myself, but could be handy.
- FU::Log - Basic logger.
- FU::Util additions: `uri_escape`, `VNDB::Util::query_encode`, `scrypt`, `urandom`.

76
c/fdpass.c Normal file
View file

@ -0,0 +1,76 @@
/* File descriptor passing based on
* https://manned.org/man.c2c6968a/cmsg.3 */
static ssize_t fufdpass_send(int socket, int fd, const char *buf, size_t buflen) {
union {
char buf[CMSG_SPACE(sizeof(int))];
struct cmsghdr align;
} cmsgbuf = {};
struct iovec iov;
iov.iov_base = (char *)buf;
iov.iov_len = buflen;
struct msghdr msg;
msg.msg_name = NULL;
msg.msg_namelen = 0;
msg.msg_iov = &iov;
msg.msg_iovlen = 1;
msg.msg_control = cmsgbuf.buf;
msg.msg_controllen = sizeof(cmsgbuf.buf);
msg.msg_flags = 0;
struct cmsghdr *cmsg = CMSG_FIRSTHDR(&msg);
cmsg->cmsg_level = SOL_SOCKET;
cmsg->cmsg_type = SCM_RIGHTS;
cmsg->cmsg_len = CMSG_LEN(sizeof(int));
memcpy(CMSG_DATA(cmsg), &fd, sizeof(int));
return sendmsg(socket, &msg, 0);
}
static int fufdpass_recv(pTHX_ I32 ax, int socket, size_t len) {
if (GIMME_V != G_LIST)
fu_confess("Invalid use of fdpass_recv() in scalar context");
union {
char buf[CMSG_SPACE(sizeof(int))];
struct cmsghdr align;
} cmsgbuf;
SV *buf = sv_2mortal(newSV(len));
SvPOK_only(buf);
struct iovec iov;
iov.iov_base = SvPVX(buf);
iov.iov_len = len;
struct msghdr msg;
msg.msg_name = NULL;
msg.msg_namelen = 0;
msg.msg_iov = &iov;
msg.msg_iovlen = 1;
msg.msg_control = cmsgbuf.buf;
msg.msg_controllen = sizeof(cmsgbuf.buf);
msg.msg_flags = 0;
ssize_t r = recvmsg(socket, &msg, 0);
if (r < 0) {
ST(0) = &PL_sv_undef;
ST(1) = &PL_sv_undef;
return 2;
}
struct cmsghdr *cmsg = CMSG_FIRSTHDR(&msg);
if (cmsg == NULL || cmsg->cmsg_level != SOL_SOCKET
|| cmsg->cmsg_type != SCM_RIGHTS || cmsg->cmsg_len != CMSG_LEN(sizeof(int))) {
ST(0) = &PL_sv_undef;
} else {
int fd;
memcpy(&fd, CMSG_DATA(cmsg), sizeof(int));
ST(0) = sv_2mortal(newSViv(fd));
}
SvCUR_set(buf, r);
ST(1) = buf;
return 2;
}

2
c/pgconn.c
View file

@ -16,7 +16,7 @@ struct fupg_prep {
};
#define fupg_prep_hash(p) ((p)->hash)
#define fupg_prep_eq(a, b) (strcmp((a)->query, (b)->query) == 0)
#define fupg_prep_eq(a, b) ((a)->hash == (b)->hash && strcmp((a)->query, (b)->query) == 0)
KHASHL_SET_INIT(KH_LOCAL, fupg_prepared, fupg_prepared, fupg_prep *, fupg_prep_hash, fupg_prep_eq);
static void fupg_prep_destroy(fupg_prep *p) {

39
t/fdpass.t Normal file
View file

@ -0,0 +1,39 @@
use v5.36;
use Test::More;
use IO::Socket qw/AF_UNIX SOCK_STREAM PF_UNSPEC/;
BEGIN { use_ok 'FU::Util', qw/fdpass_send fdpass_recv/ }
my ($rd, $wr) = IO::Socket->socketpair(AF_UNIX, SOCK_STREAM, PF_UNSPEC);
is $wr->syswrite("abc", 3), 3;
my ($fd, $buf) = fdpass_recv fileno($rd), 10;
ok !defined $fd;
is $buf, 'abc';
is fdpass_send(fileno($wr), fileno($wr), 'def'), 3;
($fd, $buf) = fdpass_recv fileno($rd), 50;
ok $fd > 0;
is $buf, 'def';
# Check that $fd is indeed an alias for $wr
my $nwr = IO::Socket->new_from_fd($fd, 'w');
is $nwr->syswrite('hij'), 3;
is $rd->sysread($buf, 20), 3;
is $buf, 'hij';
$nwr->close;
$wr->close;
($fd, $buf) = fdpass_recv fileno($rd), 10;
ok !defined $fd;
is $buf, '';
($fd, $buf) = fdpass_recv -1, 10;
ok !defined $fd;
ok !defined $buf;
is fdpass_send(-1, 3, 'x'), -1;
done_testing;