]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/Config.pm
mda: match List-Id insensitively
[public-inbox.git] / lib / PublicInbox / Config.pm
index 4fcb20d24437dee77aeb1bdf6e1ecc6f92c9466d..d57c361ad90cd8364629201021b485c7b715cb46 100644 (file)
@@ -1,4 +1,4 @@
-# Copyright (C) 2014-2019 all contributors <meta@public-inbox.org>
+# Copyright (C) 2014-2020 all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 #
 # Used throughout the project for reading configuration
@@ -9,8 +9,8 @@
 
 package PublicInbox::Config;
 use strict;
-use warnings;
-require PublicInbox::Inbox;
+use v5.10.1;
+use PublicInbox::Inbox;
 use PublicInbox::Spawn qw(popen_rd);
 
 sub _array ($) { ref($_[0]) eq 'ARRAY' ? $_[0] : [ $_[0] ] }
@@ -19,17 +19,23 @@ sub _array ($) { ref($_[0]) eq 'ARRAY' ? $_[0] : [ $_[0] ] }
 # if keys may be multi-value, the value is an array ref containing all values
 sub new {
        my ($class, $file) = @_;
-       $file = default_file() unless defined($file);
-       $file = ref $file ? $file : git_config_dump($file);
-       my $self = bless $file, $class;
-
+       $file //= default_file();
+       my $self;
+       if (ref($file) eq 'SCALAR') { # used by some tests
+               open my $fh, '<', $file or die;  # PerlIO::scalar
+               $self = config_fh_parse($fh, "\n", '=');
+       } else {
+               $self = git_config_dump($file);
+       }
+       bless $self, $class;
        # caches
-       $self->{-by_addr} ||= {};
-       $self->{-by_name} ||= {};
-       $self->{-by_newsgroup} ||= {};
-       $self->{-no_obfuscate} ||= {};
-       $self->{-limiters} ||= {};
-       $self->{-code_repos} ||= {}; # nick => PublicInbox::Git object
+       $self->{-by_addr} = {};
+       $self->{-by_list_id} = {};
+       $self->{-by_name} = {};
+       $self->{-by_newsgroup} = {};
+       $self->{-no_obfuscate} = {};
+       $self->{-limiters} = {};
+       $self->{-code_repos} = {}; # nick => PublicInbox::Git object
        $self->{-cgitrc_unparsed} = $self->{'publicinbox.cgitrc'};
 
        if (my $no = delete $self->{'publicinbox.noobfuscate'}) {
@@ -57,80 +63,50 @@ sub new {
        $self;
 }
 
+sub noop {}
+sub fill_all ($) { each_inbox($_[0], \&noop) }
+
+sub _lookup_fill ($$$) {
+       my ($self, $cache, $key) = @_;
+       $self->{$cache}->{$key} // do {
+               fill_all($self);
+               $self->{$cache}->{$key};
+       }
+}
+
 sub lookup {
        my ($self, $recipient) = @_;
-       my $addr = lc($recipient);
-       my $ibx = $self->{-by_addr}->{$addr};
-       return $ibx if $ibx;
-
-       my $pfx;
-
-       foreach my $k (keys %$self) {
-               $k =~ m!\A(publicinbox\.[^/]+)\.address\z! or next;
-               my $v = $self->{$k};
-               if (ref($v) eq "ARRAY") {
-                       foreach my $alias (@$v) {
-                               (lc($alias) eq $addr) or next;
-                               $pfx = $1;
-                               last;
-                       }
-               } else {
-                       (lc($v) eq $addr) or next;
-                       $pfx = $1;
-                       last;
-               }
-       }
-       defined $pfx or return;
-       _fill($self, $pfx);
+       _lookup_fill($self, '-by_addr', lc($recipient));
+}
+
+sub lookup_list_id {
+       my ($self, $list_id) = @_;
+       _lookup_fill($self, '-by_list_id', lc($list_id));
 }
 
 sub lookup_name ($$) {
        my ($self, $name) = @_;
-       $self->{-by_name}->{$name} || _fill($self, "publicinbox.$name");
+       $self->{-by_name}->{$name} // _fill($self, "publicinbox.$name");
 }
 
 sub each_inbox {
-       my ($self, $cb) = @_;
-       if (my $section_order = $self->{-section_order}) {
-               foreach my $section (@$section_order) {
-                       next if $section !~ m!\Apublicinbox\.([^/]+)\z!;
-                       $self->{"publicinbox.$1.mainrepo"} or next;
-                       my $ibx = lookup_name($self, $1) or next;
-                       $cb->($ibx);
-               }
-       } else {
-               my %seen;
-               foreach my $k (keys %$self) {
-                       $k =~ m!\Apublicinbox\.([^/]+)\.mainrepo\z! or next;
-                       next if $seen{$1};
-                       $seen{$1} = 1;
-                       my $ibx = lookup_name($self, $1) or next;
-                       $cb->($ibx);
-               }
+       my ($self, $cb, @arg) = @_;
+       # may auto-vivify if config file is non-existent:
+       foreach my $section (@{$self->{-section_order}}) {
+               next if $section !~ m!\Apublicinbox\.([^/]+)\z!;
+               my $ibx = lookup_name($self, $1) or next;
+               $cb->($ibx, @arg);
        }
 }
 
 sub lookup_newsgroup {
        my ($self, $ng) = @_;
-       $ng = lc($ng);
-       my $ibx = $self->{-by_newsgroup}->{$ng};
-       return $ibx if $ibx;
-
-       foreach my $k (keys %$self) {
-               $k =~ m!\A(publicinbox\.[^/]+)\.newsgroup\z! or next;
-               my $v = $self->{$k};
-               my $pfx = $1;
-               if ($v eq $ng) {
-                       $ibx = _fill($self, $pfx);
-                       return $ibx;
-               }
-       }
-       undef;
+       _lookup_fill($self, '-by_newsgroup', lc($ng));
 }
 
 sub limiter {
        my ($self, $name) = @_;
-       $self->{-limiters}->{$name} ||= do {
+       $self->{-limiters}->{$name} //= do {
                require PublicInbox::Qspawn;
                my $max = $self->{"publicinboxlimiter.$name.max"} || 1;
                my $limiter = PublicInbox::Qspawn::Limiter->new($max);
@@ -139,27 +115,20 @@ sub limiter {
        };
 }
 
-sub config_dir { $ENV{PI_DIR} || "$ENV{HOME}/.public-inbox" }
+sub config_dir { $ENV{PI_DIR} // "$ENV{HOME}/.public-inbox" }
 
 sub default_file {
-       my $f = $ENV{PI_CONFIG};
-       return $f if defined $f;
-       config_dir() . '/config';
+       $ENV{PI_CONFIG} // (config_dir() . '/config');
 }
 
-sub git_config_dump {
-       my ($file) = @_;
-       my (%section_seen, @section_order);
-       return {} unless -e $file;
-       my @cmd = (qw/git config -z -l/, "--file=$file");
-       my $cmd = join(' ', @cmd);
-       my $fh = popen_rd(\@cmd) or die "popen_rd failed for $file: $!\n";
+sub config_fh_parse ($$$) {
+       my ($fh, $rs, $fs) = @_;
        my %rv;
-       local $/ = "\0";
+       my (%section_seen, @section_order);
+       local $/ = $rs;
        while (defined(my $line = <$fh>)) {
                chomp $line;
-               my ($k, $v) = split(/\n/, $line, 2);
-
+               my ($k, $v) = split($fs, $line, 2);
                my ($section) = ($k =~ /\A(\S+)\.[^\.]+\z/);
                unless (defined $section_seen{$section}) {
                        $section_seen{$section} = 1;
@@ -177,12 +146,22 @@ sub git_config_dump {
                        $rv{$k} = $v;
                }
        }
-       close $fh or die "failed to close ($cmd) pipe: $?";
        $rv{-section_order} = \@section_order;
 
        \%rv;
 }
 
+sub git_config_dump {
+       my ($file) = @_;
+       return {} unless -e $file;
+       my @cmd = (qw/git config -z -l --includes/, "--file=$file");
+       my $cmd = join(' ', @cmd);
+       my $fh = popen_rd(\@cmd);
+       my $rv = config_fh_parse($fh, "\0", "\n");
+       close $fh or die "failed to close ($cmd) pipe: $?";
+       $rv;
+}
+
 sub valid_inbox_name ($) {
        my ($name) = @_;
 
@@ -209,6 +188,9 @@ sub cgit_repo_merge ($$$) {
                return unless -e "$path/$se";
        }
        return if -e "$path/noweb";
+       # this comes from the cgit config, and AFAIK cgit only allows
+       # repos to have one URL, but that's just the PATH_INFO component,
+       # not the Host: portion
        # $repo = { url => 'foo.git', dir => '/path/to/foo.git' }
        my $rel = $repo->{url};
        unless (defined $rel) {
@@ -225,8 +207,8 @@ sub cgit_repo_merge ($$$) {
                $self->{-cgit_remove_suffix} and
                        $rel =~ s!/?\.git\z!!;
        }
-       $self->{"coderepo.$rel.dir"} ||= $path;
-       $self->{"coderepo.$rel.cgiturl"} ||= $rel;
+       $self->{"coderepo.$rel.dir"} //= $path;
+       $self->{"coderepo.$rel.cgiturl"} //= _array($rel);
 }
 
 sub is_git_dir ($) {
@@ -268,7 +250,7 @@ sub scan_projects_coderepo ($$$) {
                warn "failed to open cgit projectlist=$list: $!\n";
                return;
        };
-       foreach (<$fh>) {
+       while (<$fh>) {
                chomp;
                scan_path_coderepo($self, $path, "$path/$_");
        }
@@ -293,7 +275,7 @@ sub parse_cgitrc {
 
        # FIXME: this doesn't support macro expansion via $VARS, yet
        my $repo;
-       foreach (<$fh>) {
+       while (<$fh>) {
                chomp;
                if (m!\Arepo\.url=(.+?)/*\z!) {
                        my $nick = $1;
@@ -351,13 +333,14 @@ sub _fill_code_repo {
                                _array($self->{lc("$pfx.${t}UrlFormat")});
        }
 
-       if (my $cgits = $self->{lc("$pfx.cgitUrl")}) {
+       if (defined(my $cgits = $self->{"$pfx.cgiturl"})) {
                $git->{cgit_url} = $cgits = _array($cgits);
+               $self->{"$pfx.cgiturl"} = $cgits;
 
                # cgit supports "/blob/?id=%s", but it's only a plain-text
                # display and requires an unabbreviated id=
                foreach my $t (qw(blob commit tag)) {
-                       $git->{$t.'_url_format'} ||= map {
+                       $git->{$t.'_url_format'} //= map {
                                "$_/$t/?id=%s"
                        } @$cgits;
                }
@@ -366,8 +349,8 @@ sub _fill_code_repo {
        $git;
 }
 
-sub _git_config_bool ($) {
-       my ($val) = @_;
+sub git_bool {
+       my ($val) = $_[-1]; # $_[0] may be $self, or $val
        if ($val =~ /\A(?:false|no|off|[\-\+]?(?:0x)?0+)\z/i) {
                0;
        } elsif ($val =~ /\A(?:true|yes|on|[\-\+]?(?:0x)?[0-9]+)\z/i) {
@@ -381,16 +364,34 @@ sub _fill {
        my ($self, $pfx) = @_;
        my $ibx = {};
 
-       foreach my $k (qw(mainrepo filter url newsgroup
-                       infourl watch watchheader httpbackendmax
-                       replyto feedmax nntpserver indexlevel)) {
+       for my $k (qw(watch nntpserver)) {
                my $v = $self->{"$pfx.$k"};
                $ibx->{$k} = $v if defined $v;
        }
+       for my $k (qw(filter inboxdir newsgroup replyto httpbackendmax feedmax
+                       indexlevel indexsequentialshard)) {
+               if (defined(my $v = $self->{"$pfx.$k"})) {
+                       if (ref($v) eq 'ARRAY') {
+                               warn <<EOF;
+W: $pfx.$k has multiple values, only using `$v->[-1]'
+EOF
+                               $ibx->{$k} = $v->[-1];
+                       } else {
+                               $ibx->{$k} = $v;
+                       }
+               }
+       }
+
+       # backwards compatibility:
+       $ibx->{inboxdir} //= $self->{"$pfx.mainrepo"};
+       if (($ibx->{inboxdir} // '') =~ /\n/s) {
+               warn "E: `$ibx->{inboxdir}' must not contain `\\n'\n";
+               return;
+       }
        foreach my $k (qw(obfuscate)) {
                my $v = $self->{"$pfx.$k"};
                defined $v or next;
-               if (defined(my $bval = _git_config_bool($v))) {
+               if (defined(my $bval = git_bool($v))) {
                        $ibx->{$k} = $bval;
                } else {
                        warn "Ignoring $pfx.$k=$v in config, not boolean\n";
@@ -398,13 +399,14 @@ sub _fill {
        }
        # TODO: more arrays, we should support multi-value for
        # more things to encourage decentralization
-       foreach my $k (qw(address altid nntpmirror coderepo hide)) {
+       foreach my $k (qw(address altid nntpmirror coderepo hide listid url
+                       infourl watchheader)) {
                if (defined(my $v = $self->{"$pfx.$k"})) {
                        $ibx->{$k} = _array($v);
                }
        }
 
-       return unless $ibx->{mainrepo};
+       return unless defined($ibx->{inboxdir});
        my $name = $pfx;
        $name =~ s/\Apublicinbox\.//;
 
@@ -421,6 +423,12 @@ sub _fill {
                $self->{-by_addr}->{$lc_addr} = $ibx;
                $self->{-no_obfuscate}->{$lc_addr} = 1;
        }
+       if (my $listids = $ibx->{listid}) {
+               # RFC2919 section 6 stipulates "case insensitive equality"
+               foreach my $list_id (@$listids) {
+                       $self->{-by_list_id}->{lc($list_id)} = $ibx;
+               }
+       }
        if (my $ng = $ibx->{newsgroup}) {
                $self->{-by_newsgroup}->{$ng} = $ibx;
        }
@@ -428,7 +436,7 @@ sub _fill {
        if ($ibx->{obfuscate}) {
                $ibx->{-no_obfuscate} = $self->{-no_obfuscate};
                $ibx->{-no_obfuscate_re} = $self->{-no_obfuscate_re};
-               each_inbox($self, sub {}); # noop to populate -no_obfuscate
+               fill_all($self); # noop to populate -no_obfuscate
        }
 
        if (my $ibx_code_repos = $ibx->{coderepo}) {
@@ -440,7 +448,7 @@ sub _fill {
                        $valid += valid_inbox_name($_) foreach (@parts);
                        $valid == scalar(@parts) or next;
 
-                       my $repo = $code_repos->{$nick} ||=
+                       my $repo = $code_repos->{$nick} //=
                                                _fill_code_repo($self, $nick);
                        push @$repo_objs, $repo if $repo;
                }
@@ -449,4 +457,23 @@ sub _fill {
        $ibx
 }
 
+sub urlmatch {
+       my ($self, $key, $url) = @_;
+       state $urlmatch_broken; # requires git 1.8.5
+       return if $urlmatch_broken;
+       my $file = default_file();
+       my $cmd = [qw/git config -z --includes --get-urlmatch/,
+               "--file=$file", $key, $url ];
+       my $fh = popen_rd($cmd);
+       local $/ = "\0";
+       my $val = <$fh>;
+       if (close($fh)) {
+               chomp($val);
+               $val;
+       } else {
+               $urlmatch_broken = 1 if (($? >> 8) != 1);
+               undef;
+       }
+}
+
 1;