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