lib/PublicInbox/LeiLcat.pm

   1 # Copyright (C) 2021 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # lcat: local cat, display a local message by Message-ID or blob,
   5 # extracting from URL necessary
   6 # "lei lcat <URL|SPEC>"
   7 package PublicInbox::LeiLcat;
   8 use strict;
   9 use v5.10.1;
  10 use PublicInbox::LeiViewText;
  11 use URI::Escape qw(uri_unescape);
  12 use PublicInbox::MID qw($MID_EXTRACT);
  13
  14 sub lcat_imap_uri ($$) {
  15         my ($lei, $uri) = @_;
  16         my $lms = $lei->{lse}->lms or return;
  17         # cf. LeiToMail->wq_atexit_child
  18         if (defined $uri->uid) {
  19                 my $oidhex = $lms->imap_oid($lei, $uri);
  20                 if (ref(my $err = $oidhex)) { # art2folder error
  21                         $lei->qerr(@{$err->{qerr}}) if $err->{qerr};
  22                 }
  23                 push @{$lei->{lcat_blob}}, $oidhex;
  24         } elsif (defined(my $fid = $lms->fid_for($$uri))) {
  25                 push @{$lei->{lcat_fid}}, $fid;
  26         } else {
  27                 my $folders = [ $$uri ];
  28                 my $err = $lms->arg2folder($lei, $folders);
  29                 $lei->qerr(@{$err->{qerr}}) if $err && $err->{qerr};
  30                 if ($err && $err->{fail}) {
  31                         $lei->child_error(1 << 8, "# unknown folder: $uri");
  32                 } else {
  33                         for my $f (@$folders) {
  34                                 my $fid = $lms->fid_for($f);
  35                                 push @{$lei->{lcat_fid}}, $fid;
  36                         }
  37                 }
  38         }
  39 }
  40
  41 sub extract_1 ($$) {
  42         my ($lei, $x) = @_;
  43         if ($x =~ m!\b(imaps?://[^>]+)!i) {
  44                 my $u = $1;
  45                 require PublicInbox::URIimap;
  46                 lcat_imap_uri($lei, PublicInbox::URIimap->new($u));
  47                 '""'; # blank query, using {lcat_blob} or {lcat
  48         } elsif ($x =~ m!\b([a-z]+?://\S+)!i) {
  49                 my $u = $1;
  50                 $u =~ s/[\>\]\)\,\.\;]+\z//;
  51                 require URI;
  52                 $u = URI->new($u);
  53                 my $p = $u->path;
  54                 my $term;
  55                 if ($p =~ m!([^/]+\@[^/]+)!) { # common msgid pattern
  56                         $term = 'mid:'.uri_unescape($1);
  57
  58                         # is it a URL which returns the full thread?
  59                         if ($u->scheme =~ /\Ahttps?/i &&
  60                                 $p =~ m!/(?:T/?|t/?|t\.mbox\.gz|t\.atom)\b!) {
  61
  62                                 $lei->{mset_opt}->{threads} = 1;
  63                         }
  64                 } elsif ($u->scheme =~ /\Ahttps?/i &&
  65                                 # some msgids don't have '@', see if it looks like
  66                                 # a public-inbox URL:
  67                                 $p =~ m!/([^/]+)/(raw|t/?|T/?|
  68                                         t\.mbox\.gz|t\.atom)\z!x) {
  69                         $lei->{mset_opt}->{threads} = 1 if $2 && $2 ne 'raw';
  70                         $term = 'mid:'.uri_unescape($1);
  71                 }
  72                 $term;
  73         } elsif ($x =~ $MID_EXTRACT) { # <$MSGID>
  74                 "mid:$1";
  75         } elsif ($x =~ /\b((?:m|mid):\S+)/) { # our own prefixes (and mairix)
  76                 $1;
  77         } elsif ($x =~ /\bid:(\S+)/) { # notmuch convention
  78                 "mid:$1";
  79         } elsif ($x =~ /\bblob:([0-9a-f]{7,})\b/) {
  80                 push @{$lei->{lcat_blob}}, $1; # cf. LeiToMail->wq_atexit_child
  81                 '""'; # blank query
  82         } else {
  83                 undef;
  84         }
  85 }
  86
  87 sub extract_all {
  88         my ($lei, @argv) = @_;
  89         my $strict = !$lei->{opt}->{stdin};
  90         my @q;
  91         for my $x (@argv) {
  92                 if (my $term = extract_1($lei,$x)) {
  93                         push @q, $term;
  94                 } elsif ($strict) {
  95                         return $lei->fail(<<"");
  96 could not extract Message-ID from $x
  97
  98                 }
  99         }
 100         @q ? join(' OR ', @q) : $lei->fail("no Message-ID in: @argv");
 101 }
 102
 103 sub _stdin { # PublicInbox::InputPipe::consume callback for --stdin
 104         my ($lei) = @_; # $_[1] = $rbuf
 105         if (defined($_[1])) {
 106                 $_[1] eq '' and return eval {
 107                         $lei->fchdir or return;
 108                         my @argv = split(/\s+/, $lei->{mset_opt}->{qstr});
 109                         $lei->{mset_opt}->{qstr} = extract_all($lei, @argv)
 110                                 or return;
 111                         $lei->_start_query;
 112                 };
 113                 $lei->{mset_opt}->{qstr} .= $_[1];
 114         } else {
 115                 $lei->fail("error reading stdin: $!");
 116         }
 117 }
 118
 119 sub lei_lcat {
 120         my ($lei, @argv) = @_;
 121         my $lxs = $lei->lxs_prepare or return;
 122         $lei->ale->refresh_externals($lxs);
 123         my $sto = $lei->_lei_store(1);
 124         $lei->{lse} = $sto->search;
 125         my $opt = $lei->{opt};
 126         my %mset_opt = map { $_ => $opt->{$_} } qw(threads limit offset);
 127         $mset_opt{asc} = $opt->{'reverse'} ? 1 : 0;
 128         $mset_opt{limit} //= 10000;
 129         $opt->{sort} //= 'relevance';
 130         $mset_opt{relevance} = 1;
 131         $lei->{mset_opt} = \%mset_opt;
 132         $opt->{'format'} //= 'text' unless defined($opt->{output});
 133         if ($lei->{opt}->{stdin}) {
 134                 return $lei->fail(<<'') if @argv;
 135 no args allowed on command-line with --stdin
 136
 137                 require PublicInbox::InputPipe;
 138                 PublicInbox::InputPipe::consume($lei->{0}, \&_stdin, $lei);
 139                 return;
 140         }
 141         $lei->{mset_opt}->{qstr} = extract_all($lei, @argv) or return;
 142         $lei->_start_query;
 143 }
 144
 145 sub _complete_lcat {
 146         my ($lei, @argv) = @_;
 147         my $sto = $lei->_lei_store or return;
 148         my $lms = $sto->search->lms or return;
 149         my $match_cb = $lei->complete_url_prepare(\@argv);
 150         grep(m!\A[a-z]+://!, map { $match_cb->($_) } $lms->folders);
 151 }
 152
 153 1;