view release on metacpan or  search on metacpan

lib/Protocol/HAP/HTTP.pm  view on Meta::CPAN

# ex:ts=8 sw=4:
# $OpenBSD$
#
# Copyright (c) 2026 Dick Olsson <hi@senzilla.io>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

use v5.36;

package Protocol::HAP::HTTP;
our $VERSION = '0.1.0';

# Protocol::HAP::HTTP - one HTTP/1.1 codec, for both ends of a connection.
#
# The module is functions over strings. It opens no socket, holds no
# connection state, and never logs. A server calls parse_request and
# build_response; a client calls build_request and parse_response.
#
# message_complete is the framing. A stream socket gives a reader
# whatever arrived, which is not a message: a request can span two
# reads, and two requests can share one. A reader that parses each
# read as a whole message drops the second request and mangles the
# split one. The caller keeps a buffer and asks this function how much
# of it is a message.
#
# The module knows nothing about any protocol built on HTTP. A status
# code that belongs to one application, and the header defaults that
# one application wants, are arguments.

# The bound on a message that a caller does not set for itself. The
# value is generous for a request and small enough that an unpaired
# client cannot make a server hold megabytes.
use constant DEFAULT_MAX_SIZE => 65536;

# The status texts of the codes that RFC 9110 defines. A caller with a
# code of its own passes the text.
my %STATUS_TEXT = (
	200 => 'OK',
	201 => 'Created',
	204 => 'No Content',
	207 => 'Multi-Status',
	304 => 'Not Modified',
	400 => 'Bad Request',
	401 => 'Unauthorized',
	403 => 'Forbidden',
	404 => 'Not Found',
	405 => 'Method Not Allowed',
	408 => 'Request Timeout',
	413 => 'Content Too Large',
	500 => 'Internal Server Error',
	503 => 'Service Unavailable',
);

# message_complete($buffer, %args):
#	Report how many bytes at the front of $buffer form one whole
#	message.
#
#	%args:
#		max_size => $bytes	refuse a message larger than this
#
#	The function returns the length of the message, 0 when more
#	bytes are necessary, and undef when the message is over the
#	limit. A caller that gets undef closes the connection: the peer
#	is either broken or hostile, and no further byte can make the
#	message valid.
sub message_complete ( $buffer, %args )
{
	my $max_size = $args{max_size} // DEFAULT_MAX_SIZE;

	my $end = index $buffer, "\r\n\r\n";
	if ( $end < 0 ) {

		# The header block alone is already over the limit, so
		# no body can make it fit
		return if length($buffer) > $max_size;
		return 0;
	}

	my $head_length = $end + 4;
	my $head        = substr $buffer, 0, $end;

	# The trailing \r is part of the line terminator, and $ under /m
	# matches before the \n only. A class that omits it makes the
	# header match only when it is the last one in the block.
	my ($length) = $head =~ /^Content-Length:[ \t]*(\d+)[ \t\r]*$/mi;
	$length //= 0;

	my $total = $head_length + $length;
	return   if $total > $max_size;
	return 0 if length($buffer) < $total;

	return $total;
}

# parse_request($data):
#	Parse one request message. The function returns a hashref with
#	method, path, version, headers and body. Header names are
#	lowercase, because a peer chooses their case and a caller must
#	not.
#
#	The function returns undef when the request line is not a
#	request line.
sub parse_request ($data)
{
	my ( $head, $body ) = _split_message($data);
	my @lines = split /\r?\n/, $head;

	my $request_line = shift @lines // '';