X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FInbox.pm;h=cb98d2ad5e29cbc017ddf65df293e9bbe1546d9f;hb=HEAD;hp=10f716ca6d033b0aecaa7df8a37563997db7c368;hpb=20ddcb02821ff3bf8afd2c2279e0889492c93fd9;p=public-inbox.git diff --git a/lib/PublicInbox/Inbox.pm b/lib/PublicInbox/Inbox.pm index 10f716ca..cb98d2ad 100644 --- a/lib/PublicInbox/Inbox.pm +++ b/lib/PublicInbox/Inbox.pm @@ -1,88 +1,54 @@ -# Copyright (C) 2016-2018 all contributors +# Copyright (C) all contributors # License: AGPL-3.0+ # # Represents a public-inbox (which may have multiple mailing addresses) package PublicInbox::Inbox; use strict; -use warnings; +use v5.10.1; use PublicInbox::Git; use PublicInbox::MID qw(mid2path); -use PublicInbox::MIME; - -# Long-running "git-cat-file --batch" processes won't notice -# unlinked packs, so we need to restart those processes occasionally. -# Xapian and SQLite file handles are mostly stable, but sometimes an -# admin will attempt to replace them atomically after compact/vacuum -# and we need to be prepared for that. -my $cleanup_timer; -my $cleanup_avail = -1; # 0, or 1 -my $have_devel_peek; -my $CLEANUP = {}; # string(inbox) -> inbox -sub cleanup_task () { - $cleanup_timer = undef; - my $next = {}; - for my $ibx (values %$CLEANUP) { - my $again; - if ($have_devel_peek) { - foreach my $f (qw(mm search over)) { - # we bump refcnt by assigning tmp, here: - my $tmp = $ibx->{$f} or next; - next if Devel::Peek::SvREFCNT($tmp) > 2; - delete $ibx->{$f}; - # refcnt is zero when tmp is out-of-scope - } - } - if (my $git = $ibx->{git}) { - $again = $git->cleanup; - } - if (my $gits = $ibx->{-repo_objs}) { - foreach my $git (@$gits) { - $again = 1 if $git->cleanup; - } - } - if ($have_devel_peek) { - $again ||= !!($ibx->{over} || $ibx->{mm} || - $ibx->{search}); - } - $next->{"$ibx"} = $ibx if $again; - } - $CLEANUP = $next; -} - -sub cleanup_possible () { - # no need to require EvCleanup, here, if it were enabled another - # module would've require'd it, already - eval { PublicInbox::EvCleanup::enabled() } or return 0; +use PublicInbox::Eml; +use List::Util qw(max); +use Carp qw(croak); - eval { - require Devel::Peek; # needs separate package in Fedora - $have_devel_peek = 1; - }; - 1; +# returns true if further checking is required +sub check_inodes ($) { + for (qw(over mm)) { $_[0]->{$_}->check_inodes if $_[0]->{$_} } } -sub _cleanup_later ($) { - my ($self) = @_; - $cleanup_avail = cleanup_possible() if $cleanup_avail < 0; - return if $cleanup_avail != 1; - $cleanup_timer ||= PublicInbox::EvCleanup::later(*cleanup_task); - $CLEANUP->{"$self"} = $self; +sub do_cleanup { + my ($ibx) = @_; + my $live; + if (defined $ibx->{git}) { + $live = $ibx->isa(__PACKAGE__) ? $ibx->{git}->cleanup(1) + : $ibx->{git}->cleanup_if_unlinked; + delete($ibx->{git}) unless $live; + } + if ($live) { + check_inodes($ibx); + } else { + delete(@$ibx{qw(over mm description cloneurl + -imap_url -nntp_url -pop3_url)}); + } + my $srch = $ibx->{search} // $ibx; + delete @$srch{qw(xdb qp)}; + for my $git (@{$ibx->{-repo_objs} // []}) { + $live = 1 if $git->cleanup(1); + } + PublicInbox::DS::add_uniq_timer($ibx+0, 5, \&do_cleanup, $ibx) if $live; } -sub _set_uint ($$$) { - my ($opts, $field, $default) = @_; - my $val = $opts->{$field}; - if (defined $val) { - $val = $val->[-1] if ref($val) eq 'ARRAY'; - $val = undef if $val !~ /\A[0-9]+\z/; - } - $opts->{$field} = $val || $default; +sub _cleanup_later ($) { + # no need to require DS, here, if it were enabled another + # module would've require'd it, already + eval { PublicInbox::DS::in_loop() } and + PublicInbox::DS::add_uniq_timer($_[0]+0, 30, \&do_cleanup, @_) } sub _set_limiter ($$$) { - my ($self, $pi_config, $pfx) = @_; + my ($self, $pi_cfg, $pfx) = @_; my $lkey = "-${pfx}_limiter"; - $self->{$lkey} ||= eval { + $self->{$lkey} //= do { # full key is: publicinbox.$NAME.httpbackendmax my $mkey = $pfx.'max'; my $val = $self->{$mkey} or return; @@ -91,7 +57,7 @@ sub _set_limiter ($$$) { require PublicInbox::Qspawn; $lim = PublicInbox::Qspawn::Limiter->new($val); } elsif ($val =~ /\A[a-z][a-z0-9]*\z/) { - $lim = $pi_config->limiter($val); + $lim = $pi_cfg->limiter($val); warn "$mkey limiter=$val not found\n" if !$lim; } else { warn "$mkey limiter=$val not understood\n"; @@ -102,18 +68,17 @@ sub _set_limiter ($$$) { sub new { my ($class, $opts) = @_; - my $v = $opts->{address} ||= 'public-inbox@example.com'; + my $v = $opts->{address} ||= [ 'public-inbox@example.com' ]; my $p = $opts->{-primary_address} = ref($v) eq 'ARRAY' ? $v->[0] : $v; $opts->{domain} = ($p =~ /\@(\S+)\z/) ? $1 : 'localhost'; - my $pi_config = delete $opts->{-pi_config}; - _set_limiter($opts, $pi_config, 'httpbackend'); - _set_uint($opts, 'feedmax', 25); - $opts->{nntpserver} ||= $pi_config->{'publicinbox.nntpserver'}; - my $dir = $opts->{mainrepo}; - if (defined $dir && -f "$dir/inbox.lock") { - $opts->{version} = 2; + my $pi_cfg = delete $opts->{-pi_cfg}; + _set_limiter($opts, $pi_cfg, 'httpbackend'); + my $fmax = $opts->{feedmax}; + if (defined($fmax) && $fmax =~ /\A[0-9]+\z/) { + $opts->{feedmax} += 0; + } else { + delete $opts->{feedmax}; } - # allow any combination of multi-line or comma-delimited hide entries my $hide = {}; if (defined(my $h = $opts->{hide})) { @@ -125,258 +90,256 @@ sub new { bless $opts, $class; } -sub git_part { - my ($self, $part) = @_; - ($self->{version} || 1) == 2 or return; - $self->{"$part.git"} ||= eval { - my $git_dir = "$self->{mainrepo}/git/$part.git"; +sub version { + $_[0]->{version} //= -f "$_[0]->{inboxdir}/inbox.lock" ? 2 : 1 +} + +sub git_epoch { + my ($self, $epoch) = @_; # v2-only, callers always supply $epoch + $self->{"$epoch.git"} //= do { + my $git_dir = "$self->{inboxdir}/git/$epoch.git"; + return unless -d $git_dir; my $g = PublicInbox::Git->new($git_dir); - $g->{-httpbackend_limiter} = $self->{-httpbackend_limiter}; - # no cleanup needed, we never cat-file off this, only clone + my $lim = $self->{-httpbackend_limiter}; + $g->{-httpbackend_limiter} = $lim if $lim; + # caller must manually cleanup when done $g; }; } sub git { my ($self) = @_; - $self->{git} ||= eval { - my $git_dir = $self->{mainrepo}; - $git_dir .= '/all.git' if (($self->{version} || 1) == 2); + $self->{git} //= do { + my $git_dir = $self->{inboxdir}; + $git_dir .= '/all.git' if $self->version == 2; my $g = PublicInbox::Git->new($git_dir); - $g->{-httpbackend_limiter} = $self->{-httpbackend_limiter}; + my $lim = $self->{-httpbackend_limiter}; + $g->{-httpbackend_limiter} = $lim if $lim; _cleanup_later($self); $g; }; } -sub max_git_part { +sub max_git_epoch { my ($self) = @_; - my $v = $self->{version}; - return unless defined($v) && $v == 2; - my $part = $self->{-max_git_part}; - my $changed = git($self)->alternates_changed; - if (!defined($part) || $changed) { - $self->git->cleanup if $changed; - my $gits = "$self->{mainrepo}/git"; + return if $self->version < 2; + my $cur = $self->{-max_git_epoch}; + my $changed; + if (!defined($cur) || ($changed = git($self)->alternates_changed)) { + $self->{git}->cleanup if $changed; + my $gits = "$self->{inboxdir}/git"; if (opendir my $dh, $gits) { - my $max = -1; - while (defined(my $git_dir = readdir($dh))) { - $git_dir =~ m!\A([0-9]+)\.git\z! or next; - $max = $1 if $1 > $max; - } - $part = $self->{-max_git_part} = $max if $max >= 0; - } else { - warn "opendir $gits failed: $!\n"; + my $max = max(map { + substr($_, 0, -4) + 0; # drop ".git" suffix + } grep(/\A[0-9]+\.git\z/, readdir($dh))) // return; + $cur = $self->{-max_git_epoch} = $max; } } - $part; + $cur; } -sub mm { +sub mm_file { my ($self) = @_; - $self->{mm} ||= eval { + my $d = $self->{inboxdir}; + ($self->version >= 2 ? $d : "$d/public-inbox").'/msgmap.sqlite3'; +} + +sub mm { + my ($self, $req) = @_; + $self->{mm} //= eval { require PublicInbox::Msgmap; _cleanup_later($self); - my $dir = $self->{mainrepo}; - if (($self->{version} || 1) >= 2) { - PublicInbox::Msgmap->new_file("$dir/msgmap.sqlite3"); - } else { - PublicInbox::Msgmap->new($dir); - } - }; + PublicInbox::Msgmap->new_file($self); + } // ($req ? croak("E: $@") : undef); } -sub search ($;$) { - my ($self, $over_only) = @_; - my $srch = $self->{search} ||= eval { +sub search { + my ($self) = @_; + $self->{search} // eval { _cleanup_later($self); require PublicInbox::Search; - PublicInbox::Search->new($self); + my $srch = PublicInbox::Search->new($self); + (eval { $srch->xdb }) ? ($self->{search} = $srch) : undef; }; - ($over_only || eval { $srch->xdb }) ? $srch : undef; } -sub over ($) { - my ($self) = @_; - my $srch = search($self, 1) or return; - $self->{over} ||= eval { - my $over = $srch->{over_ro}; - $over->dbh_new; # may fail - $over; - } -} +# isrch is preferred for read-only interfaces if available since it +# reduces kernel cache and FD overhead +sub isrch { $_[0]->{isrch} // search($_[0]) } -sub try_cat { - my ($path) = @_; - my $rv = ''; - if (open(my $fh, '<', $path)) { - local $/; - $rv = <$fh>; - } - $rv; +sub over { + my ($self, $req) = @_; + $self->{over} // eval { + my $srch = $self->{search} // do { + require PublicInbox::Search; + PublicInbox::Search->new($self); + }; + _cleanup_later($self); + my $over = PublicInbox::Over->new("$srch->{xpfx}/over.sqlite3"); + $over->dbh; # may fail + $self->{over} = $over; + } // ($req ? croak("E: $@") : undef); } sub description { my ($self) = @_; - my $desc = $self->{description}; - return $desc if defined $desc; - $desc = try_cat("$self->{mainrepo}/description"); - local $/ = "\n"; - chomp $desc; - $desc =~ s/\s+/ /smg; - $desc = '($INBOX_DIR/description missing)' if $desc eq ''; - $self->{description} = $desc; + ($self->{description} //= + PublicInbox::Git::cat_desc("$self->{inboxdir}/description")) // + '($INBOX_DIR/description missing)'; } sub cloneurl { my ($self) = @_; - my $url = $self->{cloneurl}; - return $url if $url; - $url = try_cat("$self->{mainrepo}/cloneurl"); - my @url = split(/\s+/s, $url); - local $/ = "\n"; - chomp @url; - $self->{cloneurl} = \@url; + $self->{cloneurl} // do { + my @urls = split(/\s+/s, + PublicInbox::Git::try_cat("$self->{inboxdir}/cloneurl")); + scalar(@urls) ? ($self->{cloneurl} = \@urls) : undef; + } // []; } sub base_url { - my ($self, $env) = @_; - my $scheme; - if ($env && ($scheme = $env->{'psgi.url_scheme'})) { # PSGI env - my $host_port = $env->{HTTP_HOST} || - "$env->{SERVER_NAME}:$env->{SERVER_PORT}"; - my $url = "$scheme://$host_port". ($env->{SCRIPT_NAME} || '/'); + my ($self, $env) = @_; # env - PSGI env + if ($env && $env->{'psgi.url_scheme'}) { + my $url = PublicInbox::Git::host_prefix_url($env, ''); # for mount in Plack::Builder $url .= '/' if $url !~ m!/\z!; - $url .= $self->{name} . '/'; - } else { - # either called from a non-PSGI environment (e.g. NNTP/POP3) - $self->{-base_url} ||= do { - my $url = $self->{url} or return undef; - # expand protocol-relative URLs to HTTPS if we're - # not inside a web server - $url = "https:$url" if $url =~ m!\A//!; - $url .= '/' if $url !~ m!/\z!; - $url; - }; + return $url .= $self->{name} . '/'; } + # called from a non-PSGI environment or cross-inbox environment + # where multiple inboxes can have different domains + my $url = $self->{url} // return undef; + $url = $url->[0] // return undef; + # expand protocol-relative URLs to HTTPS if we're + # not inside a web server + substr($url, 0, 0, 'https:') if substr($url, 0, 2) eq '//'; + $url .= '/' if substr($url, -1, 1) ne '/'; + $url; } -sub nntp_url { - my ($self) = @_; - $self->{-nntp_url} ||= do { - # no checking for nntp_usable here, we can point entirely - # to non-local servers or users run by a different user - my $ns = $self->{nntpserver}; - my $group = $self->{newsgroup}; - my @urls; - if ($ns && $group) { - $ns = [ $ns ] if ref($ns) ne 'ARRAY'; - @urls = map { - my $u = m!\Anntps?://! ? $_ : "nntp://$_"; - $u .= '/' if $u !~ m!/\z!; - $u.$group; - } @$ns; - } - - my $mirrors = $self->{nntpmirror}; - if ($mirrors) { - my @m; - foreach (@$mirrors) { - my $u = m!\Anntps?://! ? $_ : "nntp://$_"; - if ($u =~ m!\Anntps?://[^/]+/?\z!) { - if ($group) { - $u .= '/' if $u !~ m!/\z!; - $u .= $group; - } else { - warn -"publicinbox.$self->{name}.nntpmirror=$_ missing newsgroup name\n"; - } +# imapserver, nntpserver configs are used here: +sub _x_url ($$$) { + my ($self, $x, $ctx) = @_; # $x is "imap" or "nntp" + # no checking for nntp_usable here, we can point entirely + # to non-local servers or users run by a different user + my $ns = $self->{"${x}server"} // + $ctx->{www}->{pi_cfg}->get_all("publicinbox.${x}server"); + my $group = $self->{newsgroup}; + my @urls; + if ($ns && $group) { + @urls = map { + my $u = m!\A${x}s?://! ? $_ : "$x://$_"; + $u .= '/' if $u !~ m!/\z!; + $u.$group; + } @$ns; + } + if (my $mirrors = $self->{"${x}mirror"}) { + my @m; + for (@$mirrors) { + my $u = m!\A${x}s?://! ? $_ : "$x://$_"; + if ($u =~ m!\A${x}s?://[^/]+/?\z!) { + if ($group) { + $u .= '/' if $u !~ m!/\z!; + $u .= $group; + } else { # n.b. IMAP and POP3 use "newsgroup" + warn <{name}.${x}mirror=$_ missing newsgroup name +EOM } - # else: allow full URLs like: - # nntp://news.example.com/alt.example - push @m, $u; - } - my %seen = map { $_ => 1 } @urls; - foreach my $u (@m) { - next if $seen{$u}; - $seen{$u} = 1; - push @urls, $u; } + # else: allow full URLs like: + # nntp://news.example.com/alt.example + push @m, $u; + } + + # List::Util::uniq requires Perl 5.26+, maybe we + # can use it by 2030 or so + my %seen; + @urls = grep { !$seen{$_}++ } (@urls, @m); + } + \@urls; +} + +# my ($self, $ctx) = @_; +sub imap_url { $_[0]->{-imap_url} //= _x_url($_[0], 'imap', $_[1]) } +sub nntp_url { $_[0]->{-nntp_url} //= _x_url($_[0], 'nntp', $_[1]) } + +sub pop3_url { + my ($self, $ctx) = @_; + $self->{-pop3_url} //= do { + my $ps = $self->{'pop3server'} // + $ctx->{www}->{pi_cfg}->get_all('publicinbox.pop3server'); + my $group = $self->{newsgroup}; + my @urls; + ($ps && $group) and + @urls = map { m!\Apop3?s?://! ? $_ : "pop3://$_" } @$ps; + if (my $mi = $self->{'pop3mirror'}) { + my @m = map { m!\Apop3?s?://! ? $_ : "pop3://$_" } @$mi; + my %seen; # List::Util::uniq requires Perl 5.26+ + @urls = grep { !$seen{$_}++ } (@urls, @m); } + my $n = 0; + for (@urls) { $n += s!/+\z!! } + warn <{mm} = $self->{over} = $self->{search} = undef; + delete @$self{qw(mm over search)}; $ret; } -sub msg_by_path ($$;$) { - my ($self, $path, $ref) = @_; - # TODO: allow other refs: - my $str = git($self)->cat_file('HEAD:'.$path, $ref); - $$str =~ s/\A[\r\n]*From [^\r\n]*\r?\n//s if $str; - $str; +# for v1 users w/o SQLite only +sub msg_by_path ($$) { + my ($self, $path) = @_; + git($self)->cat_file('HEAD:'.$path); } -sub msg_by_smsg ($$;$) { - my ($self, $smsg, $ref) = @_; +sub msg_by_smsg ($$) { + my ($self, $smsg) = @_; # ghosts may have undef smsg (from SearchThread.node) or # no {blob} field - return unless defined $smsg; - defined(my $blob = $smsg->{blob}) or return; - - my $str = git($self)->cat_file($blob, $ref); - $$str =~ s/\A[\r\n]*From [^\r\n]*\r?\n//s if $str; - $str; + $smsg // return; + $self->git->cat_file($smsg->{blob} // return); } -sub smsg_mime { - my ($self, $smsg, $ref) = @_; - if (my $s = msg_by_smsg($self, $smsg, $ref)) { - $smsg->{mime} = PublicInbox::MIME->new($s); - return $smsg; - } -} - -sub mid2num($$) { - my ($self, $mid) = @_; - my $mm = mm($self) or return; - $mm->num_for($mid); +sub smsg_eml { + my ($self, $smsg) = @_; + my $bref = msg_by_smsg($self, $smsg) or return; + my $eml = PublicInbox::Eml->new($bref); + $smsg->{num} // $smsg->populate($eml); + $eml; } sub smsg_by_mid ($$) { my ($self, $mid) = @_; - my $over = over($self) or return; - # favor the Message-ID we used for the NNTP article number: - defined(my $num = mid2num($self, $mid)) or return; - my $smsg = $over->get_art($num) or return; - PublicInbox::SearchMsg::psgi_cull($smsg); + my $over = $self->over or return; + my $smsg; + if (my $mm = $self->mm) { + # favor the Message-ID we used for the NNTP article number: + my $num = $mm->num_for($mid) // return; + $smsg = $over->get_art($num); + } else { + my ($id, $prev); + $smsg = $over->next_by_mid($mid, \$id, \$prev); + } + $smsg ? PublicInbox::Smsg::psgi_cull($smsg) : undef; } -sub msg_by_mid ($$;$) { - my ($self, $mid, $ref) = @_; - - over($self) or - return msg_by_path($self, mid2path($mid), $ref); - +sub msg_by_mid ($$) { + my ($self, $mid) = @_; my $smsg = smsg_by_mid($self, $mid); - $smsg ? msg_by_smsg($self, $smsg, $ref) : undef; -} - -sub recent { - my ($self, $opts, $after, $before) = @_; - over($self)->recent($opts, $after, $before); + $smsg ? msg_by_smsg($self, $smsg) : msg_by_path($self, mid2path($mid)); } sub modified { my ($self) = @_; - if (my $over = over($self)) { + if (my $over = $self->over) { my $msgs = $over->recent({limit => 1}); if (my $smsg = $msgs->[0]) { return $smsg->{ts}; @@ -386,4 +349,69 @@ sub modified { git($self)->modified; # v1 } +# returns prefix => pathname mapping +# (pathname is NOT public, but prefix is used for Xapian queries) +sub altid_map ($) { + my ($self) = @_; + eval { + require PublicInbox::AltId; + my $altid = $self->{altid} or return {}; + my %h = map {; + my $x = PublicInbox::AltId->new($self, $_); + "$x->{prefix}" => $x->{filename} + } @$altid; + \%h; + } // {}; +} + +# $obj must respond to ->on_inbox_unlock, which takes Inbox ($self) as an arg +sub subscribe_unlock { + my ($self, $ident, $obj) = @_; + $self->{unlock_subs}->{$ident} = $obj; +} + +sub unsubscribe_unlock { + my ($self, $ident) = @_; + delete $self->{unlock_subs}->{$ident}; +} + +# called by inotify +sub on_unlock { + my ($self) = @_; + check_inodes($self); + my $subs = $self->{unlock_subs} or return; + for my $obj (values %$subs) { + eval { $obj->on_inbox_unlock($self) }; + warn "E: $@ ($self->{inboxdir})\n" if $@; + } +} + +sub uidvalidity { $_[0]->{uidvalidity} //= eval { $_[0]->mm->created_at } } + +sub eidx_key { $_[0]->{newsgroup} // $_[0]->{inboxdir} } + +# only used by NNTP, so we need ->mm anyways +sub art_min { $_[0]->{-art_min} //= eval { $_[0]->mm(1)->min } } + +# used by IMAP, too, which tries to avoid ->mm (but ->{mm} is likely +# faster since it's smaller iff available) +sub art_max { + $_[0]->{-art_max} //= eval { $_[0]->{mm}->max } // + eval { $_[0]->over(1)->max }; +} + +sub mailboxid { # rfc 8474, 8620, 8621 + my ($self, $imap_slice) = @_; + my $pfx = defined($imap_slice) ? $self->{newsgroup} : $self->{name}; + utf8::encode($pfx); # to octets + # RFC 8620, 1.2 recommends not starting with dash or digits + # "A good solution to these issues is to prefix every id with a single + # alphabetical character." + 'M'.join('', map { sprintf('%02x', ord) } split(//, $pfx)) . + (defined($imap_slice) ? sprintf('-%x', $imap_slice) : '') . + sprintf('-%x', uidvalidity($self) // 0) +} + +sub thing_type { 'public inbox' } + 1;