1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
#!/usr/bin/perl
# Copyright (C) 2020 Sean Whitton
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use 5.028;
use strict;
use warnings;
use JSON;
use YAML;
$YAML::UseBlock = 1;
use REST::Client;
use API::GitForge qw(forge_access_token);
use Getopt::Long;
use Git::Wrapper;
use Cwd;
my $user = "~spwhitton"; # TODO could fetch from API
my $dist = "unstable";
my $remote = "origin";
my $quilt = "auto";
GetOptions
"distribution|d=s" => \$dist,
"remote=s" => \$remote,
"quilt=s" => \$quilt;
my $git = Git::Wrapper->new(getcwd);
my ($clone_uri) = $git->remote("get-url", $remote);
chomp(my $source = `dpkg-parsechangelog -SSource`);
chomp(my $version = `dpkg-parsechangelog -SVersion`);
my $note = "Pre-upload checks for $source $version";
$git->fetch($remote);
my ($branch) = $git->symbolic_ref("HEAD");
my ($commit) = $git->rev_parse({ verify => 1 }, "HEAD");
$git->for_each_ref({ contains => $branch }, "refs/remotes/$remote")
or die "remote $remote doesn't appear to have a copy of your HEAD";
my $schroot = "$dist-amd64-sbuild";
my $changes = "${source}_${version}_multi.changes";
my $manifest->{image} = "debian/unstable";
$manifest->{sources} = [$clone_uri];
$manifest->{packages}
= ["autopkgtest", "devscripts", "dgit", "lintian", "piuparts", "sbuild"];
$manifest->{tasks} = [
map +({ $_->[0] => join "\n", $_->[1]->@*, "" }),
[
setup => [
"cd $source",
"git checkout $commit",
"git deborig || origtargz",
join(
" ",
qw(sudo
sbuild-createchroot
--command-prefix=eatmydata
--include=eatmydata),
$dist,
"/srv/chroot/$schroot"
),
"sudo sbuild-adduser \$USER"
]
],
[
build => [
"cd $source",
"dgit --quilt=$quilt sbuild -d $dist --no-run-lintian"
]
],
[lintian => ["lintian $changes"]],
[autopkgtest => ["autopkgtest $changes -- schroot $schroot"]],
[piuparts => ["sudo piuparts --no-eatmydata --schroot $schroot $changes"]]
];
my $client = REST::Client->new;
$client->setHost("https://builds.sr.ht");
$client->addHeader("Authorization", "token " . forge_access_token "sr.ht");
$client->addHeader("Content-Type", "application/json");
$client->addHeader("charset", "UTF-8");
$client->POST(
"/api/jobs",
encode_json {
note => $note,
"access:read" => [$user],
manifest => YAML::Dump $manifest
});
my $resp = decode_json $client->responseContent;
my $job_id = $resp->{id};
system "xdg-open", "https://builds.sr.ht/$user/job/$job_id#bottom";
# $client->GET("/api/jobs");
# my $jobs = decode_json $client->responseContent;
# my ($job) = grep $_->{id} == $job_id, $jobs->{results}->@*;
# my $job_host = $job->{runner};
# system "ssh", "-t", "builds@" . $job_host, "connect", $job_id;
|
