1 #!/usr/bin/env perl
2 #
3 # Copyright (c) 2024 Omar Polo <op@openbsd.org>
4 #
5 # Permission to use, copy, modify, and distribute this software for any
6 # purpose with or without fee is hereby granted, provided that the above
7 # copyright notice and this permission notice appear in all copies.
8 #
9 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16 
17 use v5.36;
18 use IPC::Open2;
19 use Getopt::Long qw(:config bundling);
20 
21 my $port = 8000;
22 
23 GetOptions("p:i" => \$port)
24     or die("usage: $0 [-p port]\n");
25 
26 my $pid = open2(my $out, my $in, 'nc', '-l', 'localhost', $port);
27 
28 my $clen;
29 while (<$out>) {
30 	local $/ = "\r\n";
31 	chomp;
32 
33 	last if /^$/;
34 
35 	if (m/^POST/) {
36 		die "bad http request" unless m,^POST / HTTP/1.1$,;
37 		next;
38 	}
39 
40 	if (m/^Host:/) {
41 		die "bad Host header" unless /^Host: localhost:$port$/;
42 		next;
43 	}
44 
45 	if (m/^Content-Type/) {
46 		die "bad content-type header"
47 		    unless m,Content-Type: application/json$,;
48 		next;
49 	}
50 
51 	if (m/^Content-Length/) {
52 		die "double content-length" if defined $clen;
53 		die "bad content-length header"
54 		    unless m/Content-Length: (\d+)$/;
55 		$clen = $1;
56 		next;
57 	}
58 
59 	if (m/Connection/) {
60 		die "bad connection header"
61 		    unless m/Connection: close$/;
62 		next;
63 	}
64 }
65 
66 die "no Content-Length header" unless defined $clen;
67 
68 while ($clen != 0) {
69 	my $len = $clen;
70 	$len = 512 if $clen > 512;
71 
72 	my $r = read($out, my $buf, $len);
73 	$clen -= $r;
74 
75 	print $buf;
76 }
77 say "";
78 
79 print $in "HTTP/1.1 200 OK\r\n";
80 print $in "Content-Length: 0\r\n";
81 print $in "Connection: close\r\n";
82 print $in "\r\n";
83 
84 close $in;
85 close $out;
86 
87 waitpid($pid, 0);
88 exit $? >> 8;