1 94a3f4e9 2024-03-30 thomas #!/usr/bin/env perl
3 94a3f4e9 2024-03-30 thomas # Copyright (c) 2024 Omar Polo <op@openbsd.org>
5 94a3f4e9 2024-03-30 thomas # Permission to use, copy, modify, and distribute this software for any
6 94a3f4e9 2024-03-30 thomas # purpose with or without fee is hereby granted, provided that the above
7 94a3f4e9 2024-03-30 thomas # copyright notice and this permission notice appear in all copies.
9 94a3f4e9 2024-03-30 thomas # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10 94a3f4e9 2024-03-30 thomas # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11 94a3f4e9 2024-03-30 thomas # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12 94a3f4e9 2024-03-30 thomas # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13 94a3f4e9 2024-03-30 thomas # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14 94a3f4e9 2024-03-30 thomas # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15 94a3f4e9 2024-03-30 thomas # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
17 94a3f4e9 2024-03-30 thomas use v5.36;
18 94a3f4e9 2024-03-30 thomas use IPC::Open2;
19 94a3f4e9 2024-03-30 thomas use Getopt::Long qw(:config bundling);
21 f0b0cfba 2024-04-25 thomas.ad my $auth;
22 94a3f4e9 2024-03-30 thomas my $port = 8000;
24 f0b0cfba 2024-04-25 thomas.ad GetOptions("a:s" => \$auth, "p:i" => \$port)
25 f0b0cfba 2024-04-25 thomas.ad or die("usage: $0 [-a auth] [-p port]\n");
27 94a3f4e9 2024-03-30 thomas my $pid = open2(my $out, my $in, 'nc', '-l', 'localhost', $port);
30 94a3f4e9 2024-03-30 thomas while (<$out>) {
31 94a3f4e9 2024-03-30 thomas local $/ = "\r\n";
34 94a3f4e9 2024-03-30 thomas last if /^$/;
36 94a3f4e9 2024-03-30 thomas if (m/^POST/) {
37 94a3f4e9 2024-03-30 thomas die "bad http request" unless m,^POST / HTTP/1.1$,;
41 94a3f4e9 2024-03-30 thomas if (m/^Host:/) {
42 94a3f4e9 2024-03-30 thomas die "bad Host header" unless /^Host: localhost:$port$/;
46 94a3f4e9 2024-03-30 thomas if (m/^Content-Type/) {
47 94a3f4e9 2024-03-30 thomas die "bad content-type header"
48 94a3f4e9 2024-03-30 thomas unless m,Content-Type: application/json$,;
52 94a3f4e9 2024-03-30 thomas if (m/^Content-Length/) {
53 94a3f4e9 2024-03-30 thomas die "double content-length" if defined $clen;
54 94a3f4e9 2024-03-30 thomas die "bad content-length header"
55 94a3f4e9 2024-03-30 thomas unless m/Content-Length: (\d+)$/;
56 94a3f4e9 2024-03-30 thomas $clen = $1;
60 94a3f4e9 2024-03-30 thomas if (m/Connection/) {
61 94a3f4e9 2024-03-30 thomas die "bad connection header"
62 94a3f4e9 2024-03-30 thomas unless m/Connection: close$/;
66 f0b0cfba 2024-04-25 thomas.ad if (m/Authorization/) {
67 f0b0cfba 2024-04-25 thomas.ad die "bad authorization header"
68 f0b0cfba 2024-04-25 thomas.ad unless m/Authorization: basic (.*)$/;
69 f0b0cfba 2024-04-25 thomas.ad my $t = $1;
70 f0b0cfba 2024-04-25 thomas.ad die "wrong authorization; got $t want $auth"
71 f0b0cfba 2024-04-25 thomas.ad if not defined($auth) or $auth ne $t;
76 94a3f4e9 2024-03-30 thomas die "no Content-Length header" unless defined $clen;
78 94a3f4e9 2024-03-30 thomas while ($clen != 0) {
79 94a3f4e9 2024-03-30 thomas my $len = $clen;
80 94a3f4e9 2024-03-30 thomas $len = 512 if $clen > 512;
82 94a3f4e9 2024-03-30 thomas my $r = read($out, my $buf, $len);
83 94a3f4e9 2024-03-30 thomas $clen -= $r;
85 94a3f4e9 2024-03-30 thomas print $buf;
89 94a3f4e9 2024-03-30 thomas print $in "HTTP/1.1 200 OK\r\n";
90 94a3f4e9 2024-03-30 thomas print $in "Content-Length: 0\r\n";
91 94a3f4e9 2024-03-30 thomas print $in "Connection: close\r\n";
92 94a3f4e9 2024-03-30 thomas print $in "\r\n";
94 94a3f4e9 2024-03-30 thomas close $in;
95 94a3f4e9 2024-03-30 thomas close $out;
97 94a3f4e9 2024-03-30 thomas waitpid($pid, 0);
98 94a3f4e9 2024-03-30 thomas exit $? >> 8;
