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