lib/PublicInbox/LeiExternal.pm

   1 # Copyright (C) 2020-2021 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # *-external commands of lei
   5 package PublicInbox::LeiExternal;
   6 use strict;
   7 use v5.10.1;
   8 use parent qw(Exporter);
   9 our @EXPORT = qw(lei_ls_external lei_add_external lei_forget_external);
  10 use PublicInbox::Config;
  11
  12 sub externals_each {
  13         my ($self, $cb, @arg) = @_;
  14         my $cfg = $self->_lei_cfg(0);
  15         my %boost;
  16         for my $sec (grep(/\Aexternal\./, @{$cfg->{-section_order}})) {
  17                 my $loc = substr($sec, length('external.'));
  18                 $boost{$loc} = $cfg->{"$sec.boost"};
  19         }
  20         return \%boost if !wantarray && !$cb;
  21
  22         # highest boost first, but stable for alphabetic tie break
  23         use sort 'stable';
  24         my @order = sort { $boost{$b} <=> $boost{$a} } sort keys %boost;
  25         return @order if !$cb;
  26         for my $loc (@order) {
  27                 $cb->(@arg, $loc, $boost{$loc});
  28         }
  29         @order; # scalar or array
  30 }
  31
  32 sub lei_ls_external {
  33         my ($self, @argv) = @_;
  34         my ($OFS, $ORS) = $self->{opt}->{z} ? ("\0", "\0\0") : (" ", "\n");
  35         externals_each($self, sub {
  36                 my ($loc, $boost_val) = @_;
  37                 $self->out($loc, $OFS, 'boost=', $boost_val, $ORS);
  38         });
  39 }
  40
  41 sub ext_canonicalize {
  42         my ($location) = @_;
  43         if ($location !~ m!\Ahttps?://!) {
  44                 PublicInbox::Config::rel2abs_collapsed($location);
  45         } else {
  46                 require URI;
  47                 my $uri = URI->new($location)->canonical;
  48                 my $path = $uri->path . '/';
  49                 $path =~ tr!/!/!s; # squeeze redundant '/'
  50                 $uri->path($path);
  51                 $uri->as_string;
  52         }
  53 }
  54
  55 my %patmap = ('*' => '[^/]*?', '?' => '[^/]', '[' => '[', ']' => ']');
  56 sub glob2pat {
  57         my ($glob) = @_;
  58         $glob =~ s!(.)!$patmap{$1} || "\Q$1"!ge;
  59         $glob;
  60 }
  61
  62 sub get_externals {
  63         my ($self, $loc, $exclude) = @_;
  64         return (ext_canonicalize($loc)) if -e $loc;
  65
  66         my @m;
  67         my @cur = externals_each($self);
  68         my $do_glob = !$self->{opt}->{globoff}; # glob by default
  69         if ($do_glob && ($loc =~ /[\*\?]/s || $loc =~ /\[.*\]/s)) {
  70                 my $re = glob2pat($loc);
  71                 @m = grep(m!$re!, @cur);
  72                 return @m if scalar(@m);
  73         } elsif (index($loc, '/') < 0) { # exact basename match:
  74                 @m = grep(m!/\Q$loc\E/?\z!, @cur);
  75                 return @m if scalar(@m) == 1;
  76         } elsif ($exclude) { # URL, maybe:
  77                 my $canon = ext_canonicalize($loc);
  78                 @m = grep(m!\A\Q$canon\E\z!, @cur);
  79                 return @m if scalar(@m) == 1;
  80         } else { # URL:
  81                 return (ext_canonicalize($loc));
  82         }
  83         if (scalar(@m) == 0) {
  84                 $self->fail("`$loc' is unknown");
  85         } else {
  86                 $self->fail("`$loc' is ambiguous:\n", map { "\t$_\n" } @m);
  87         }
  88         ();
  89 }
  90
  91 sub add_external_finish {
  92         my ($self, $location) = @_;
  93         my $cfg = $self->_lei_cfg(1);
  94         my $new_boost = $self->{opt}->{boost} // 0;
  95         my $key = "external.$location.boost";
  96         my $cur_boost = $cfg->{$key};
  97         return if defined($cur_boost) && $cur_boost == $new_boost; # idempotent
  98         $self->lei_config($key, $new_boost);
  99 }
 100
 101 sub lei_add_external {
 102         my ($self, $location) = @_;
 103         $self->_lei_store(1)->write_prepare($self);
 104         my $opt = $self->{opt};
 105         my $mirror = $opt->{mirror} // do {
 106                 my @fail;
 107                 for my $sw ($self->index_opt, $self->curl_opt,
 108                                 qw(c no-torsocks torsocks inbox-version)) {
 109                         my ($f) = (split(/|/, $sw, 2))[0];
 110                         next unless defined $opt->{$f};
 111                         $f = length($f) == 1 ? "-$f" : "--$f";
 112                         push @fail, $f;
 113                 }
 114                 if (scalar(@fail) == 1) {
 115                         return $self->("@fail requires --mirror");
 116                 } elsif (@fail) {
 117                         my $last = pop @fail;
 118                         my $fail = join(', ', @fail);
 119                         return $self->("@fail and $last require --mirror");
 120                 }
 121                 undef;
 122         };
 123         my $new_boost = $opt->{boost} // 0;
 124         $location = ext_canonicalize($location);
 125         if (defined($mirror) && -d $location) {
 126                 $self->fail(<<""); # TODO: did you mean "update-external?"
 127 --mirror destination `$location' already exists
 128
 129         }
 130         if ($location !~ m!\Ahttps?://! && !-d $location) {
 131                 $mirror // return $self->fail("$location not a directory");
 132                 $mirror = ext_canonicalize($mirror);
 133                 require PublicInbox::LeiMirror;
 134                 PublicInbox::LeiMirror->start($self, $mirror => $location);
 135         } else {
 136                 add_external_finish($self, $location);
 137         }
 138 }
 139
 140 sub lei_forget_external {
 141         my ($self, @locations) = @_;
 142         my $cfg = $self->_lei_cfg(1);
 143         my $quiet = $self->{opt}->{quiet};
 144         my %seen;
 145         for my $loc (@locations) {
 146                 my (@unset, @not_found);
 147                 for my $l ($loc, ext_canonicalize($loc)) {
 148                         next if $seen{$l}++;
 149                         my $key = "external.$l.boost";
 150                         delete($cfg->{$key});
 151                         $self->_config('--unset', $key);
 152                         if ($? == 0) {
 153                                 push @unset, $l;
 154                         } elsif (($? >> 8) == 5) {
 155                                 push @not_found, $l;
 156                         } else {
 157                                 $self->err("# --unset $key error");
 158                                 return $self->x_it($?);
 159                         }
 160                 }
 161                 if (@unset) {
 162                         next if $quiet;
 163                         $self->err("# $_ gone") for @unset;
 164                 } elsif (@not_found) {
 165                         $self->err("# $_ not found") for @not_found;
 166                 } # else { already exited
 167         }
 168 }
 169
 170 sub _complete_url_common ($) {
 171         my ($argv) = @_;
 172         # Workaround bash word-splitting URLs to ['https', ':', '//' ...]
 173         # Maybe there's a better way to go about this in
 174         # contrib/completion/lei-completion.bash
 175         my $re = '';
 176         my $cur = pop @$argv;
 177         if (@$argv) {
 178                 my @x = @$argv;
 179                 if ($cur eq ':' && @x) {
 180                         push @x, $cur;
 181                         $cur = '';
 182                 }
 183                 while (@x > 2 && $x[0] !~ /\Ahttps?\z/ && $x[1] ne ':') {
 184                         shift @x;
 185                 }
 186                 if (@x >= 2) { # qw(https : hostname : 443) or qw(http :)
 187                         $re = join('', @x);
 188                 } else { # just filter out the flags and hope for the best
 189                         $re = join('', grep(!/^-/, @$argv));
 190                 }
 191                 $re = quotemeta($re);
 192         }
 193         ($cur, $re);
 194 }
 195
 196 # shell completion helper called by lei__complete
 197 sub _complete_forget_external {
 198         my ($self, @argv) = @_;
 199         my $cfg = $self->_lei_cfg(0);
 200         my ($cur, $re) = _complete_url_common(\@argv);
 201         # FIXME: bash completion off "http:" or "https:" when the last
 202         # character is a colon doesn't work properly even if we're
 203         # returning "//$HTTP_HOST/$PATH_INFO/", not sure why, could
 204         # be a bash issue.
 205         map {
 206                 my $x = substr($_, length('external.'));
 207                 # only return the part specified on the CLI
 208                 # don't duplicate if already 100% completed
 209                 $x =~ /\A$re(\Q$cur\E.*)/ ? ($cur eq $1 ? () : $1) : ();
 210         } grep(/\Aexternal\.$re\Q$cur/, @{$cfg->{-section_order}});
 211 }
 212
 213 sub _complete_add_external { # for bash, this relies on "compopt -o nospace"
 214         my ($self, @argv) = @_;
 215         my $cfg = $self->_lei_cfg(0);
 216         my ($cur, $re) = _complete_url_common(\@argv);
 217         require URI;
 218         map {
 219                 my $u = URI->new(substr($_, length('external.')));
 220                 my ($base) = ($u->path =~ m!((?:/?.*)?/)[^/]+/?\z!);
 221                 $u->path($base);
 222                 $u = $u->as_string;
 223                 $u =~ /\A$re(\Q$cur\E.*)/ ? ($cur eq $1 ? () : $1) : ();
 224         } grep(m!\Aexternal\.https?://!, @{$cfg->{-section_order}});
 225 }
 226
 227 1;