3 # Copyright (c) 2024 Omar Polo <op@openbsd.org>
4 # Copyright (c) 2024 Stefan Sperling <stsp@openbsd.org>
6 # Permission to use, copy, modify, and distribute this software for any
7 # purpose with or without fee is hereby granted, provided that the above
8 # copyright notice and this permission notice appear in all copies.
10 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
11 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
12 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
13 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
14 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
15 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
16 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
20 use Getopt::Long qw(:config bundling);
27 my $usage = "usage: $0 [-p port] repo_root_path\n";
28 GetOptions("p:i" => \$port) or die($usage);
30 # $HTTP::Daemon::DEBUG = 1;
32 my $server = HTTP::Daemon->new(
36 LocalHost => '127.0.0.1',
40 ) || die "Could not open socket 127.0.0.1:$port: $IO::Socket::errstr";
42 $ENV{GIT_HTTP_EXPORT_ALL} = '';
44 $SIG{'PIPE'} = 'IGNORE';
46 my $repo_root = $ARGV[0];
49 my ($req, $client) = @_;
52 my $path = $req->uri->path;
53 $ENV{PATH_TRANSLATED} = "/$repo_root/$path";
54 $ENV{REQUEST_METHOD} = 'GET';
55 $ENV{QUERY_STRING} = $req->uri->query;
57 my $gitpid = open2(my $gitout, my $gitin, 'git', 'http-backend');
61 my $headers = HTTP::Headers->new;
62 my ($status_code, $status) = (200, "OK");
68 if (m/^Status: ([0-9]+)(.*)$/) {
69 ($status_code, $status) = ($1, $2);
74 # XXX we don't support 'folded' headers
75 my ($name, $value) = split(':', $_);
76 $headers->header($name => $value);
79 my $resp = HTTP::Response->new($status_code, $status, $headers,
81 my $r = read($gitout, my $buf, 1024);
82 warn "error reading git output: $!" unless defined $r;
83 return undef if not defined($r) or $r == 0;
87 $client->send_response($resp);
92 printf "GET %s: 200 OK\n", $req->uri->path;
96 my ($req, $client) = @_;
99 my $path = $req->uri->path;
100 $ENV{PATH_TRANSLATED} = "/$repo_root/$path";
101 $ENV{REQUEST_METHOD} = 'POST';
102 $ENV{QUERY_STRING} = "";
103 $ENV{CONTENT_TYPE} = $req->header('Content-Type');
105 my $gitpid = open2(my $gitout, my $gitin, 'git', 'http-backend');
107 my $content = $req->content();
108 my $len = length($content);
110 my $w = syswrite($gitin, $content, $len);
113 $content = substr($content, $w);
116 die "failed to upload payload" if ($len != 0);
120 my $headers = HTTP::Headers->new;
121 my ($status_code, $status) = (200, "OK");
127 if (m/^Status: ([0-9]+)(.*)$/) {
128 ($status_code, $status) = ($1, $2);
133 # XXX we don't support 'folded' headers
134 my ($name, $value) = split(':', $_);
135 $headers->header($name => $value);
138 my $resp = HTTP::Response->new($status_code, $status, $headers,
140 my $r = read($gitout, my $buf, 1024);
141 if (not defined($r) or $r == 0) {
142 warn "read error: $!" unless defined $r;
148 $client->send_response($resp);
153 printf "POST %s: 200 OK\n", $req->uri->path;
157 my $client = $server->accept();
159 while (my $req = $client->get_request) {
160 if ($req->method eq "GET") {
161 handle_get($req, $client);
162 } elsif ($req->method eq "POST") {
163 handle_post($req, $client);
165 warn "unknown method ". $req->method . "\n";
166 my $res = HTTP::Response->new(405,
167 "Method not Allowed");
168 $client->send_response($res);