diff --git a/FU.pm b/FU.pm index 30ae4b4..cd8bc41 100644 --- a/FU.pm +++ b/FU.pm @@ -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; - # 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 $!; + 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 = $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, - ); - return if $c{init} && !@_; # already checked if we need to spawn + state %c; + return if keys %c && !@_; # already checked if we need to spawn - %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}; + 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] ? @_ : (), + ); + debug $ENV{FU_DEBUG} if exists $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("

Hello, $who!

"); + }; + + 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 module is a web framework. The C 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 - JSON parsing & formatting. + +=item * L - 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 to read running configuration from environment +variables and command-line arguments during early startup, see L below. + +I + +=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). 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. + +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), 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 and registering +L, it should call C 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, I, +I, I, I, I. + +=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 can be an C +combination to listen on TCP, or a path (optionally prefixed with C) 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 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. + +=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 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, +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 causes all worker processes to reload +their code. In both modes, C or C can be used to trigger a +clean shutdown. + +I Alternate FastCGI spawning options & server config examples. diff --git a/FU.xs b/FU.xs index f2aee9e..759fd89 100644 --- a/FU.xs +++ b/FU.xs @@ -1,8 +1,11 @@ #include #include -#include -#include -#include +#include /* strerror() */ +#include /* inet_ntop(), inet_ntoa() */ +#include /* fd passing */ +#include /* fd passing */ +#include /* 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 diff --git a/FU/Pg.pm b/FU/Pg.pm index f3d15e0..fd275c0 100644 --- a/FU/Pg.pm +++ b/FU/Pg.pm @@ -42,7 +42,7 @@ directly with C. =over -=item B<< FU::Pg->connect($string) >> +=item FU::Pg->connect($string) Connect to the PostgreSQL server and return a new C object. C<$string> can either be in key=value format or a URI, refer to L. -=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 method. Also available directly as C. -=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 if that information is not available for the given command (like with C). -=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 and C 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) 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 @@ -223,7 +223,7 @@ if no rows are returned or if its value is I. 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 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 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: diff --git a/FU/Util.pm b/FU/Util.pm index 23afdf1..e5d82d8 100644 --- a/FU/Util.pm +++ b/FU/Util.pm @@ -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 and L are perfectly fine alternatives. L and L also look like good and maintained candidates.) + + +=head2 File Descriptor Passing + +UNIX sockets (see L) 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 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. + +=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: 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 message may be split across +multiple C 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 flag and will thus survive a call to C. +Refer to L +for more weirdness and edge cases. + +=back + +See also L for a more portable solution, although that one does not +support passing along regular data. diff --git a/README.md b/README.md index 23113a4..c677c71 100644 --- a/README.md +++ b/README.md @@ -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`. diff --git a/c/fdpass.c b/c/fdpass.c new file mode 100644 index 0000000..74a1229 --- /dev/null +++ b/c/fdpass.c @@ -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; +} diff --git a/c/pgconn.c b/c/pgconn.c index c96fdde..09f08cf 100644 --- a/c/pgconn.c +++ b/c/pgconn.c @@ -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) { diff --git a/t/fdpass.t b/t/fdpass.t new file mode 100644 index 0000000..dabc38f --- /dev/null +++ b/t/fdpass.t @@ -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;