summaryrefslogtreecommitdiffstats
path: root/lib/Devscripts/Salsa
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Devscripts/Salsa')
-rwxr-xr-xlib/Devscripts/Salsa/Config.pm460
-rw-r--r--lib/Devscripts/Salsa/Hooks.pm303
-rwxr-xr-xlib/Devscripts/Salsa/Repo.pm73
-rw-r--r--lib/Devscripts/Salsa/add_user.pm40
-rwxr-xr-xlib/Devscripts/Salsa/check_repo.pm205
-rw-r--r--lib/Devscripts/Salsa/checkout.pm79
-rw-r--r--lib/Devscripts/Salsa/create_repo.pm47
-rw-r--r--lib/Devscripts/Salsa/del_repo.pm26
-rw-r--r--lib/Devscripts/Salsa/del_user.pm32
-rw-r--r--lib/Devscripts/Salsa/fork.pm36
-rw-r--r--lib/Devscripts/Salsa/forks.pm45
-rw-r--r--lib/Devscripts/Salsa/group.pm35
-rw-r--r--lib/Devscripts/Salsa/join.pm20
-rw-r--r--lib/Devscripts/Salsa/last_ci_status.pm74
-rw-r--r--lib/Devscripts/Salsa/list_groups.pm40
-rw-r--r--lib/Devscripts/Salsa/list_repos.pm42
-rw-r--r--lib/Devscripts/Salsa/merge_request.pm174
-rw-r--r--lib/Devscripts/Salsa/merge_requests.pm49
-rwxr-xr-xlib/Devscripts/Salsa/pipeline_schedule.pm124
-rwxr-xr-xlib/Devscripts/Salsa/pipeline_schedules.pm70
-rw-r--r--lib/Devscripts/Salsa/protect_branch.pm43
-rw-r--r--lib/Devscripts/Salsa/protected_branches.pm27
-rw-r--r--lib/Devscripts/Salsa/purge_cache.pm15
-rw-r--r--lib/Devscripts/Salsa/push.pm106
-rw-r--r--lib/Devscripts/Salsa/push_repo.pm71
-rw-r--r--lib/Devscripts/Salsa/rename_branch.pm45
-rw-r--r--lib/Devscripts/Salsa/search_group.pm37
-rw-r--r--lib/Devscripts/Salsa/search_project.pm57
-rw-r--r--lib/Devscripts/Salsa/search_user.pm36
-rw-r--r--lib/Devscripts/Salsa/update_repo.pm140
-rw-r--r--lib/Devscripts/Salsa/update_safe.pm22
-rw-r--r--lib/Devscripts/Salsa/update_user.pm38
-rw-r--r--lib/Devscripts/Salsa/whoami.pm24
33 files changed, 2635 insertions, 0 deletions
diff --git a/lib/Devscripts/Salsa/Config.pm b/lib/Devscripts/Salsa/Config.pm
new file mode 100755
index 0000000..8c9ccbd
--- /dev/null
+++ b/lib/Devscripts/Salsa/Config.pm
@@ -0,0 +1,460 @@
+# Salsa configuration (inherits from Devscripts::Config)
+package Devscripts::Salsa::Config;
+
+use strict;
+use Devscripts::Output;
+use Moo;
+
+extends 'Devscripts::Config';
+
+# Declare accessors for each option
+foreach (qw(
+ all api_url cache_file command desc desc_pattern dest_branch rename_head
+ disable_irker disable_kgb disable_tagpending irc_channel irker wiki
+ snippets pages releases auto_devops request_acc issues mr repo forks
+ lfs packages jobs container analytics requirements irker_server_url
+ irker_host irker_port kgb kgb_server_url kgb_options mr_allow_squash
+ mr_desc mr_dst_branch mr_dst_project mr_remove_source_branch mr_src_branch
+ mr_src_project mr_title no_fail path private_token skip source_branch
+ group group_id user user_id tagpending tagpending_server_url email
+ email_recipient disable_email ci_config_path archived build_timeout
+ enable_remove_branch disable_remove_branch all_archived git_server_url
+ schedule_desc schedule_ref schedule_cron schedule_tz
+ schedule_enable schedule_disable schedule_run schedule_delete
+ avatar_path request_access
+ )
+) {
+ has $_ => (is => 'rw');
+}
+
+my $cacheDir;
+
+our @kgbOpt = qw(push_events issues_events confidential_issues_events
+ confidential_comments_events merge_requests_events tag_push_events
+ note_events job_events pipeline_events wiki_page_events
+ confidential_note_events enable_ssl_verification);
+
+BEGIN {
+ $cacheDir = $ENV{XDG_CACHE_HOME} || $ENV{HOME} . '/.cache';
+}
+
+# Options
+use constant keys => [
+
+ # General options
+ [
+ 'C|chdir=s', undef,
+ sub { return (chdir($_[1]) ? 1 : (0, "$_[1] doesn't exist")) }
+ ],
+ [
+ 'cache-file',
+ 'SALSA_CACHE_FILE',
+ sub {
+ $_[0]->cache_file($_[1] ? $_[1] : undef);
+ },
+ "$cacheDir/salsa.json"
+ ],
+ [
+ 'no-cache',
+ 'SALSA_NO_CACHE',
+ sub {
+ $_[0]->cache_file(undef)
+ if ($_[1] !~ /^(?:no|0+)$/i);
+ return 1;
+ }
+ ],
+ ['debug', undef, sub { $verbose = 2 }],
+ ['info|i', 'SALSA_INFO', sub { info(-1, 'SALSA_INFO', @_) }],
+ [
+ 'path=s',
+ 'SALSA_REPO_PATH',
+ sub {
+ $_ = $_[1];
+ s#/*(.*)/*#$1#;
+ $_[0]->path($_);
+ return /^[\w\d\-]+$/ ? 1 : (0, "Bad path $_");
+ }
+ ],
+ ['group=s', 'SALSA_GROUP', qr/^[\/\-\w]+$/],
+ ['group-id=s', 'SALSA_GROUP_ID', qr/^\d+$/],
+ ['token', 'SALSA_TOKEN', sub { $_[0]->private_token($_[1]) }],
+ [
+ 'token-file',
+ 'SALSA_TOKEN_FILE',
+ sub {
+ my ($self, $v) = @_;
+ return (0, "Unable to open token file") unless (-r $v);
+ open F, $v;
+ my $s = join '', <F>;
+ close F;
+ if ($s
+ =~ m/^[^#]*(?:SALSA_(?:PRIVATE_)?TOKEN)\s*=\s*(["'])?([-\w]+)\1?$/m
+ ) {
+ $self->private_token($2);
+ return 1;
+ } else {
+ return (0, "No token found in file $v");
+ }
+ }
+ ],
+ ['user=s', 'SALSA_USER', qr/^[\-\w]+$/],
+ ['user-id=s', 'SALSA_USER_ID', qr/^\d+$/],
+ ['verbose', 'SALSA_VERBOSE', sub { $verbose = 1 }],
+ ['yes!', 'SALSA_YES', sub { info(1, "SALSA_YES", @_) },],
+
+ # Update/create repo options
+ ['all'],
+ ['all-archived'],
+ ['skip=s', 'SALSA_SKIP', undef, sub { [] }],
+ [
+ 'skip-file=s',
+ 'SALSA_SKIP_FILE',
+ sub {
+ return 1 unless $_[1];
+ return (0, "Unable to read $_[1]") unless (-r $_[1]);
+ open my $fh, $_[1];
+ push @{ $_[0]->skip }, (map { chomp $_; ($_ ? $_ : ()) } <$fh>);
+ return 1;
+ }
+ ],
+ ['no-skip', undef, sub { $_[0]->skip([]); $_[0]->skip_file(undef); }],
+ ['build-timeout=s', 'SALSA_BUILD_TIMEOUT', qr/^\d+$/, '3600'],
+ ['ci-config-path=s', 'SALSA_CI_CONFIG_PATH', qr/\./],
+ ['desc!', 'SALSA_DESC', 'bool'],
+ ['desc-pattern=s', 'SALSA_DESC_PATTERN', qr/\w/, 'Debian package %p'],
+ [
+ 'enable-remove-source-branch!',
+ undef,
+ sub {
+ !$_[1]
+ or $_[0]
+ ->enable('yes', 'enable_remove_branch', 'disable_remove_branch');
+ }
+ ],
+ [
+ 'disable-remove-source-branch!',
+ undef,
+ sub {
+ !$_[1]
+ or $_[0]
+ ->enable('no', 'enable_remove_branch', 'disable_remove_branch');
+ }
+ ],
+ [
+ undef,
+ 'SALSA_REMOVE_SOURCE_BRANCH',
+ sub {
+ $_[0]
+ ->enable($_[1], 'enable_remove_branch', 'disable_remove_branch');
+ }
+ ],
+ [
+ 'issues=s', 'SALSA_ENABLE_ISSUES',
+ qr/y(es)?|true|enabled?|private|no?|false|disabled?/
+ ],
+ [
+ 'repo=s', 'SALSA_ENABLE_REPO',
+ qr/y(es)?|true|enabled?|private|no?|false|disabled?/
+ ],
+ [
+ 'mr=s', 'SALSA_ENABLE_MR',
+ qr/y(es)?|true|enabled?|private|no?|false|disabled?/
+ ],
+ [
+ 'forks=s', 'SALSA_ENABLE_FORKS',
+ qr/y(es)?|true|enabled?|private|no?|false|disabled?/
+ ],
+ [
+ 'lfs=s', 'SALSA_ENABLE_LFS',
+ qr/y(es)?|true|enabled?|no?|false|disabled?/
+ ],
+ [
+ 'packages=s',
+ 'SALSA_ENABLE_PACKAGES',
+ qr/y(es)?|true|enabled?|no?|false|disabled?/
+ ],
+ [
+ 'jobs=s', 'SALSA_ENABLE_JOBS',
+ qr/y(es)?|true|enabled?|private|no?|false|disabled?/
+ ],
+ [
+ 'container=s', 'SALSA_ENABLE_CONTAINER',
+ qr/y(es)?|true|enabled?|private|no?|false|disabled?/
+ ],
+ [
+ 'analytics=s', 'SALSA_ENABLE_ANALYTICS',
+ qr/y(es)?|true|enabled?|private|no?|false|disabled?/
+ ],
+ [
+ 'requirements=s',
+ 'SALSA_ENABLE_REQUIREMENTS',
+ qr/y(es)?|true|enabled?|private|no?|false|disabled?/
+ ],
+ [
+ 'wiki=s', 'SALSA_ENABLE_WIKI',
+ qr/y(es)?|true|enabled?|private|no?|false|disabled?/
+ ],
+ [
+ 'snippets=s', 'SALSA_ENABLE_SNIPPETS',
+ qr/y(es)?|true|enabled?|private|no?|false|disabled?/
+ ],
+ [
+ 'pages=s', 'SALSA_ENABLE_PAGES',
+ qr/y(es)?|true|enabled?|private|no?|false|disabled?/
+ ],
+ [
+ 'releases=s', 'SALSA_ENABLE_RELEASES',
+ qr/y(es)?|true|enabled?|private|no?|false|disabled?/
+ ],
+ [
+ 'auto-devops=s',
+ 'SALSA_ENABLE_AUTO_DEVOPS',
+ qr/y(es)?|true|enabled?|no?|false|disabled?/
+ ],
+ [
+ 'request-acc=s',
+ 'SALSA_ENABLE_REQUEST_ACC',
+ qr/y(es)?|true|enabled?|no?|false|disabled?/
+ ],
+ [
+ 'email!', undef,
+ sub { !$_[1] or $_[0]->enable('yes', 'email', 'disable_email'); }
+ ],
+ [
+ 'disable-email!', undef,
+ sub { !$_[1] or $_[0]->enable('no', 'email', 'disable_email'); }
+ ],
+ [
+ undef, 'SALSA_EMAIL',
+ sub { $_[0]->enable($_[1], 'email', 'disable_email'); }
+ ],
+ ['email-recipient=s', 'SALSA_EMAIL_RECIPIENTS', undef, sub { [] },],
+ ['irc-channel|irc=s', 'SALSA_IRC_CHANNEL', undef, sub { [] }],
+ [
+ 'irker!', undef,
+ sub { !$_[1] or $_[0]->enable('yes', 'irker', 'disable_irker'); }
+ ],
+ [
+ 'disable-irker!', undef,
+ sub { !$_[1] or $_[0]->enable('no', 'irker', 'disable_irker'); }
+ ],
+ [
+ undef, 'SALSA_IRKER',
+ sub { $_[0]->enable($_[1], 'irker', 'disable_irker'); }
+ ],
+ ['irker-host=s', 'SALSA_IRKER_HOST', undef, 'ruprecht.snow-crash.org'],
+ ['irker-port=s', 'SALSA_IRKER_PORT', qr/^\d*$/],
+ [
+ 'kgb!', undef,
+ sub { !$_[1] or $_[0]->enable('yes', 'kgb', 'disable_kgb'); }
+ ],
+ [
+ 'disable-kgb!', undef,
+ sub { !$_[1] or $_[0]->enable('no', 'kgb', 'disable_kgb'); }
+ ],
+ [undef, 'SALSA_KGB', sub { $_[0]->enable($_[1], 'kgb', 'disable_kgb'); }],
+ [
+ 'kgb-options=s',
+ 'SALSA_KGB_OPTIONS',
+ qr/\w/,
+ 'push_events,issues_events,merge_requests_events,tag_push_events,'
+ . 'note_events,pipeline_events,wiki_page_events,'
+ . 'enable_ssl_verification'
+ ],
+
+ ['no-fail', 'SALSA_NO_FAIL', 'bool'],
+ ['rename-head!', 'SALSA_RENAME_HEAD', 'bool'],
+ ['avatar-path=s', 'SALSA_AVATAR_PATH', undef],
+ ['source-branch=s', 'SALSA_SOURCE_BRANCH', undef, 'master'],
+ ['dest-branch=s', 'SALSA_DEST_BRANCH', undef, 'debian/master'],
+ [
+ 'tagpending!',
+ undef,
+ sub {
+ !$_[1]
+ or $_[0]->enable('yes', 'tagpending', 'disable_tagpending');
+ }
+ ],
+ [
+ 'disable-tagpending!',
+ undef,
+ sub {
+ !$_[1] or $_[0]->enable('no', 'tagpending', 'disable_tagpending');
+ }
+ ],
+ [
+ undef, 'SALSA_TAGPENDING',
+ sub { $_[0]->enable($_[1], 'tagpending', 'disable_tagpending'); }
+ ],
+
+ # Pipeline schedules options
+ ['schedule-desc=s', 'SALSA_SCHEDULE_DESC', qr/\w/],
+ ['schedule-ref=s', 'SALSA_SCHEDULE_REF'],
+ ['schedule-cron=s', 'SALSA_SCHEDULE_CRON'],
+ ['schedule-tz=s', 'SALSA_SCHEDULE_TZ'],
+ ['schedule-enable!', 'SALSA_SCHEDULE_ENABLE', 'bool'],
+ ['schedule-disable!', 'SALSA_SCHEDULE_DISABLE', 'bool'],
+ ['schedule-run!', 'SALSA_SCHEDULE_RUN', 'bool'],
+ ['schedule-delete!', 'SALSA_SCHEDULE_DELETE', 'bool'],
+
+ # Merge requests options
+ ['mr-allow-squash!', 'SALSA_MR_ALLOW_SQUASH', 'bool', 1],
+ ['mr-desc=s'],
+ ['mr-dst-branch=s', undef, undef, 'master'],
+ ['mr-dst-project=s'],
+ ['mr-remove-source-branch!', 'SALSA_MR_REMOVE_SOURCE_BRANCH', 'bool', 0],
+ ['mr-src-branch=s'],
+ ['mr-src-project=s'],
+ ['mr-title=s'],
+
+ # Options to manage other Gitlab instances
+ [
+ 'api-url=s', 'SALSA_API_URL',
+ qr#^https?://#, 'https://salsa.debian.org/api/v4'
+ ],
+ [
+ 'git-server-url=s', 'SALSA_GIT_SERVER_URL',
+ qr/^\S+\@\S+/, 'git@salsa.debian.org:'
+ ],
+ [
+ 'irker-server-url=s', 'SALSA_IRKER_SERVER_URL',
+ qr'^ircs?://', 'ircs://irc.oftc.net:6697/'
+ ],
+ [
+ 'kgb-server-url=s', 'SALSA_KGB_SERVER_URL',
+ qr'^https?://', 'http://kgb.debian.net:9418/webhook/?channel='
+ ],
+ [
+ 'tagpending-server-url=s',
+ 'SALSA_TAGPENDING_SERVER_URL',
+ qr'^https?://',
+ 'https://webhook.salsa.debian.org/tagpending/'
+ ],
+
+ [
+ 'request-access=s',
+ 'SALSA_REQUEST_ACCESS',
+ qr/y(es)?|true|enabled?|1|no?|false|disabled?|0/
+ ],
+
+ # List/search options
+ ['archived!', 'SALSA_ARCHIVED', 'bool', 0],
+];
+
+# Consistency rules
+use constant rules => [
+ # Reject unless token exists
+ sub {
+ return (1,
+"SALSA_TOKEN not set in configuration files. Some commands may fail"
+ ) unless ($_[0]->private_token);
+ },
+ # Get command
+ sub {
+ return (0, "No command given, aborting") unless (@ARGV);
+ $_[0]->command(shift @ARGV);
+ return (0, "Malformed command: " . $_[0]->command)
+ unless ($_[0]->command =~ /^[a-z_]+$/);
+ return 1;
+ },
+ sub {
+ if ( ($_[0]->group or $_[0]->group_id)
+ and ($_[0]->user_id or $_[0]->user)) {
+ ds_warn(
+ "Both --user-id and --group-id are set, ignore --group-id");
+ $_[0]->group(undef);
+ $_[0]->group_id(undef);
+ }
+ return 1;
+ },
+ sub {
+ if ($_[0]->group and $_[0]->group_id) {
+ ds_warn("Both --group-id and --group are set, ignore --group");
+ $_[0]->group(undef);
+ }
+ return 1;
+ },
+ sub {
+ if ($_[0]->user and $_[0]->user_id) {
+ ds_warn("Both --user-id and --user are set, ignore --user");
+ $_[0]->user(undef);
+ }
+ return 1;
+ },
+ sub {
+ if ($_[0]->email and not @{ $_[0]->email_recipient }) {
+ return (0, '--email-recipient needed with --email');
+ }
+ return 1;
+ },
+ sub {
+ if (@{ $_[0]->irc_channel }) {
+ foreach (@{ $_[0]->irc_channel }) {
+ if (/^#/) {
+ return (1,
+"# found in --irc-channel, assuming double hash is wanted"
+ );
+ }
+ }
+ if ($_[0]->irc_channel->[1] and $_[0]->kgb) {
+ return (0, "Only one IRC channel is accepted with --kgb");
+ }
+ }
+ return 1;
+ },
+ sub {
+ $_[0]->kgb_options([sort split ',\s*', $_[0]->kgb_options]);
+ my @err;
+ foreach my $o (@{ $_[0]->kgb_options }) {
+ unless (grep { $_ eq $o } @kgbOpt) {
+ push @err, $o;
+ }
+ }
+ return (0, 'Unknown KGB options: ' . join(', ', @err))
+ if @err;
+ return 1;
+ },
+];
+
+sub usage {
+ print <<END;
+usage: salsa <command> <parameters> <options>
+
+Most used commands:
+ - checkout, co: clone repo in current dir
+ - fork : fork a project
+ - mr : create a merge request
+ - push_repo : push local git repo to upstream repository
+ - whoami : gives information on the token owner
+
+See salsa(1) manpage for more.
+END
+}
+
+sub info {
+ my ($num, $key, undef, $nv) = @_;
+ $nv = (
+ $nv =~ /^yes|1$/ ? $num
+ : $nv =~ /^no|0$/i ? 0
+ : return (0, "Bad $key value"));
+ $ds_yes = $nv;
+}
+
+sub enable {
+ my ($self, $v, $en, $dis) = @_;
+ $v = lc($v);
+ if ($v eq 'ignore') {
+ $self->{$en} = $self->{$dis} = 0;
+ } elsif ($v eq 'yes') {
+ $self->{$en} = 1;
+ $self->{$dis} = 0;
+ } elsif ($v eq 'no') {
+ $self->{$en} = 0;
+ $self->{$dis} = 1;
+ } else {
+ return (0, "Bad value for SALSA_" . uc($en));
+ }
+ return 1;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/Hooks.pm b/lib/Devscripts/Salsa/Hooks.pm
new file mode 100644
index 0000000..95a2f47
--- /dev/null
+++ b/lib/Devscripts/Salsa/Hooks.pm
@@ -0,0 +1,303 @@
+# Common hooks library
+package Devscripts::Salsa::Hooks;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub add_hooks {
+ my ($self, $repo_id, $repo) = @_;
+ if ( $self->config->kgb
+ or $self->config->disable_kgb
+ or $self->config->tagpending
+ or $self->config->disable_tagpending
+ or $self->config->irker
+ or $self->config->disable_irker
+ or $self->config->email
+ or $self->config->disable_email) {
+ my $hooks = $self->enabled_hooks($repo_id);
+ return 1 unless (defined $hooks);
+ # KGB hook (IRC)
+ if ($self->config->kgb or $self->config->disable_kgb) {
+ unless ($self->config->irc_channel->[0]
+ or $self->config->disable_kgb) {
+ ds_warn "--kgb needs --irc-channel";
+ return 1;
+ }
+ if ($self->config->irc_channel->[1]) {
+ ds_warn "KGB accepts only one --irc-channel value,";
+ }
+ if ($hooks->{kgb}) {
+ ds_warn "Deleting old kgb (was $hooks->{kgb}->{url})";
+ $self->api->delete_project_hook($repo_id, $hooks->{kgb}->{id});
+ }
+ if ($self->config->irc_channel->[0]
+ and not $self->config->disable_kgb) {
+ # TODO: if useful, add parameters for this options
+ eval {
+ $self->api->create_project_hook(
+ $repo_id,
+ {
+ url => $self->config->kgb_server_url
+ . $self->config->irc_channel->[0],
+ map { ($_ => 1) } @{ $self->config->kgb_options },
+ });
+ ds_verbose "KGB hook added to project $repo_id (channel: "
+ . $self->config->irc_channel->[0] . ')';
+ };
+ if ($@) {
+ ds_warn "Fail to add KGB hook: $@";
+ if (!$self->config->no_fail) {
+ return 1;
+ }
+ }
+ }
+ }
+ # Irker hook (IRC)
+ if ($self->config->irker or $self->config->disable_irker) {
+ unless ($self->config->irc_channel->[0]
+ or $self->config->disable_irker) {
+ ds_warn "--irker needs --irc-channel";
+ return 1;
+ }
+ if ($hooks->{irker}) {
+ no warnings;
+ ds_warn
+"Deleting old irker (redirected to $hooks->{irker}->{recipients})";
+ $self->api->delete_project_service($repo_id, 'irker');
+ }
+ if ($self->config->irc_channel->[0]
+ and not $self->config->disable_irker) {
+ # TODO: if useful, add parameters for this options
+ my $ch = join(' ',
+ map { '#' . $_ } @{ $self->config->irc_channel });
+ $self->api->edit_project_service(
+ $repo_id, 'irker',
+ {
+ active => 1,
+ server_host => $self->config->irker_host,
+ (
+ $self->config->irker_port
+ ? (server_port => $self->config->irker_port)
+ : ()
+ ),
+ default_irc_uri => $self->config->irker_server_url,
+ recipients => $ch,
+ colorize_messages => 1,
+ });
+ ds_verbose
+ "Irker hook added to project $repo_id (channel: $ch)";
+ }
+ }
+ # email on push
+ if ($self->config->email or $self->config->disable_email) {
+ if ($hooks->{email}) {
+ no warnings;
+ ds_warn
+"Deleting old email-on-push (redirected to $hooks->{email}->{recipients})";
+ $self->api->delete_project_service($repo_id, 'emails-on-push');
+ }
+ if (@{ $self->config->email_recipient }
+ and not $self->config->disable_email) {
+ # TODO: if useful, add parameters for this options
+ $self->api->edit_project_service(
+ $repo_id,
+ 'emails-on-push',
+ {
+ recipients => join(' ',
+ map { my $a = $_; $a =~ s/%p/$repo/; $a }
+ @{ $self->config->email_recipient }),
+ });
+ no warnings;
+ ds_verbose
+ "Email-on-push hook added to project $repo_id (recipients: "
+ . join(' ', @{ $self->config->email_recipient }) . ')';
+ }
+ }
+ # Tagpending hook
+ if ($self->config->tagpending or $self->config->disable_tagpending) {
+ if ($hooks->{tagpending}) {
+ ds_warn
+ "Deleting old tagpending (was $hooks->{tagpending}->{url})";
+ $self->api->delete_project_hook($repo_id,
+ $hooks->{tagpending}->{id});
+ }
+ my $repo_name = $self->api->project($repo_id)->{name};
+ unless ($self->config->disable_tagpending) {
+ eval {
+ $self->api->create_project_hook(
+ $repo_id,
+ {
+ url => $self->config->tagpending_server_url
+ . $repo_name,
+ push_events => 1,
+ });
+ ds_verbose "Tagpending hook added to project $repo_id";
+ };
+ if ($@) {
+ ds_warn "Fail to add Tagpending hook: $@";
+ if (!$self->config->no_fail) {
+ return 1;
+ }
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+sub enabled_hooks {
+ my ($self, $repo_id) = @_;
+ my $hooks;
+ my $res = {};
+ if ( $self->config->kgb
+ or $self->config->disable_kgb
+ or $self->config->tagpending
+ or $self->config->disable_tagpending) {
+ $hooks = eval { $self->api->project_hooks($repo_id) };
+ if ($@) {
+ ds_warn "Unable to check hooks for project $repo_id";
+ return undef;
+ }
+ foreach my $h (@{$hooks}) {
+ $res->{kgb} = {
+ id => $h->{id},
+ url => $h->{url},
+ options => [grep { $h->{$_} and $h->{$_} eq 1 } keys %$h],
+ }
+ if $h->{url} =~ /\Q$self->{config}->{kgb_server_url}\E/;
+ $res->{tagpending} = {
+ id => $h->{id},
+ url => $h->{url},
+ }
+ if $h->{url} =~ /\Q$self->{config}->{tagpending_server_url}\E/;
+ }
+ }
+ if ( ($self->config->email or $self->config->disable_email)
+ and $_ = $self->api->project_service($repo_id, 'emails-on-push')
+ and $_->{active}) {
+ $res->{email} = $_->{properties};
+ }
+ if ( ($self->config->irker or $self->config->disable_irker)
+ and $_ = $self->api->project_service($repo_id, 'irker')
+ and $_->{active}) {
+ $res->{irker} = $_->{properties};
+ }
+ return $res;
+}
+
+sub _check_config {
+ my ($config, $key_name, $config_name, $can_be_private, $res_ref) = @_;
+ if (!$config) { return undef; }
+ for ($config) {
+ if ($can_be_private) {
+ if ($_ eq "private") {
+ push @$res_ref, $key_name => "private";
+ } elsif (qr/y(es)?|true|enabled?/) {
+ push @$res_ref, $key_name => "enabled";
+ } elsif (qr/no?|false|disabled?/) {
+ push @$res_ref, $key_name => "disabled";
+ } else {
+ print "error with SALSA_$config_name";
+ }
+ } else {
+ if (qr/y(es)?|true|enabled?/) {
+ push @$res_ref, $key_name => 1;
+ } elsif (qr/no?|false|disabled?/) {
+ push @$res_ref, $key_name => 0;
+ } else {
+ print "error with SALSA_$config_name";
+ }
+ }
+ }
+}
+
+sub desc {
+ my ($self, $repo) = @_;
+ my @res = ();
+ if ($self->config->desc) {
+ my $str = $self->config->desc_pattern;
+ $str =~ s/%P/$repo/g;
+ $repo =~ s#.*/##;
+ $str =~ s/%p/$repo/g;
+ push @res, description => $str;
+ }
+ if ($self->config->build_timeout) {
+ push @res, build_timeout => $self->config->build_timeout;
+ }
+
+ # Parameter: config value, key name, config name, has private
+ _check_config($self->config->issues, "issues_access_level",
+ "ENABLE_ISSUES", 1, \@res);
+ _check_config($self->config->repo, "repository_access_level",
+ "ENABLE_REPO", 1, \@res);
+ _check_config($self->config->mr, "merge_requests_access_level",
+ "ENABLE_MR", 1, \@res);
+ _check_config($self->config->forks, "forking_access_level",
+ "ENABLE_FORKS", 1, \@res);
+ _check_config($self->config->lfs, "lfs_enabled", "ENABLE_LFS", 0, \@res);
+ _check_config($self->config->packages,
+ "packages_enabled", "ENABLE_PACKAGES", 0, \@res);
+ _check_config($self->config->jobs, "builds_access_level", "ENABLE_JOBS",
+ 1, \@res);
+ _check_config(
+ $self->config->container,
+ "container_registry_access_level",
+ "ENABLE_CONTAINER", 1, \@res
+ );
+ _check_config($self->config->analytics,
+ "analytics_access_level", "ENABLE_ANALYTICS", 1, \@res);
+ _check_config($self->config->requirements,
+ "requirements_access_level", "ENABLE_REQUIREMENTS", 1, \@res);
+ _check_config($self->config->wiki, "wiki_access_level", "ENABLE_WIKI", 1,
+ \@res);
+ _check_config($self->config->snippets,
+ "snippets_access_level", "ENABLE_SNIPPETS", 1, \@res);
+ _check_config($self->config->pages, "pages_access_level", "ENABLE_PAGES",
+ 1, \@res);
+ _check_config($self->config->releases,
+ "releases_access_level", "ENABLE_RELEASES", 1, \@res);
+ _check_config($self->config->auto_devops,
+ "auto_devops_enabled", "ENABLE_AUTO_DEVOPS", 0, \@res);
+ _check_config($self->config->request_acc,
+ "request_access_enabled", "ENABLE_REQUEST_ACC", 0, \@res);
+
+ if ($self->config->disable_remove_branch) {
+ push @res, remove_source_branch_after_merge => 0;
+ } elsif ($self->config->enable_remove_branch) {
+ push @res, remove_source_branch_after_merge => 1;
+ }
+ if ($self->config->ci_config_path) {
+ push @res, ci_config_path => $self->config->ci_config_path;
+ }
+ if ($self->config->request_access) {
+ if ($self->config->request_access =~ qr/y(es)?|true|enabled?|1/) {
+ push @res, request_access_enabled => 1;
+ } else {
+ push @res, request_access_enabled => 0;
+ }
+ }
+ return @res;
+}
+
+sub desc_multipart {
+ my ($self, $repo) = @_;
+ my @res = ();
+ if ($self->config->avatar_path) {
+ my $str = $self->config->avatar_path;
+ $str =~ s/%p/$repo/g;
+ unless (-r $str) {
+ if (!$self->config->no_fail) {
+ ds_error("Unable to find: $str");
+ exit 1;
+ }
+ ds_warn "Unable to find: $str";
+ } else {
+ # avatar_path (salsa) -> avatar (GitLab API)
+ push @res, avatar => $str;
+ }
+ }
+ return @res;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/Repo.pm b/lib/Devscripts/Salsa/Repo.pm
new file mode 100755
index 0000000..0370810
--- /dev/null
+++ b/lib/Devscripts/Salsa/Repo.pm
@@ -0,0 +1,73 @@
+# Common method to get projects
+package Devscripts::Salsa::Repo;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+with "Devscripts::Salsa::Hooks";
+
+sub get_repo {
+ my ($self, $prompt, @reponames) = @_;
+ my @repos;
+ if (($self->config->all or $self->config->all_archived)
+ and @reponames == 0) {
+ ds_debug "--all is set";
+ my $options = {};
+ $options->{order_by} = 'name';
+ $options->{sort} = 'asc';
+ $options->{archived} = 'false' if not $self->config->all_archived;
+ my $projects;
+ # This rule disallow trying to configure all "Debian" projects:
+ # - Debian id is 2
+ # - next is 1987
+ if ($self->group_id) {
+ $projects
+ = $self->api->paginator('group_projects', $self->group_id,
+ $options)->all;
+ } elsif ($self->user_id) {
+ $projects
+ = $self->api->paginator('user_projects', $self->user_id,
+ $options)->all;
+ } else {
+ ds_warn "Missing or invalid token";
+ return 1;
+ }
+ unless ($projects) {
+ ds_warn "No projects found";
+ return 1;
+ }
+ @repos = map {
+ $self->projectCache->{ $_->{path_with_namespace} } = $_->{id};
+ [$_->{id}, $_->{path}]
+ } @$projects;
+ if (@{ $self->config->skip }) {
+ @repos = map {
+ my $res = 1;
+ foreach my $k (@{ $self->config->skip }) {
+ $res = 0 if ($_->[1] =~ m#(?:.*/)?\Q$k\E#);
+ }
+ $res ? $_ : ();
+ } @repos;
+ }
+ if ($ds_yes > 0 or !$prompt) {
+ ds_verbose "Found " . @repos . " projects";
+ } else {
+ unless (
+ ds_prompt(
+ "You're going to configure "
+ . @repos
+ . " projects. Continue (N/y) "
+ ) =~ accept
+ ) {
+ ds_warn "Aborting";
+ return 1;
+ }
+ }
+ } else {
+ @repos = map { [$self->project2id($_), $_] } @reponames;
+ }
+ return @repos;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/add_user.pm b/lib/Devscripts/Salsa/add_user.pm
new file mode 100644
index 0000000..3968fb3
--- /dev/null
+++ b/lib/Devscripts/Salsa/add_user.pm
@@ -0,0 +1,40 @@
+# Adds a user in a group with a role
+package Devscripts::Salsa::add_user;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub add_user {
+ my ($self, $level, $user) = @_;
+ unless ($level and $user) {
+ ds_warn "Usage $0 --group-id 1234 add_user <level> <userid>";
+ return 1;
+ }
+ unless ($self->group_id) {
+ ds_warn "Unable to add user without --group or --group-id";
+ return 1;
+ }
+
+ my $id = $self->username2id($user) or return 1;
+ my $al = $self->levels_name($level) or return 1;
+ return 1
+ if (
+ $ds_yes < 0
+ and ds_prompt(
+"You're going to accept $user as $level in group $self->{group_id}. Continue (Y/n) "
+ ) =~ refuse
+ );
+ $self->api->add_group_member(
+ $self->group_id,
+ {
+ user_id => $id,
+ access_level => $al,
+ });
+ ds_warn "User $user added to group "
+ . $self->group_id
+ . " with role $level";
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/check_repo.pm b/lib/Devscripts/Salsa/check_repo.pm
new file mode 100755
index 0000000..d22095b
--- /dev/null
+++ b/lib/Devscripts/Salsa/check_repo.pm
@@ -0,0 +1,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;
diff --git a/lib/Devscripts/Salsa/checkout.pm b/lib/Devscripts/Salsa/checkout.pm
new file mode 100644
index 0000000..c3b5fe5
--- /dev/null
+++ b/lib/Devscripts/Salsa/checkout.pm
@@ -0,0 +1,79 @@
+# Clones or updates a repository using gbp
+# TODO: git-dpm ?
+package Devscripts::Salsa::checkout;
+
+use strict;
+use Devscripts::Output;
+use Devscripts::Utils;
+use Dpkg::IPC;
+use Moo::Role;
+
+with "Devscripts::Salsa::Repo";
+
+sub checkout {
+ my ($self, @repos) = @_;
+ unless (@repos or $self->config->all or $self->config->all_archived) {
+ ds_warn "Usage $0 checkout <--all|--all-archived|names>";
+ return 1;
+ }
+ if (@repos and $self->config->all) {
+ ds_warn "--all with a reponame makes no sense";
+ return 1;
+ }
+ if (@repos and $self->config->all_archived) {
+ ds_warn "--all-archived with a reponame makes no sense";
+ return 1;
+ }
+ # If --all is asked, launch all projects
+ @repos = map { $_->[1] } $self->get_repo(0, @repos) unless (@repos);
+ my $cdir = `pwd`;
+ chomp $cdir;
+ my $res = 0;
+ foreach (@repos) {
+ my $path = $self->project2path($_);
+ s#.*/##;
+ if (-d $_) {
+ chdir $_;
+ ds_verbose "Updating existing checkout in $_";
+ spawn(
+ exec => ['gbp', 'pull', '--pristine-tar'],
+ wait_child => 1,
+ nocheck => 1,
+ );
+ if ($?) {
+ if ($self->config->no_fail) {
+ print STDERR "gbp pull fails in $_, "
+ . "continuing since --no-fail is set\n";
+ $res++;
+ } else {
+ ds_warn "gbp pull failed in $_\n";
+ return 1;
+ }
+ }
+ chdir $cdir;
+ } else {
+ spawn(
+ exec => [
+ 'gbp', 'clone',
+ '--all', $self->config->git_server_url . $path . ".git"
+ ],
+ wait_child => 1,
+ nocheck => 1,
+ );
+ if ($?) {
+ if ($self->config->no_fail) {
+ print STDERR "gbp clone fails in $_, "
+ . "continuing since --no-fail is set\n";
+ $res++;
+ } else {
+ ds_warn "gbp clone failed for $_\n";
+ return 1;
+ }
+ }
+ ds_warn "$_ ready in $_/";
+ }
+ }
+ return $res;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/create_repo.pm b/lib/Devscripts/Salsa/create_repo.pm
new file mode 100644
index 0000000..4640ae2
--- /dev/null
+++ b/lib/Devscripts/Salsa/create_repo.pm
@@ -0,0 +1,47 @@
+# Creates repo using name or path
+package Devscripts::Salsa::create_repo;
+
+use strict;
+use Devscripts::Output;
+use Dpkg::IPC;
+use Moo::Role;
+
+with "Devscripts::Salsa::Hooks";
+
+sub create_repo {
+ my ($self, $reponame) = @_;
+ unless ($reponame) {
+ ds_warn "Repository name is missing";
+ return 1;
+ }
+ # Get parameters from Devscripts::Salsa::Repo
+ my $opts = {
+ name => $reponame,
+ path => $reponame,
+ visibility => 'public',
+ $self->desc($reponame),
+ };
+ if ($self->group_id) {
+ $opts->{namespace_id} = $self->group_id;
+ }
+ return 1
+ if (
+ $ds_yes < 0
+ and ds_prompt(
+ "You're going to create $reponame in "
+ . ($self->group_id ? $self->group_path : 'your namespace')
+ . ". Continue (Y/n) "
+ ) =~ refuse
+ );
+ my $repo = eval { $self->api->create_project($opts) };
+ if ($@ or !$repo) {
+ ds_warn "Project not created: $@";
+ return 1;
+ }
+ ds_warn "Project $repo->{web_url} created";
+ $reponame =~ s#^.*/##;
+ $self->add_hooks($repo->{id}, $reponame);
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/del_repo.pm b/lib/Devscripts/Salsa/del_repo.pm
new file mode 100644
index 0000000..74700e0
--- /dev/null
+++ b/lib/Devscripts/Salsa/del_repo.pm
@@ -0,0 +1,26 @@
+# Deletes a repository
+package Devscripts::Salsa::del_repo;
+
+use strict;
+use Devscripts::Output;
+use Dpkg::IPC;
+use Moo::Role;
+
+sub del_repo {
+ my ($self, $reponame) = @_;
+ unless ($reponame) {
+ ds_warn "Repository name or path is missing";
+ return 1;
+ }
+ my $id = $self->project2id($reponame) or return 1;
+ my $path = $self->project2path($reponame);
+ return 1
+ if ($ds_yes < 0
+ and ds_prompt("You're going to delete $path. Continue (Y/n) ")
+ =~ refuse);
+ $self->api->delete_project($id);
+ ds_warn "Project $path deleted";
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/del_user.pm b/lib/Devscripts/Salsa/del_user.pm
new file mode 100644
index 0000000..a29dbbe
--- /dev/null
+++ b/lib/Devscripts/Salsa/del_user.pm
@@ -0,0 +1,32 @@
+# Removes a user from a group
+package Devscripts::Salsa::del_user;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub del_user {
+ my ($self, $user) = @_;
+ unless ($user) {
+ ds_warn "Usage $0 del_user <user>";
+ return 1;
+ }
+ unless ($self->group_id) {
+ ds_warn "Unable to del user without --group-id";
+ return 1;
+ }
+
+ my $id = $self->username2id($user) or return 1;
+ return 1
+ if (
+ $ds_yes < 0
+ and ds_prompt(
+"You're going to remove $user from group $self->{group_id}. Continue (Y/n) "
+ ) =~ refuse
+ );
+ $self->api->remove_group_member($self->group_id, $id);
+ ds_warn "User $user removed from group " . $self->group_id;
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/fork.pm b/lib/Devscripts/Salsa/fork.pm
new file mode 100644
index 0000000..ca5559e
--- /dev/null
+++ b/lib/Devscripts/Salsa/fork.pm
@@ -0,0 +1,36 @@
+# Forks a project given by full path into group/user namespace
+package Devscripts::Salsa::fork;
+
+use strict;
+use Devscripts::Output;
+use Dpkg::IPC;
+use Moo::Role;
+
+with 'Devscripts::Salsa::checkout';
+
+sub fork {
+ my ($self, $project) = @_;
+ unless ($project) {
+ ds_warn "Project to fork is missing";
+ return 1;
+ }
+ my $path = $self->main_path or return 1;
+ $self->api->fork_project($project, { namespace => $path });
+ my $p = $project;
+ $p =~ s#.*/##;
+ if ($self->checkout($p)) {
+ ds_warn "Failed to checkout $project";
+ return 1;
+ }
+ chdir $p;
+ spawn(
+ exec => [
+ qw(git remote add upstream),
+ $self->config->git_server_url . $project
+ ],
+ wait_child => 1
+ );
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/forks.pm b/lib/Devscripts/Salsa/forks.pm
new file mode 100644
index 0000000..18b1d0c
--- /dev/null
+++ b/lib/Devscripts/Salsa/forks.pm
@@ -0,0 +1,45 @@
+# Lists forks of a project
+package Devscripts::Salsa::forks;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub forks {
+ my ($self, @reponames) = @_;
+ my $res = 0;
+ unless (@reponames) {
+ ds_warn "Repository name is missing";
+ return 1;
+ }
+ foreach my $p (@reponames) {
+ my $id = $self->project2id($p);
+ unless ($id) {
+ ds_warn "Project $_ not found";
+ $res++;
+ next;
+ }
+ print "$p\n";
+ my $forks = $self->api->paginator(
+ 'project_forks',
+ $id,
+ {
+ state => 'opened',
+ });
+ unless ($forks) {
+ print "\n";
+ next;
+ }
+ while ($_ = $forks->next) {
+ print <<END;
+\tId : $_->{id}
+\tName: $_->{path_with_namespace}
+\tURL : $_->{web_url}
+
+END
+ }
+ }
+ return $res;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/group.pm b/lib/Devscripts/Salsa/group.pm
new file mode 100644
index 0000000..cb14741
--- /dev/null
+++ b/lib/Devscripts/Salsa/group.pm
@@ -0,0 +1,35 @@
+# Lists members of a group
+package Devscripts::Salsa::group;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub group {
+ my ($self) = @_;
+ my $count = 0;
+ unless ($self->group_id) {
+ ds_warn "Usage $0 --group-id 1234 group";
+ return 1;
+ }
+ my $users = $self->api->paginator('group_members', $self->group_id);
+ while ($_ = $users->next) {
+ $count++;
+ my $access_level = $self->levels_code($_->{access_level});
+ print <<END;
+Id : $_->{id}
+Username : $_->{username}
+Name : $_->{name}
+Access level: $access_level
+State : $_->{state}
+
+END
+ }
+ unless ($count) {
+ ds_warn "No users found";
+ return 1;
+ }
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/join.pm b/lib/Devscripts/Salsa/join.pm
new file mode 100644
index 0000000..319e107
--- /dev/null
+++ b/lib/Devscripts/Salsa/join.pm
@@ -0,0 +1,20 @@
+# Launch request to join a group
+package Devscripts::Salsa::join;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub join {
+ my ($self, $group) = @_;
+ unless ($group ||= $self->config->group || $self->config->group_id) {
+ ds_warn "Group is missing";
+ return 1;
+ }
+ my $gid = $self->group2id($group);
+ $self->api->group_access_requests($gid);
+ ds_warn "Request launched to group $group ($gid)";
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/last_ci_status.pm b/lib/Devscripts/Salsa/last_ci_status.pm
new file mode 100644
index 0000000..c275efb
--- /dev/null
+++ b/lib/Devscripts/Salsa/last_ci_status.pm
@@ -0,0 +1,74 @@
+package Devscripts::Salsa::last_ci_status;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+with "Devscripts::Salsa::Repo";
+
+use constant OK => 'success';
+use constant SKIPPED => 'skipped';
+use constant FAILED => 'failed';
+
+sub last_ci_status {
+ my ($self, @repos) = @_;
+ unless (@repos or $self->config->all or $self->config->all_archived) {
+ ds_warn "Usage $0 ci_status <--all|--all-archived|names>";
+ return 1;
+ }
+ if (@repos and $self->config->all) {
+ ds_warn "--all with a reponame makes no sense";
+ return 1;
+ }
+ if (@repos and $self->config->all_archived) {
+ ds_warn "--all-archived with a reponame makes no sense";
+ return 1;
+ }
+ # If --all is asked, launch all projects
+ @repos = map { $_->[1] } $self->get_repo(0, @repos) unless (@repos);
+ my $ret = 0;
+ foreach my $repo (@repos) {
+ my $id = $self->project2id($repo) or return 1;
+ my $pipelines = $self->api->pipelines($id);
+ unless ($pipelines and @$pipelines) {
+ ds_warn "No pipelines for $repo";
+ $ret++;
+ return 1 unless $self->config->no_fail;
+ } else {
+ my $status = $pipelines->[0]->{status};
+ if ($status eq OK) {
+ print "Last result for $repo: $status\n";
+ } else {
+ print STDERR "Last result for $repo: $status\n";
+ my $jobs
+ = $self->api->pipeline_jobs($id, $pipelines->[0]->{id});
+ my %jres;
+ foreach my $job (sort { $a->{id} <=> $b->{id} } @$jobs) {
+ next if $job->{status} eq SKIPPED;
+ push @{ $jres{ $job->{status} } }, $job->{name};
+ }
+ if ($jres{ OK() }) {
+ print STDERR ' success: '
+ . join(', ', @{ $jres{ OK() } }) . "\n";
+ delete $jres{ OK() };
+ }
+ foreach my $k (sort keys %jres) {
+ print STDERR ' '
+ . uc($k) . ': '
+ . join(', ', @{ $jres{$k} }) . "\n";
+ }
+ print STDERR "\n See: " . $pipelines->[0]->{web_url} . "\n\n";
+ if ($status eq FAILED) {
+ $ret++;
+ unless ($self->config->no_fail) {
+ ds_verbose "Use --no-fail to continue";
+ return 1;
+ }
+ }
+ }
+ }
+ }
+ return $ret;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/list_groups.pm b/lib/Devscripts/Salsa/list_groups.pm
new file mode 100644
index 0000000..903cd1e
--- /dev/null
+++ b/lib/Devscripts/Salsa/list_groups.pm
@@ -0,0 +1,40 @@
+# Lists subgroups of a group or groups of a user
+package Devscripts::Salsa::list_groups;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub list_groups {
+ my ($self, $match) = @_;
+ my $groups;
+ my $count = 0;
+ my $opts = {
+ order_by => 'name',
+ sort => 'asc',
+ ($match ? (search => $match) : ()),
+ };
+ if ($self->group_id) {
+ $groups
+ = $self->api->paginator('group_subgroups', $self->group_id, $opts);
+ } else {
+ $groups = $self->api->paginator('groups', $opts);
+ }
+ while ($_ = $groups->next) {
+ $count++;
+ my $parent = $_->{parent_id} ? "Parent id: $_->{parent_id}\n" : '';
+ print <<END;
+Id : $_->{id}
+Name : $_->{name}
+Full path: $_->{full_path}
+$parent
+END
+ }
+ unless ($count) {
+ ds_warn "No groups found";
+ return 1;
+ }
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/list_repos.pm b/lib/Devscripts/Salsa/list_repos.pm
new file mode 100644
index 0000000..34ae05a
--- /dev/null
+++ b/lib/Devscripts/Salsa/list_repos.pm
@@ -0,0 +1,42 @@
+# Lists repositories of group/user
+package Devscripts::Salsa::list_repos;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub list_repos {
+ my ($self, $match) = @_;
+ my $projects;
+ my $count = 0;
+ my $opts = {
+ order_by => 'name',
+ sort => 'asc',
+ simple => 1,
+ archived => $self->config->archived,
+ ($match ? (search => $match) : ()),
+ };
+ if ($self->group_id) {
+ $projects
+ = $self->api->paginator('group_projects', $self->group_id, $opts);
+ } else {
+ $projects
+ = $self->api->paginator('user_projects', $self->user_id, $opts);
+ }
+ while ($_ = $projects->next) {
+ $count++;
+ print <<END;
+Id : $_->{id}
+Name: $_->{name}
+URL : $_->{web_url}
+
+END
+ }
+ unless ($count) {
+ ds_warn "No projects found";
+ return 1;
+ }
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/merge_request.pm b/lib/Devscripts/Salsa/merge_request.pm
new file mode 100644
index 0000000..b76c6e8
--- /dev/null
+++ b/lib/Devscripts/Salsa/merge_request.pm
@@ -0,0 +1,174 @@
+# Creates a merge request from current directory (or using parameters)
+package Devscripts::Salsa::merge_request;
+
+use strict;
+use Devscripts::Output;
+use Dpkg::IPC;
+use Moo::Role;
+
+with 'Devscripts::Salsa::search_project';
+
+sub merge_request {
+ my ($self, $dst_project, $dst_branch) = @_;
+ my $src_branch = $self->config->mr_src_branch;
+ my $src_project = $self->config->mr_src_project;
+ $dst_project ||= $self->config->mr_dst_project;
+ $dst_branch ||= $self->config->mr_dst_branch;
+ my $title = $self->config->mr_title;
+ my $desc = $self->config->mr_desc;
+
+ if ($src_branch) {
+ unless ($src_project and $dst_project) {
+ ds_warn "--mr-src-project and --mr-src-project "
+ . "are required when --mr-src-branch is set";
+ return 1;
+ }
+ unless ($src_project =~ m#/#) {
+ $src_project = $self->project2path($src_project);
+ }
+ } else { # Use current repository to find elements
+ ds_verbose "using current branch as source";
+ my $out;
+ unless ($src_project) {
+ # 1. Verify that repo is ready
+ spawn(
+ exec => [qw(git status -s -b -uno)],
+ wait_child => 1,
+ to_string => \$out
+ );
+ chomp $out;
+ # Case "rebased"
+ if ($out =~ /\[/) {
+ ds_warn "Current branch isn't pushed, aborting:\n";
+ return 1;
+ }
+ # Case else: nothing after src...dst
+ unless ($out =~ /\s(\S+)\.\.\.(\S+)/s) {
+ ds_warn
+ "Current branch as no origin or isn't pushed, aborting";
+ return 1;
+ }
+ # 2. Set source branch to current branch
+ $src_branch ||= $1;
+ ds_verbose "Found current branch: $src_branch";
+ }
+ unless ($src_project and $dst_project) {
+ # Check remote links
+ spawn(
+ exec => [qw(git remote --verbose show)],
+ wait_child => 1,
+ to_string => \$out,
+ );
+ my $origin = $self->config->api_url;
+ $origin =~ s#api/v4$##;
+ # 3. Set source project using "origin" target
+ unless ($src_project) {
+ if ($out
+ =~ /origin\s+(?:\Q$self->{config}->{git_server_url}\E|\Q$origin\E)(\S*)/m
+ ) {
+ $src_project = $1;
+ $src_project =~ s/\.git$//;
+ } else {
+ ds_warn
+"Unable to find project origin, set it using --mr-src-project";
+ return 1;
+ }
+ }
+ # 4. Steps to find destination project:
+ # - command-line
+ # - GitLab API (search for "forked_from_project"
+ # - "upstream" in git remote
+ # - use source project as destination project
+
+ # 4.1. Stop if dest project has been given in command line
+ unless ($dst_project) {
+ my $project = $self->api->project($src_project);
+
+ # 4.2. Search original project from GitLab API
+ if ($project->{forked_from_project}) {
+ $dst_project
+ = $project->{forked_from_project}->{path_with_namespace};
+ }
+ if ($dst_project) {
+ ds_verbose "Project was forked from $dst_project";
+
+ # 4.3. Search for an "upstream" target in `git remote`
+ } elsif ($out
+ =~ /upstream\s+(?:\Q$self->{config}->{git_server_url}\E|\Q$origin\E)(\S*)/m
+ ) {
+ $dst_project = $1;
+ $dst_project =~ s/\.git$//;
+ ds_verbose 'Use "upstream" target as dst project';
+ # 4.4. Use source project as destination
+ } else {
+ ds_warn
+"No upstream target found, using current project as target";
+ $dst_project = $src_project;
+ }
+ ds_verbose "Use $dst_project as dest project";
+ }
+ }
+ # 5. Search for MR title and desc
+ unless ($title) {
+ ds_warn "Title not set, using last commit";
+ spawn(
+ exec => ['git', 'show', '--format=format:%s###%b'],
+ wait_child => 1,
+ to_string => \$out,
+ );
+ $out =~ s/\ndiff.*$//s;
+ my ($t, $d) = split /###/, $out;
+ chomp $d;
+ $title = $t;
+ ds_verbose "Title set to $title";
+ $desc ||= $d;
+ # Replace all bug links by markdown links
+ if ($desc) {
+ $desc =~ s@#(\d{6,})\b@[#$1](https://bugs.debian.org/$1)@mg;
+ ds_verbose "Desc set to $desc";
+ }
+ }
+ }
+ if ($dst_project eq 'same') {
+ $dst_project = $src_project;
+ }
+ my $src = $self->api->project($src_project);
+ unless ($title) {
+ ds_warn "Title is required";
+ return 1;
+ }
+ unless ($src and $src->{id}) {
+ ds_warn "Target project not found $src_project";
+ return 1;
+ }
+ my $dst;
+ if ($dst_project) {
+ $dst = $self->api->project($dst_project);
+ unless ($dst and $dst->{id}) {
+ ds_warn "Target project not found";
+ return 1;
+ }
+ }
+ return 1
+ if (
+ ds_prompt(
+"You're going to push an MR to $dst_project:$dst_branch. Continue (Y/n)"
+ ) =~ refuse
+ );
+ my $res = $self->api->create_merge_request(
+ $src->{id},
+ {
+ source_branch => $src_branch,
+ target_branch => $dst_branch,
+ title => $title,
+ remove_source_branch => $self->config->mr_remove_source_branch,
+ squash => $self->config->mr_allow_squash,
+ ($dst ? (target_project_id => $dst->{id}) : ()),
+ ($desc ? (description => $desc) : ()),
+ });
+ ds_warn "MR '$title' posted:";
+ ds_warn $res->{web_url};
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/merge_requests.pm b/lib/Devscripts/Salsa/merge_requests.pm
new file mode 100644
index 0000000..e722390
--- /dev/null
+++ b/lib/Devscripts/Salsa/merge_requests.pm
@@ -0,0 +1,49 @@
+# Lists merge requests proposed to a project
+package Devscripts::Salsa::merge_requests;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub merge_requests {
+ my ($self, @reponames) = @_;
+ my $res = 1;
+ unless (@reponames) {
+ ds_warn "Repository name is missing";
+ return 1;
+ }
+ foreach my $p (@reponames) {
+ my $id = $self->project2id($p);
+ my $count = 0;
+ unless ($id) {
+ ds_warn "Project $_ not found";
+ return 1;
+ }
+ print "$p\n";
+ my $mrs = $self->api->paginator(
+ 'merge_requests',
+ $id,
+ {
+ state => 'opened',
+ });
+ while ($_ = $mrs->next) {
+ $res = 0;
+ my $status = $_->{work_in_progress} ? 'WIP' : $_->{merge_status};
+ print <<END;
+\tId : $_->{id}
+\tTitle : $_->{title}
+\tAuthor: $_->{author}->{username}
+\tStatus: $status
+\tUrl : $_->{web_url}
+
+END
+ }
+ unless ($count) {
+ print "\n";
+ next;
+ }
+ }
+ return $res;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/pipeline_schedule.pm b/lib/Devscripts/Salsa/pipeline_schedule.pm
new file mode 100755
index 0000000..51c1e09
--- /dev/null
+++ b/lib/Devscripts/Salsa/pipeline_schedule.pm
@@ -0,0 +1,124 @@
+# Create a pipeline schedule using parameters
+package Devscripts::Salsa::pipeline_schedule;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+# For --all
+with "Devscripts::Salsa::Repo";
+
+sub pipeline_schedule {
+ my ($self, @repos) = @_;
+ my $ret = 0;
+ my $desc = $self->config->schedule_desc;
+ my $ref = $self->config->schedule_ref;
+ my $cron = $self->config->schedule_cron;
+ my $tz = $self->config->schedule_tz;
+ my $active = $self->config->schedule_enable;
+ $active
+ = ($self->config->schedule_disable)
+ ? "0"
+ : $active;
+ my $run = $self->config->schedule_run;
+ my $delete = $self->config->schedule_delete;
+
+ unless (@repos or $self->config->all) {
+ ds_warn "Usage $0 pipeline <project|--all>";
+ return 1;
+ }
+ if (@repos and $self->config->all) {
+ ds_warn "--all with a project (@repos) makes no sense";
+ return 1;
+ }
+
+ unless ($desc) {
+ ds_warn "--schedule-desc / SALSA_SCHEDULE_DESC is missing";
+ ds_warn "Are you looking for: $0 pipelines <project|--all>";
+ return 1;
+ }
+
+ # If --all is asked, launch all projects
+ @repos = map { $_->[1] } $self->get_repo(0, @repos) unless (@repos);
+
+ foreach my $repo (sort @repos) {
+ my $id = $self->project2id($repo);
+ unless ($id) {
+#ds_warn "Project $repo not found"; # $self->project2id($repo) shows this error
+ $ret++;
+ return 1 unless $self->config->no_fail;
+ } else {
+ my @pipe_id = ();
+ $desc =~ s/%p/$repo/g;
+ my $options = {};
+ $options->{ref} = $ref if defined $ref;
+ $options->{cron} = $cron if defined $cron;
+ $options->{cron_timezone} = $tz if defined $tz;
+ $options->{active} = $active if defined $active;
+
+# REF: https://docs.gitlab.com/ee/api/pipeline_schedules.html#get-all-pipeline-schedules
+# $self->api->pipeline_schedules($id)
+ my $pipelines
+ = $self->api->paginator('pipeline_schedules', $id)->all();
+ ds_verbose "No pipelines scheduled for $repo" unless @$pipelines;
+
+ foreach (@$pipelines) {
+ push @pipe_id, $_->{id}
+ if ($_->{description} eq $desc);
+ }
+
+ ds_warn "More than 1 scheduled pipeline matches: $desc ("
+ . ++$#pipe_id . ")"
+ if ($pipe_id[1]);
+
+ if (!@pipe_id) {
+ ds_warn "--schedule-ref / SALSA_SCHEDULE_REF is required"
+ unless ($ref);
+ ds_warn "--schedule-cron / SALSA_SCHEDULE_CRON is required"
+ unless ($cron);
+ return 1
+ unless ($ref && $cron);
+
+ $options->{description} = $desc if defined $desc;
+
+ ds_verbose "No scheduled pipelines matching: $desc. Creating!";
+ my $schedule
+ = $self->api->create_pipeline_schedule($id, $options);
+
+ @pipe_id = $schedule->{id};
+ } elsif (keys %$options) {
+ ds_verbose "Editing scheduled pipelines matching: $desc";
+ foreach (@pipe_id) {
+ next if !$_;
+
+ my $schedule
+ = $self->api->edit_pipeline_schedule($id, $_, $options);
+ }
+ }
+
+ if ($run) {
+ ds_verbose "Running scheduled pipelines matching: $desc";
+
+ foreach (@pipe_id) {
+ next if !$_;
+
+ my $schedule = $self->api->run_pipeline_schedule($id, $_);
+ }
+ }
+
+ if ($delete) {
+ ds_verbose "Deleting scheduled pipelines matching: $desc";
+
+ foreach (@pipe_id) {
+ next if !$_;
+
+ my $schedule
+ = $self->api->delete_pipeline_schedule($id, $_);
+ }
+ }
+ }
+ }
+ return $ret;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/pipeline_schedules.pm b/lib/Devscripts/Salsa/pipeline_schedules.pm
new file mode 100755
index 0000000..47c7904
--- /dev/null
+++ b/lib/Devscripts/Salsa/pipeline_schedules.pm
@@ -0,0 +1,70 @@
+# Lists pipeline schedules of a project
+package Devscripts::Salsa::pipeline_schedules;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+# For --all
+with "Devscripts::Salsa::Repo";
+
+sub pipeline_schedules {
+ my ($self, @repo) = @_;
+ my $ret = 0;
+
+ unless (@repo or $self->config->all) {
+ ds_warn "Usage $0 pipelines <project|--all>";
+ return 1;
+ }
+ if (@repo and $self->config->all) {
+ ds_warn "--all with a project (@repo) makes no sense";
+ return 1;
+ }
+
+ # If --all is asked, launch all projects
+ @repo = map { $_->[1] } $self->get_repo(0, @repo) unless (@repo);
+
+ foreach my $p (sort @repo) {
+ my $id = $self->project2id($p);
+ my $count = 0;
+ unless ($id) {
+ #ds_warn "Project $p not found"; # $self->project2id($p) shows this error
+ $ret++;
+ return 1 unless $self->config->no_fail;
+ } else {
+ my $projects = $self->api->project($id);
+ if ($projects->{jobs_enabled} == 0) {
+ print "$p has disabled CI/CD\n";
+ next;
+ }
+
+ my $pipelines
+ = $self->api->paginator('pipeline_schedules', $id)->all();
+
+ print "$p\n" if @$pipelines;
+
+ foreach (@$pipelines) {
+ my $status = $_->{active} ? 'Enabled' : 'Disabled';
+ print <<END;
+\tID : $_->{id}
+\tDescription: $_->{description}
+\tStatus : $status
+\tRef : $_->{ref}
+\tCron : $_->{cron}
+\tTimezone : $_->{cron_timezone}
+\tCreated : $_->{created_at}
+\tUpdated : $_->{updated_at}
+\tNext run : $_->{next_run_at}
+\tOwner : $_->{owner}->{username}
+
+END
+ }
+ }
+ unless ($count) {
+ next;
+ }
+ }
+ return $ret;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/protect_branch.pm b/lib/Devscripts/Salsa/protect_branch.pm
new file mode 100644
index 0000000..5451818
--- /dev/null
+++ b/lib/Devscripts/Salsa/protect_branch.pm
@@ -0,0 +1,43 @@
+# Protects a branch
+package Devscripts::Salsa::protect_branch;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+use constant levels => {
+ o => 50,
+ owner => 50,
+ m => 40,
+ maintainer => 40,
+ d => 30,
+ developer => 30,
+ r => 20,
+ reporter => 20,
+ g => 10,
+ guest => 10,
+};
+
+sub protect_branch {
+ my ($self, $reponame, $branch, $merge, $push) = @_;
+ unless ($reponame and $branch) {
+ ds_warn "usage: $0 protect_branch repo branch merge push";
+ return 1;
+ }
+ if (defined $merge and $merge =~ /^(?:no|0)$/i) {
+ $self->api->unprotect_branch($self->project2id($reponame), $branch);
+ return 0;
+ }
+ unless (levels->{$merge} and levels->{$push}) {
+ ds_warn
+ "usage: $0 protect_branch repo branch <merge level> <push level>";
+ return 1;
+ }
+ my $opts = { name => $branch };
+ $opts->{push_access_level} = (levels->{$push});
+ $opts->{merge_access_level} = (levels->{$merge});
+ $self->api->protect_branch($self->project2id($reponame), $opts);
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/protected_branches.pm b/lib/Devscripts/Salsa/protected_branches.pm
new file mode 100644
index 0000000..cd0cd0e
--- /dev/null
+++ b/lib/Devscripts/Salsa/protected_branches.pm
@@ -0,0 +1,27 @@
+# Displays protected branches of a project
+package Devscripts::Salsa::protected_branches;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub protected_branches {
+ my ($self, $reponame) = @_;
+ unless ($reponame) {
+ ds_warn "Repository name is missing";
+ return 1;
+ }
+ my $branches
+ = $self->api->protected_branches($self->project2id($reponame));
+ if ($branches and @$branches) {
+ printf " %-20s | %-25s | %-25s\n", 'Branch', 'Merge', 'Push';
+ foreach (@$branches) {
+ printf " %-20s | %-25s | %-25s\n", $_->{name},
+ $_->{merge_access_levels}->[0]->{access_level_description},
+ $_->{push_access_levels}->[0]->{access_level_description};
+ }
+ }
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/purge_cache.pm b/lib/Devscripts/Salsa/purge_cache.pm
new file mode 100644
index 0000000..187f698
--- /dev/null
+++ b/lib/Devscripts/Salsa/purge_cache.pm
@@ -0,0 +1,15 @@
+# Empties the Devscripts::JSONCache
+package Devscripts::Salsa::purge_cache;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub purge_cache {
+ my @keys = keys %{ $_[0]->_cache };
+ delete $_[0]->_cache->{$_} foreach (@keys);
+ ds_verbose "Cache empty";
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/push.pm b/lib/Devscripts/Salsa/push.pm
new file mode 100644
index 0000000..fa3b6cc
--- /dev/null
+++ b/lib/Devscripts/Salsa/push.pm
@@ -0,0 +1,106 @@
+# Push local work. Like gbp push but able to push incomplete work
+package Devscripts::Salsa::push;
+use strict;
+use Devscripts::Output;
+use Devscripts::Utils;
+use Dpkg::Source::Format;
+use Moo::Role;
+use Dpkg::IPC;
+
+sub readGbpConf {
+ my ($self) = @_;
+ my $res = '';
+ foreach my $gbpconf (qw(.gbp.conf debian/gbp.conf .git/gbp.conf)) {
+ if (-e $gbpconf) {
+ open(my $f, $gbpconf);
+ while (<$f>) {
+ $res .= $_;
+ if (/^\s*(debian|upstream)\-(branch|tag)\s*=\s*(.*\S)/) {
+ $self->{"$1_$2"} = $3;
+ }
+ }
+ close $f;
+ last;
+ }
+ }
+ if ($self->{debian_tag}) {
+ $self->{debian_tag} =~ s/%\(version\)s/.*/g;
+ $self->{debian_tag} =~ s/^/^/;
+ $self->{debian_tag} =~ s/$/\$/;
+ } else {
+ my @tmp
+ = Dpkg::Source::Format->new(filename => 'debian/source/format')->get;
+ $self->{debian_tag} = $tmp[2] eq 'native' ? '.*' : '^debian/.*$';
+ }
+ if ($self->{upstream_tag}) {
+ $self->{upstream_tag} =~ s/%\(version\)s/.*/g;
+ $self->{upstream_tag} =~ s/^/^/;
+ $self->{upstream_tag} =~ s/$/\$/;
+ } else {
+ $self->{upstream_tag} = '^upstream/.*$';
+ }
+ $self->{debian_branch} ||= 'master';
+ $self->{upstream_branch} ||= 'upstream';
+ return $res;
+}
+
+sub push {
+ my ($self) = @_;
+ $self->readGbpConf;
+ my @refs;
+ foreach (
+ $self->{debian_branch}, $self->{upstream_branch},
+ 'pristine-tar', 'refs/notes/commits'
+ ) {
+ if (ds_exec_no_fail(qw(git rev-parse --verify --quiet), $_) == 0) {
+ push @refs, $_;
+ }
+ }
+ my $out;
+ spawn(exec => ['git', 'tag'], wait_child => 1, to_string => \$out);
+ my @tags = grep /(?:$self->{debian_tag}|$self->{upstream_tag})/,
+ split(/\r?\n/, $out);
+ unless (
+ $ds_yes < 0
+ and ds_prompt(
+ "You're going to push :\n - "
+ . join(', ', @refs)
+ . "\nand check tags that match:\n - "
+ . join(', ', $self->{debian_tag}, $self->{upstream_tag})
+ . "\nContinue (Y/n) "
+ ) =~ refuse
+ ) {
+ my $origin;
+ eval {
+ spawn(
+ exec => ['git', 'rev-parse', '--abbrev-ref', 'HEAD'],
+ wait_child => 1,
+ to_string => \$out,
+ );
+ chomp $out;
+ spawn(
+ exec =>
+ ['git', 'config', '--local', '--get', "branch.$out.remote"],
+ wait_child => 1,
+ to_string => \$origin,
+ );
+ chomp $origin;
+ };
+ if ($origin) {
+ ds_verbose 'Origin is ' . $origin;
+ } else {
+ ds_warn 'Unable to detect remote name, trying "origin"';
+ ds_verbose "Error: $@" if ($@);
+ $origin = 'origin';
+ }
+ ds_verbose "Execute 'git push $origin " . join(' ', @refs, '<tags>');
+ ds_debug "Tags are: " . join(' ', @tags);
+ spawn(
+ exec => ['git', 'push', $origin, @refs, @tags],
+ wait_child => 1
+ );
+ }
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/push_repo.pm b/lib/Devscripts/Salsa/push_repo.pm
new file mode 100644
index 0000000..94e8ff3
--- /dev/null
+++ b/lib/Devscripts/Salsa/push_repo.pm
@@ -0,0 +1,71 @@
+# Creates GitLab repo from local path
+package Devscripts::Salsa::push_repo;
+
+use strict;
+use Devscripts::Output;
+use Dpkg::IPC;
+use Moo::Role;
+
+with "Devscripts::Salsa::create_repo";
+
+sub push_repo {
+ my ($self, $reponame) = @_;
+ unless ($reponame) {
+ ds_warn "Repository path is missing";
+ return 1;
+ }
+ unless (-d $reponame) {
+ ds_warn "$reponame isn't a directory";
+ return 1;
+ }
+ chdir $reponame;
+ eval {
+ spawn(
+ exec => ['dpkg-parsechangelog', '--show-field', 'Source'],
+ to_string => \$reponame,
+ wait_child => 1,
+ );
+ };
+ if ($@) {
+ ds_warn $@;
+ return 1;
+ }
+ chomp $reponame;
+ my $out;
+ spawn(
+ exec => ['git', 'remote', 'show'],
+ to_string => \$out,
+ wait_child => 1,
+ );
+ if ($out =~ /^origin$/m) {
+ ds_warn "git origin is already configured:\n$out";
+ return 1;
+ }
+ my $path = $self->project2path('') or return 1;
+ my $url = $self->config->git_server_url . "$path$reponame";
+ spawn(
+ exec => ['git', 'remote', 'add', 'origin', $url],
+ wait_child => 1,
+ );
+ my $res = $self->create_repo($reponame);
+ if ($res) {
+ return 1
+ unless (
+ ds_prompt(
+"Project already exists, do you want to try to push local repo? (y/N) "
+ ) =~ accept
+ );
+ }
+ spawn(
+ exec =>
+ ['git', 'push', '--all', '--verbose', '--set-upstream', 'origin'],
+ wait_child => 1,
+ );
+ spawn(
+ exec => ['git', 'push', '--tags', '--verbose', 'origin'],
+ wait_child => 1,
+ );
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/rename_branch.pm b/lib/Devscripts/Salsa/rename_branch.pm
new file mode 100644
index 0000000..d908080
--- /dev/null
+++ b/lib/Devscripts/Salsa/rename_branch.pm
@@ -0,0 +1,45 @@
+package Devscripts::Salsa::rename_branch;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+with "Devscripts::Salsa::Repo";
+
+our $prompt = 1;
+
+sub rename_branch {
+ my ($self, @reponames) = @_;
+ my $res = 0;
+ my @repos = $self->get_repo($prompt, @reponames);
+ return @repos unless (ref $repos[0]); # get_repo returns 1 when fails
+ foreach (@repos) {
+ my $id = $_->[0];
+ ds_verbose "Configuring $_->[1]";
+ my $project = $self->api->project($_->[0]);
+ eval {
+ $self->api->create_branch(
+ $id,
+ {
+ ref => $self->config->source_branch,
+ branch => $self->config->dest_branch,
+ });
+ $self->api->delete_branch($id, $self->config->source_branch);
+ };
+ if ($@) {
+ $res++;
+ if ($self->config->no_fail) {
+ ds_verbose $@;
+ ds_warn
+"Branch rename has failed for $_->[1]. Use --verbose to see errors\n";
+ next;
+ } else {
+ ds_warn $@;
+ return 1;
+ }
+ }
+ }
+ return $res;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/search_group.pm b/lib/Devscripts/Salsa/search_group.pm
new file mode 100644
index 0000000..2fd047b
--- /dev/null
+++ b/lib/Devscripts/Salsa/search_group.pm
@@ -0,0 +1,37 @@
+# Searches groups using given string
+package Devscripts::Salsa::search_group;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub search_group {
+ my ($self, $group) = @_;
+ unless ($group) {
+ ds_warn "Searched string is missing";
+ return 1;
+ }
+ my $groups = $self->api->group_without_projects($group);
+ if ($groups) {
+ $groups = [$groups];
+ } else {
+ $groups = $self->api->paginator('groups',
+ { search => $group, order_by => 'name' })->all;
+ }
+ unless ($groups and @$groups) {
+ ds_warn "No group found";
+ return 1;
+ }
+ foreach (@$groups) {
+ print <<END;
+Id : $_->{id}
+Name : $_->{name}
+Full name: $_->{full_name}
+Full path: $_->{full_path}
+
+END
+ }
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/search_project.pm b/lib/Devscripts/Salsa/search_project.pm
new file mode 100644
index 0000000..34584bf
--- /dev/null
+++ b/lib/Devscripts/Salsa/search_project.pm
@@ -0,0 +1,57 @@
+# Searches projects using given string
+package Devscripts::Salsa::search_project;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub search_project {
+ my ($self, $project) = @_;
+ unless ($project) {
+ ds_warn "Searched string is missing";
+ return 1;
+ }
+ my $projects = $self->api->project($project);
+ if ($projects) {
+ $projects = [$projects];
+ } else {
+ $projects = $self->api->paginator(
+ 'projects',
+ {
+ search => $project,
+ order_by => 'name',
+ archived => $self->config->archived
+ })->all();
+ }
+ unless ($projects and @$projects) {
+ ds_warn "No projects found";
+ return 1;
+ }
+ foreach (@$projects) {
+ print <<END;
+Id : $_->{id}
+Name : $_->{name}
+Full path: $_->{path_with_namespace}
+END
+ print(
+ $_->{namespace}->{kind} eq 'group'
+ ? "Group id : "
+ : "User id : "
+ );
+ print "$_->{namespace}->{id}\n";
+ print(
+ $_->{namespace}->{kind} eq 'group'
+ ? "Group : "
+ : "User : "
+ );
+ print "$_->{namespace}->{name}\n";
+ if ($_->{forked_from_project} and $_->{forked_from_project}->{id}) {
+ print
+ "Fork of : $_->{forked_from_project}->{name_with_namespace}\n";
+ }
+ print "\n";
+ }
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/search_user.pm b/lib/Devscripts/Salsa/search_user.pm
new file mode 100644
index 0000000..2a14580
--- /dev/null
+++ b/lib/Devscripts/Salsa/search_user.pm
@@ -0,0 +1,36 @@
+# Searches users using given string
+package Devscripts::Salsa::search_user;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub search_user {
+ my ($self, $user) = @_;
+ unless ($user) {
+ ds_warn "User name is missing";
+ return 1;
+ }
+ my $users = $self->api->user($user);
+ if ($users) {
+ $users = [$users];
+ } else {
+ $users = $self->api->paginator('users', { search => $user })->all();
+ }
+ unless ($users and @$users) {
+ ds_warn "No user found";
+ return 1;
+ }
+ foreach (@$users) {
+ print <<END;
+Id : $_->{id}
+Username : $_->{username}
+Name : $_->{name}
+State : $_->{state}
+
+END
+ }
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/update_repo.pm b/lib/Devscripts/Salsa/update_repo.pm
new file mode 100644
index 0000000..7902313
--- /dev/null
+++ b/lib/Devscripts/Salsa/update_repo.pm
@@ -0,0 +1,140 @@
+# Updates repositories
+package Devscripts::Salsa::update_repo;
+
+use strict;
+use Devscripts::Output;
+use GitLab::API::v4::Constants qw(:all);
+use Moo::Role;
+
+with "Devscripts::Salsa::Repo";
+
+our $prompt = 1;
+
+sub update_repo {
+ my ($self, @reponames) = @_;
+ if ($ds_yes < 0 and $self->config->command eq 'update_repo') {
+ ds_warn
+ "update_repo can't be launched when -i is set, use update_safe";
+ return 1;
+ }
+ unless (@reponames or $self->config->all or $self->config->all_archived) {
+ ds_warn "Usage $0 update_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;
+ }
+ return $self->_update_repo(@reponames);
+}
+
+sub _update_repo {
+ my ($self, @reponames) = @_;
+ my $res = 0;
+ # Common options
+ my $configparams = {};
+ # visibility can be modified only by group owners
+ $configparams->{visibility} = 'public'
+ if $self->access_level >= $GITLAB_ACCESS_LEVEL_OWNER;
+ # get repo list using Devscripts::Salsa::Repo
+ my @repos = $self->get_repo($prompt, @reponames);
+ return @repos unless (ref $repos[0]); # get_repo returns 1 when fails
+ foreach my $repo (@repos) {
+ ds_verbose "Configuring $repo->[1]";
+ my $id = $repo->[0];
+ my $str = $repo->[1];
+ eval {
+ # apply new parameters
+ $self->api->edit_project(
+ $id,
+ {
+ %$configparams,
+ $self->desc($repo->[1]),
+ $self->desc_multipart($repo->[1]) });
+ # add hooks if needed
+ $str =~ s#^.*/##;
+ $self->add_hooks($id, $str);
+ };
+ if ($@) {
+ $res++;
+ if ($self->config->no_fail) {
+ ds_verbose $@;
+ ds_warn
+"update_repo has failed for $repo->[1]. Use --verbose to see errors\n";
+ next;
+ } else {
+ ds_warn $@;
+ return 1;
+ }
+ } elsif ($self->config->rename_head) {
+ # 1 - creates new branch if --rename-head
+ my $project = $self->api->project($id);
+ if ($project->{default_branch} ne $self->config->dest_branch) {
+ eval {
+ $self->api->create_branch(
+ $id,
+ {
+ ref => $self->config->source_branch,
+ branch => $self->config->dest_branch,
+ });
+ };
+ if ($@) {
+ ds_debug $@ if ($@);
+ $project = undef;
+ }
+
+ eval {
+ $self->api->edit_project($id,
+ { default_branch => $self->config->dest_branch });
+ # delete old branch only if "create_branch" succeed
+ if ($project) {
+ $self->api->delete_branch($id,
+ $self->config->source_branch);
+ }
+ };
+ if ($@) {
+ $res++;
+ if ($self->config->no_fail) {
+ ds_verbose $@;
+ ds_warn
+"Branch rename has failed for $repo->[1]. Use --verbose to see errors\n";
+ next;
+ } else {
+ ds_warn $@;
+ return 1;
+ }
+ }
+ } else {
+ ds_verbose "Head already renamed for $str";
+ }
+ }
+ ds_verbose "Project $str updated";
+ }
+ return $res;
+}
+
+sub access_level {
+ my ($self) = @_;
+ my $user_id = $self->api->current_user()->{id};
+ if ($self->group_id) {
+ my $tmp = $self->api->group_member($self->group_id, $user_id);
+ unless ($tmp) {
+ my $members
+ = $self->api->paginator('all_group_members', $self->group_id,
+ { query => $user_id });
+ while ($_ = $members->next) {
+ return $_->{access_level} if ($_->{id} eq $user_id);
+ }
+ ds_warn "You're not member of this group";
+ return 0;
+ }
+ return $tmp->{access_level};
+ }
+ return $GITLAB_ACCESS_LEVEL_OWNER;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/update_safe.pm b/lib/Devscripts/Salsa/update_safe.pm
new file mode 100644
index 0000000..6d32e88
--- /dev/null
+++ b/lib/Devscripts/Salsa/update_safe.pm
@@ -0,0 +1,22 @@
+# launches check_repo and launch uscan_repo if user agrees with this changes
+package Devscripts::Salsa::update_safe;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+with 'Devscripts::Salsa::check_repo';
+with 'Devscripts::Salsa::update_repo';
+
+sub update_safe {
+ my $self = shift;
+ my ($res, $fails) = $self->_check_repo(@_);
+ return 0 unless ($res);
+ return $res
+ if (ds_prompt("$res packages misconfigured, update them ? (Y/n) ")
+ =~ refuse);
+ $Devscripts::Salsa::update_repo::prompt = 0;
+ return $self->_update_repo(@$fails);
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/update_user.pm b/lib/Devscripts/Salsa/update_user.pm
new file mode 100644
index 0000000..f7dfeba
--- /dev/null
+++ b/lib/Devscripts/Salsa/update_user.pm
@@ -0,0 +1,38 @@
+# Updates user role in a group
+package Devscripts::Salsa::update_user;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub update_user {
+ my ($self, $level, $user) = @_;
+ unless ($level and $user) {
+ ds_warn "Usage $0 update_user <level> <userid>";
+ return 1;
+ }
+ unless ($self->group_id) {
+ ds_warn "Unable to update user without --group-id";
+ return 1;
+ }
+
+ my $id = $self->username2id($user);
+ my $al = $self->levels_name($level);
+ return 1
+ if (
+ $ds_yes < 0
+ and ds_prompt(
+"You're going to accept $user as $level in group $self->{group_id}. Continue (Y/n) "
+ ) =~ refuse
+ );
+ $self->api->update_group_member(
+ $self->group_id,
+ $id,
+ {
+ access_level => $al,
+ });
+ ds_warn "User $user removed from group " . $self->group_id;
+ return 0;
+}
+
+1;
diff --git a/lib/Devscripts/Salsa/whoami.pm b/lib/Devscripts/Salsa/whoami.pm
new file mode 100644
index 0000000..176e591
--- /dev/null
+++ b/lib/Devscripts/Salsa/whoami.pm
@@ -0,0 +1,24 @@
+# Gives information on token owner
+package Devscripts::Salsa::whoami;
+
+use strict;
+use Devscripts::Output;
+use Moo::Role;
+
+sub whoami {
+ my ($self) = @_;
+ my $current_user = $self->api->current_user;
+ print <<END;
+Id : $current_user->{id}
+Username: $current_user->{username}
+Name : $current_user->{name}
+Email : $current_user->{email}
+State : $current_user->{state}
+END
+ $self->cache->{user}->{ $current_user->{id} } = $current_user->{username};
+ $self->cache->{user_id}->{ $current_user->{username} }
+ = $current_user->{id};
+ return 0;
+}
+
+1;
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-07 04:14:20 +0000