summaryrefslogtreecommitdiffstats
path: root/lib/Devscripts/Salsa/check_repo.pm
blob: d22095b7a0dc3eb7b6642ab45828e6476bd0a2b7 (plain)
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
# Parses repo to check if parameters are well set
package Devscripts::Salsa::check_repo;

use strict;
use Devscripts::Output;
use Digest::MD5  qw(md5_hex);
use Digest::file qw(digest_file_hex);
use LWP::UserAgent;
use Moo::Role;

with "Devscripts::Salsa::Repo";

sub check_repo {
    my $self = shift;
    my ($res) = $self->_check_repo(@_);
    return $res;
}

sub _url_md5_hex {
    my $res = LWP::UserAgent->new->get(shift());
    if (!$res->is_success) {
        return undef;
    }
    return Digest::MD5::md5_hex($res->content);
}

sub _check_repo {
    my ($self, @reponames) = @_;
    my $res = 0;
    my @fail;
    unless (@reponames or $self->config->all or $self->config->all_archived) {
        ds_warn "Usage $0 check_repo <--all|--all-archived|names>";
        return 1;
    }
    if (@reponames and $self->config->all) {
        ds_warn "--all with a reponame makes no sense";
        return 1;
    }
    if (@reponames and $self->config->all_archived) {
        ds_warn "--all-archived with a reponame makes no sense";
        return 1;
    }
    # Get repo list from Devscripts::Salsa::Repo
    my @repos = $self->get_repo(0, @reponames);
    return @repos unless (ref $repos[0]);
    foreach my $repo (@repos) {
        my ($id, $name) = @$repo;
        ds_debug "Checking $name ($id)";
        my @err;
        my $project = eval { $self->api->project($id) };
        unless ($project) {
            ds_debug $@;
            ds_warn "Project $name not found";
            next;
        }
        # check description
        my %prms           = $self->desc($name);
        my %prms_multipart = $self->desc_multipart($name);
        if ($self->config->desc) {
            $project->{description} //= '';
            push @err, "bad description: $project->{description}"
              if ($prms{description} ne $project->{description});
        }
        # check build timeout
        if ($self->config->desc) {
            $project->{build_timeout} //= '';
            push @err, "bad build_timeout: $project->{build_timeout}"
              if ($prms{build_timeout} ne $project->{build_timeout});
        }
        # check features (w/permission) & ci config
        foreach (
            qw(analytics_access_level
            auto_devops_enabled
            builds_access_level
            container_registry_access_level
            forking_access_level
            issues_access_level
            lfs_enabled
            merge_requests_access_level
            packages_enabled
            pages_access_level
            releases_access_level
            repository_access_level
            request_access_enabled
            requirements_access_level
            snippets_access_level
            wiki_access_level
            remove_source_branch_after_merge
            ci_config_path
            request_access_enabled)
        ) {
            push @err, "$_ should be $prms{$_}"
              if (defined $prms{$_}
                and (!defined($project->{$_}) or $project->{$_} ne $prms{$_}));
        }
        # only public projects are accepted
        push @err, "private" unless ($project->{visibility} eq "public");
        # Default branch
        if ($self->config->rename_head) {
            push @err, "Default branch is $project->{default_branch}"
              if ($project->{default_branch} ne $self->config->dest_branch);
        }
        # Webhooks (from Devscripts::Salsa::Hooks)
        my $hooks = $self->enabled_hooks($id);
        unless (defined $hooks) {
            ds_warn "Unable to get $name hooks";
            next;
        }
        # check avatar's path
        if ($self->config->avatar_path) {
            my ($md5_file, $md5_url) = "";
            if ($prms_multipart{avatar}) {
                ds_verbose "Calculating local checksum";
                $md5_file = digest_file_hex($prms_multipart{avatar}, "MD5")
                  or die "$prms_multipart{avatar} failed md5: $!";
                if ($project->{avatar_url}) {
                    ds_verbose "Calculating remote checksum";
                    $md5_url = _url_md5_hex($project->{avatar_url})
                      or die "$project->{avatar_url} failed md5: $!";
                }
                push @err, "Will set the avatar to be: $prms_multipart{avatar}"
                  if ($md5_file ne $md5_url);
            }
        }
        # KGB
        if ($self->config->kgb and not $hooks->{kgb}) {
            push @err, "kgb missing";
        } elsif ($self->config->disable_kgb and $hooks->{kgb}) {
            push @err, "kgb enabled";
        } elsif ($self->config->kgb) {
            push @err,
              "bad irc channel: "
              . substr($hooks->{kgb}->{url},
                length($self->config->kgb_server_url))
              if $hooks->{kgb}->{url} ne $self->config->kgb_server_url
              . $self->config->irc_channel->[0];
            my @wopts = @{ $self->config->kgb_options };
            my @gopts = sort @{ $hooks->{kgb}->{options} };
            my $i     = 0;
            while (@gopts and @wopts) {
                my $a;
                $a = ($wopts[0] cmp $gopts[0]);
                if ($a == -1) {
                    push @err, "Missing KGB option " . shift(@wopts);
                } elsif ($a == 1) {
                    push @err, 'Unwanted KGB option ' . shift(@gopts);
                } else {
                    shift @wopts;
                    shift @gopts;
                }
            }
            push @err, map { "Missing KGB option $_" } @wopts;
            push @err, map { "Unwanted KGB option $_" } @gopts;
        }
        # Email-on-push
        if ($self->config->email
            and not($hooks->{email} and %{ $hooks->{email} })) {
            push @err, "email-on-push missing";
        } elsif (
            $self->config->email
            and $hooks->{email}->{recipients} ne join(
                ' ',
                map {
                    my $a = $_;
                    my $b = $name;
                    $b =~ s#.*/##;
                    $a =~ s/%p/$b/;
                    $a
                } @{ $self->config->email_recipient })
        ) {
            push @err, "bad email recipients " . $hooks->{email}->{recipients};
        } elsif ($self->config->disable_email and $hooks->{kgb}) {
            push @err, "email-on-push enabled";
        }
        # Irker
        if ($self->config->irker and not $hooks->{irker}) {
            push @err, "irker missing";
        } elsif ($self->config->irker
            and $hooks->{irker}->{recipients} ne
            join(' ', map { "#$_" } @{ $self->config->irc_channel })) {
            push @err, "bad irc channel: " . $hooks->{irker}->{recipients};
        } elsif ($self->config->disable_irker and $hooks->{irker}) {
            push @err, "irker enabled";
        }
        # Tagpending
        if ($self->config->tagpending and not $hooks->{tagpending}) {
            push @err, "tagpending missing";
        } elsif ($self->config->disable_tagpending
            and $hooks->{tagpending}) {
            push @err, "tagpending enabled";
        }
        # report errors
        if (@err) {
            $res++;
            push @fail, $name;
            print "$name:\n";
            print "\t$_\n" foreach (@err);
        } else {
            ds_verbose "$name: OK";
        }
    }
    return ($res, \@fail);
}

1;