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