3 # Copyright (c) 2024 Omar Polo <op@openbsd.org>
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.
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.
19 use Getopt::Long qw(:config bundling);
24 GetOptions("a:s" => \$auth, "p:i" => \$port)
25 or die("usage: $0 [-a auth] [-p port]\n");
27 my $pid = open2(my $out, my $in, 'nc', '-l', 'localhost', $port);
37 die "bad http request" unless m,^POST / HTTP/1.1$,;
42 die "bad Host header" unless /^Host: localhost:$port$/;
46 if (m/^Content-Type/) {
47 die "bad content-type header"
48 unless m,Content-Type: application/json$,;
52 if (m/^Content-Length/) {
53 die "double content-length" if defined $clen;
54 die "bad content-length header"
55 unless m/Content-Length: (\d+)$/;
61 die "bad connection header"
62 unless m/Connection: close$/;
66 if (m/Authorization/) {
67 die "bad authorization header"
68 unless m/Authorization: basic (.*)$/;
70 die "wrong authorization; got $t want $auth"
71 if not defined($auth) or $auth ne $t;
76 die "no Content-Length header" unless defined $clen;
80 $len = 512 if $clen > 512;
82 my $r = read($out, my $buf, $len);
89 print $in "HTTP/1.1 200 OK\r\n";
90 print $in "Content-Length: 0\r\n";
91 print $in "Connection: close\r\n";