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 lei_add_external {
  92         my ($self, $location) = @_;
  93         my $cfg = $self->_lei_cfg(1);
  94         my $new_boost = $self->{opt}->{boost} // 0;
  95         $location = ext_canonicalize($location);
  96         if ($location !~ m!\Ahttps?://! && !-d $location) {
  97                 return $self->fail("$location not a directory");
  98         }
  99         my $key = "external.$location.boost";
 100         my $cur_boost = $cfg->{$key};
 101         return if defined($cur_boost) && $cur_boost == $new_boost; # idempotent
 102         $self->lei_config($key, $new_boost);
 103         $self->_lei_store(1)->done; # just create the store
 104 }
 105
 106 sub lei_forget_external {
 107         my ($self, @locations) = @_;
 108         my $cfg = $self->_lei_cfg(1);
 109         my $quiet = $self->{opt}->{quiet};
 110         my %seen;
 111         for my $loc (@locations) {
 112                 my (@unset, @not_found);
 113                 for my $l ($loc, ext_canonicalize($loc)) {
 114                         next if $seen{$l}++;
 115                         my $key = "external.$l.boost";
 116                         delete($cfg->{$key});
 117                         $self->_config('--unset', $key);
 118                         if ($? == 0) {
 119                                 push @unset, $l;
 120                         } elsif (($? >> 8) == 5) {
 121                                 push @not_found, $l;
 122                         } else {
 123                                 $self->err("# --unset $key error");
 124                                 return $self->x_it($?);
 125                         }
 126                 }
 127                 if (@unset) {
 128                         next if $quiet;
 129                         $self->err("# $_ gone") for @unset;
 130                 } elsif (@not_found) {
 131                         $self->err("# $_ not found") for @not_found;
 132                 } # else { already exited
 133         }
 134 }
 135
 136 sub _complete_url_common ($) {
 137         my ($argv) = @_;
 138         # Workaround bash word-splitting URLs to ['https', ':', '//' ...]
 139         # Maybe there's a better way to go about this in
 140         # contrib/completion/lei-completion.bash
 141         my $re = '';
 142         my $cur = pop @$argv;
 143         if (@$argv) {
 144                 my @x = @$argv;
 145                 if ($cur eq ':' && @x) {
 146                         push @x, $cur;
 147                         $cur = '';
 148                 }
 149                 while (@x > 2 && $x[0] !~ /\Ahttps?\z/ && $x[1] ne ':') {
 150                         shift @x;
 151                 }
 152                 if (@x >= 2) { # qw(https : hostname : 443) or qw(http :)
 153                         $re = join('', @x);
 154                 } else { # just filter out the flags and hope for the best
 155                         $re = join('', grep(!/^-/, @$argv));
 156                 }
 157                 $re = quotemeta($re);
 158         }
 159         ($cur, $re);
 160 }
 161
 162 # shell completion helper called by lei__complete
 163 sub _complete_forget_external {
 164         my ($self, @argv) = @_;
 165         my $cfg = $self->_lei_cfg(0);
 166         my ($cur, $re) = _complete_url_common(\@argv);
 167         # FIXME: bash completion off "http:" or "https:" when the last
 168         # character is a colon doesn't work properly even if we're
 169         # returning "//$HTTP_HOST/$PATH_INFO/", not sure why, could
 170         # be a bash issue.
 171         map {
 172                 my $x = substr($_, length('external.'));
 173                 # only return the part specified on the CLI
 174                 # don't duplicate if already 100% completed
 175                 $x =~ /\A$re(\Q$cur\E.*)/ ? ($cur eq $1 ? () : $1) : ();
 176         } grep(/\Aexternal\.$re\Q$cur/, @{$cfg->{-section_order}});
 177 }
 178
 179 sub _complete_add_external { # for bash, this relies on "compopt -o nospace"
 180         my ($self, @argv) = @_;
 181         my $cfg = $self->_lei_cfg(0);
 182         my ($cur, $re) = _complete_url_common(\@argv);
 183         require URI;
 184         map {
 185                 my $u = URI->new(substr($_, length('external.')));
 186                 my ($base) = ($u->path =~ m!((?:/?.*)?/)[^/]+/?\z!);
 187                 $u->path($base);
 188                 $u = $u->as_string;
 189                 $u =~ /\A$re(\Q$cur\E.*)/ ? ($cur eq $1 ? () : $1) : ();
 190         } grep(m!\Aexternal\.https?://!, @{$cfg->{-section_order}});
 191 }
 192
 193 1;