#!/usr/bin/env perl # # Copyright (c) 2024 Omar Polo # # 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; use IPC::Open2; use Getopt::Long qw(:config bundling); my $port = 8000; GetOptions("p:i" => \$port) or die("usage: $0 [-p port]\n"); my $pid = open2(my $out, my $in, 'nc', '-l', 'localhost', $port); my $clen; while (<$out>) { local $/ = "\r\n"; chomp; say; last if /^$/; if (m/^POST/) { die "bad http request" unless m,^POST / HTTP/1.1$,; next; } if (m/^Host:/) { die "bad Host header" unless /^Host: localhost:$port$/; next; } if (m/^Content-Type/) { die "bad content-type header" unless m,Content-Type: application/json$,; next; } if (m/^Content-Length/) { die "double content-length" if defined $clen; die "bad content-length header" unless m/Content-Length: (\d+)$/; $clen = $1; next; } if (m/Connection/) { die "bad connection header" unless m/Connection: close$/; next; } } die "no Content-Length header" unless defined $clen; while ($clen != 0) { my $len = $clen; $len = 512 if $clen > 512; my $r = read($out, my $buf, $len); $clen -= $r; print $buf; } say ""; print $in "HTTP/1.1 200 OK\r\n"; print $in "Content-Length: 0\r\n"; print $in "Connection: close\r\n"; print $in "\r\n"; close $in; close $out; waitpid($pid, 0); exit $? >> 8;