lib/PublicInbox/Config.pm

   1 # Copyright (C) 2014-2020 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3 #
   4 # Used throughout the project for reading configuration
   5 #
   6 # Note: I hate camelCase; but git-config(1) uses it, but it's better
   7 # than alllowercasewithoutunderscores, so use lc('configKey') where
   8 # applicable for readability
   9
  10 package PublicInbox::Config;
  11 use strict;
  12 use v5.10.1;
  13 use PublicInbox::Inbox;
  14 use PublicInbox::Spawn qw(popen_rd);
  15
  16 sub _array ($) { ref($_[0]) eq 'ARRAY' ? $_[0] : [ $_[0] ] }
  17
  18 # returns key-value pairs of config directives in a hash
  19 # if keys may be multi-value, the value is an array ref containing all values
  20 sub new {
  21         my ($class, $file) = @_;
  22         $file = default_file() unless defined($file);
  23         my $self;
  24         if (ref($file) eq 'SCALAR') { # used by some tests
  25                 open my $fh, '<', $file or die;  # PerlIO::scalar
  26                 $self = config_fh_parse($fh, "\n", '=');
  27         } else {
  28                 $self = git_config_dump($file);
  29         }
  30         bless $self, $class;
  31         # caches
  32         $self->{-by_addr} = {};
  33         $self->{-by_list_id} = {};
  34         $self->{-by_name} = {};
  35         $self->{-by_newsgroup} = {};
  36         $self->{-no_obfuscate} = {};
  37         $self->{-limiters} = {};
  38         $self->{-code_repos} = {}; # nick => PublicInbox::Git object
  39         $self->{-cgitrc_unparsed} = $self->{'publicinbox.cgitrc'};
  40
  41         if (my $no = delete $self->{'publicinbox.noobfuscate'}) {
  42                 $no = _array($no);
  43                 my @domains;
  44                 foreach my $n (@$no) {
  45                         my @n = split(/\s+/, $n);
  46                         foreach (@n) {
  47                                 if (/\S+@\S+/) { # full address
  48                                         $self->{-no_obfuscate}->{lc $_} = 1;
  49                                 } else {
  50                                         # allow "example.com" or "@example.com"
  51                                         s/\A@//;
  52                                         push @domains, quotemeta($_);
  53                                 }
  54                         }
  55                 }
  56                 my $nod = join('|', @domains);
  57                 $self->{-no_obfuscate_re} = qr/(?:$nod)\z/i;
  58         }
  59         if (my $css = delete $self->{'publicinbox.css'}) {
  60                 $self->{css} = _array($css);
  61         }
  62
  63         $self;
  64 }
  65
  66 sub noop {}
  67 sub fill_all ($) { each_inbox($_[0], \&noop) }
  68
  69 sub _lookup_fill ($$$) {
  70         my ($self, $cache, $key) = @_;
  71         $self->{$cache}->{$key} // do {
  72                 fill_all($self);
  73                 $self->{$cache}->{$key};
  74         }
  75 }
  76
  77 sub lookup {
  78         my ($self, $recipient) = @_;
  79         _lookup_fill($self, '-by_addr', lc($recipient));
  80 }
  81
  82 sub lookup_list_id {
  83         my ($self, $list_id) = @_;
  84         _lookup_fill($self, '-by_list_id', lc($list_id));
  85 }
  86
  87 sub lookup_name ($$) {
  88         my ($self, $name) = @_;
  89         $self->{-by_name}->{$name} // _fill($self, "publicinbox.$name");
  90 }
  91
  92 sub each_inbox {
  93         my ($self, $cb, $arg) = @_;
  94         # may auto-vivify if config file is non-existent:
  95         foreach my $section (@{$self->{-section_order}}) {
  96                 next if $section !~ m!\Apublicinbox\.([^/]+)\z!;
  97                 my $ibx = lookup_name($self, $1) or next;
  98                 $cb->($ibx, $arg);
  99         }
 100 }
 101
 102 sub iterate_start {
 103         my ($self, $cb, $arg) = @_;
 104         my $i = 0;
 105         $self->{-iter} = [ \$i, $cb, $arg ];
 106 }
 107
 108 # for PublicInbox::DS::next_tick, we only call this is if
 109 # PublicInbox::DS is already loaded
 110 sub event_step {
 111         my ($self) = @_;
 112         my ($i, $cb, $arg) = @{$self->{-iter}};
 113         my $section = $self->{-section_order}->[$$i++];
 114         delete($self->{-iter}) unless defined($section);
 115         eval { $cb->($self, $section, $arg) };
 116         warn "E: $@ in ${self}::event_step" if $@;
 117         PublicInbox::DS::requeue($self) if defined($section);
 118 }
 119
 120 sub lookup_newsgroup {
 121         my ($self, $ng) = @_;
 122         _lookup_fill($self, '-by_newsgroup', lc($ng));
 123 }
 124
 125 sub limiter {
 126         my ($self, $name) = @_;
 127         $self->{-limiters}->{$name} //= do {
 128                 require PublicInbox::Qspawn;
 129                 my $max = $self->{"publicinboxlimiter.$name.max"} || 1;
 130                 my $limiter = PublicInbox::Qspawn::Limiter->new($max);
 131                 $limiter->setup_rlimit($name, $self);
 132                 $limiter;
 133         };
 134 }
 135
 136 sub config_dir { $ENV{PI_DIR} // "$ENV{HOME}/.public-inbox" }
 137
 138 sub default_file {
 139         my $f = $ENV{PI_CONFIG};
 140         return $f if defined $f;
 141         config_dir() . '/config';
 142 }
 143
 144 sub config_fh_parse ($$$) {
 145         my ($fh, $rs, $fs) = @_;
 146         my %rv;
 147         my (%section_seen, @section_order);
 148         local $/ = $rs;
 149         while (defined(my $line = <$fh>)) {
 150                 chomp $line;
 151                 my ($k, $v) = split($fs, $line, 2);
 152                 my ($section) = ($k =~ /\A(\S+)\.[^\.]+\z/);
 153                 unless (defined $section_seen{$section}) {
 154                         $section_seen{$section} = 1;
 155                         push @section_order, $section;
 156                 }
 157
 158                 my $cur = $rv{$k};
 159                 if (defined $cur) {
 160                         if (ref($cur) eq "ARRAY") {
 161                                 push @$cur, $v;
 162                         } else {
 163                                 $rv{$k} = [ $cur, $v ];
 164                         }
 165                 } else {
 166                         $rv{$k} = $v;
 167                 }
 168         }
 169         $rv{-section_order} = \@section_order;
 170
 171         \%rv;
 172 }
 173
 174 sub git_config_dump {
 175         my ($file) = @_;
 176         return {} unless -e $file;
 177         my @cmd = (qw/git config -z -l --includes/, "--file=$file");
 178         my $cmd = join(' ', @cmd);
 179         my $fh = popen_rd(\@cmd);
 180         my $rv = config_fh_parse($fh, "\0", "\n");
 181         close $fh or die "failed to close ($cmd) pipe: $?";
 182         $rv;
 183 }
 184
 185 sub valid_inbox_name ($) {
 186         my ($name) = @_;
 187
 188         # Similar rules found in git.git/remote.c::valid_remote_nick
 189         # and git.git/refs.c::check_refname_component
 190         # We don't reject /\.lock\z/, however, since we don't lock refs
 191         if ($name eq '' || $name =~ /\@\{/ ||
 192             $name =~ /\.\./ || $name =~ m![/:\?\[\]\^~\s\f[:cntrl:]\*]! ||
 193             $name =~ /\A\./ || $name =~ /\.\z/) {
 194                 return 0;
 195         }
 196
 197         # Note: we allow URL-unfriendly characters; users may configure
 198         # non-HTTP-accessible inboxes
 199         1;
 200 }
 201
 202 # XXX needs testing for cgit compatibility
 203 # cf. cgit/scan-tree.c::add_repo
 204 sub cgit_repo_merge ($$$) {
 205         my ($self, $base, $repo) = @_;
 206         my $path = $repo->{dir};
 207         if (defined(my $se = $self->{-cgit_strict_export})) {
 208                 return unless -e "$path/$se";
 209         }
 210         return if -e "$path/noweb";
 211         # this comes from the cgit config, and AFAIK cgit only allows
 212         # repos to have one URL, but that's just the PATH_INFO component,
 213         # not the Host: portion
 214         # $repo = { url => 'foo.git', dir => '/path/to/foo.git' }
 215         my $rel = $repo->{url};
 216         unless (defined $rel) {
 217                 my $off = index($path, $base, 0);
 218                 if ($off != 0) {
 219                         $rel = $path;
 220                 } else {
 221                         $rel = substr($path, length($base) + 1);
 222                 }
 223
 224                 $rel =~ s!/\.git\z!! or
 225                         $rel =~ s!/+\z!!;
 226
 227                 $self->{-cgit_remove_suffix} and
 228                         $rel =~ s!/?\.git\z!!;
 229         }
 230         $self->{"coderepo.$rel.dir"} //= $path;
 231         $self->{"coderepo.$rel.cgiturl"} //= _array($rel);
 232 }
 233
 234 sub is_git_dir ($) {
 235         my ($git_dir) = @_;
 236         -d "$git_dir/objects" && -f "$git_dir/HEAD";
 237 }
 238
 239 # XXX needs testing for cgit compatibility
 240 sub scan_path_coderepo {
 241         my ($self, $base, $path) = @_;
 242         opendir(my $dh, $path) or do {
 243                 warn "error opening directory: $path\n";
 244                 return
 245         };
 246         my $git_dir = $path;
 247         if (is_git_dir($git_dir) || is_git_dir($git_dir .= '/.git')) {
 248                 my $repo = { dir => $git_dir };
 249                 cgit_repo_merge($self, $base, $repo);
 250                 return;
 251         }
 252         while (defined(my $dn = readdir $dh)) {
 253                 next if $dn eq '.' || $dn eq '..';
 254                 if (index($dn, '.') == 0 && !$self->{-cgit_scan_hidden_path}) {
 255                         next;
 256                 }
 257                 my $dir = "$path/$dn";
 258                 scan_path_coderepo($self, $base, $dir) if -d $dir;
 259         }
 260 }
 261
 262 sub scan_tree_coderepo ($$) {
 263         my ($self, $path) = @_;
 264         scan_path_coderepo($self, $path, $path);
 265 }
 266
 267 sub scan_projects_coderepo ($$$) {
 268         my ($self, $list, $path) = @_;
 269         open my $fh, '<', $list or do {
 270                 warn "failed to open cgit projectlist=$list: $!\n";
 271                 return;
 272         };
 273         while (<$fh>) {
 274                 chomp;
 275                 scan_path_coderepo($self, $path, "$path/$_");
 276         }
 277 }
 278
 279 sub parse_cgitrc {
 280         my ($self, $cgitrc, $nesting) = @_;
 281         if ($nesting == 0) {
 282                 # defaults:
 283                 my %s = map { $_ => 1 } qw(/cgit.css /cgit.png
 284                                                 /favicon.ico /robots.txt);
 285                 $self->{-cgit_static} = \%s;
 286         }
 287
 288         # same limit as cgit/configfile.c::parse_configfile
 289         return if $nesting > 8;
 290
 291         open my $fh, '<', $cgitrc or do {
 292                 warn "failed to open cgitrc=$cgitrc: $!\n";
 293                 return;
 294         };
 295
 296         # FIXME: this doesn't support macro expansion via $VARS, yet
 297         my $repo;
 298         while (<$fh>) {
 299                 chomp;
 300                 if (m!\Arepo\.url=(.+?)/*\z!) {
 301                         my $nick = $1;
 302                         cgit_repo_merge($self, $repo->{dir}, $repo) if $repo;
 303                         $repo = { url => $nick };
 304                 } elsif (m!\Arepo\.path=(.+)\z!) {
 305                         if (defined $repo) {
 306                                 $repo->{dir} = $1;
 307                         } else {
 308                                 warn "$_ without repo.url\n";
 309                         }
 310                 } elsif (m!\Ainclude=(.+)\z!) {
 311                         parse_cgitrc($self, $1, $nesting + 1);
 312                 } elsif (m!\A(scan-hidden-path|remove-suffix)=([0-9]+)\z!) {
 313                         my ($k, $v) = ($1, $2);
 314                         $k =~ tr/-/_/;
 315                         $self->{"-cgit_$k"} = $v;
 316                 } elsif (m!\A(project-list|strict-export)=(.+)\z!) {
 317                         my ($k, $v) = ($1, $2);
 318                         $k =~ tr/-/_/;
 319                         $self->{"-cgit_$k"} = $v;
 320                 } elsif (m!\Ascan-path=(.+)\z!) {
 321                         if (defined(my $list = $self->{-cgit_project_list})) {
 322                                 scan_projects_coderepo($self, $list, $1);
 323                         } else {
 324                                 scan_tree_coderepo($self, $1);
 325                         }
 326                 } elsif (m!\A(?:css|favicon|logo|repo\.logo)=(/.+)\z!) {
 327                         # absolute paths for static files via PublicInbox::Cgit
 328                         $self->{-cgit_static}->{$1} = 1;
 329                 }
 330         }
 331         cgit_repo_merge($self, $repo->{dir}, $repo) if $repo;
 332 }
 333
 334 # parse a code repo
 335 # Only git is supported at the moment, but SVN and Hg are possibilities
 336 sub _fill_code_repo {
 337         my ($self, $nick) = @_;
 338         my $pfx = "coderepo.$nick";
 339
 340         # TODO: support gitweb and other repository viewers?
 341         if (defined(my $cgitrc = delete $self->{-cgitrc_unparsed})) {
 342                 parse_cgitrc($self, $cgitrc, 0);
 343         }
 344         my $dir = $self->{"$pfx.dir"}; # aka "GIT_DIR"
 345         unless (defined $dir) {
 346                 warn "$pfx.dir unset\n";
 347                 return;
 348         }
 349
 350         my $git = PublicInbox::Git->new($dir);
 351         foreach my $t (qw(blob commit tree tag)) {
 352                 $git->{$t.'_url_format'} =
 353                                 _array($self->{lc("$pfx.${t}UrlFormat")});
 354         }
 355
 356         if (defined(my $cgits = $self->{"$pfx.cgiturl"})) {
 357                 $git->{cgit_url} = $cgits = _array($cgits);
 358                 $self->{"$pfx.cgiturl"} = $cgits;
 359
 360                 # cgit supports "/blob/?id=%s", but it's only a plain-text
 361                 # display and requires an unabbreviated id=
 362                 foreach my $t (qw(blob commit tag)) {
 363                         $git->{$t.'_url_format'} //= map {
 364                                 "$_/$t/?id=%s"
 365                         } @$cgits;
 366                 }
 367         }
 368
 369         $git;
 370 }
 371
 372 sub git_bool {
 373         my ($val) = $_[-1]; # $_[0] may be $self, or $val
 374         if ($val =~ /\A(?:false|no|off|[\-\+]?(?:0x)?0+)\z/i) {
 375                 0;
 376         } elsif ($val =~ /\A(?:true|yes|on|[\-\+]?(?:0x)?[0-9]+)\z/i) {
 377                 1;
 378         } else {
 379                 undef;
 380         }
 381 }
 382
 383 sub _fill {
 384         my ($self, $pfx) = @_;
 385         my $ibx = {};
 386
 387         foreach my $k (qw(inboxdir filter newsgroup
 388                         watch httpbackendmax
 389                         replyto feedmax nntpserver
 390                         indexlevel indexsequentialshard)) {
 391                 my $v = $self->{"$pfx.$k"};
 392                 $ibx->{$k} = $v if defined $v;
 393         }
 394
 395         # backwards compatibility:
 396         $ibx->{inboxdir} //= $self->{"$pfx.mainrepo"};
 397         if (($ibx->{inboxdir} // '') =~ /\n/s) {
 398                 warn "E: `$ibx->{inboxdir}' must not contain `\\n'\n";
 399                 return;
 400         }
 401         foreach my $k (qw(obfuscate)) {
 402                 my $v = $self->{"$pfx.$k"};
 403                 defined $v or next;
 404                 if (defined(my $bval = git_bool($v))) {
 405                         $ibx->{$k} = $bval;
 406                 } else {
 407                         warn "Ignoring $pfx.$k=$v in config, not boolean\n";
 408                 }
 409         }
 410         # TODO: more arrays, we should support multi-value for
 411         # more things to encourage decentralization
 412         foreach my $k (qw(address altid nntpmirror coderepo hide listid url
 413                         infourl watchheader)) {
 414                 if (defined(my $v = $self->{"$pfx.$k"})) {
 415                         $ibx->{$k} = _array($v);
 416                 }
 417         }
 418
 419         return unless defined($ibx->{inboxdir});
 420         my $name = $pfx;
 421         $name =~ s/\Apublicinbox\.//;
 422
 423         if (!valid_inbox_name($name)) {
 424                 warn "invalid inbox name: '$name'\n";
 425                 return;
 426         }
 427
 428         $ibx->{name} = $name;
 429         $ibx->{-pi_config} = $self;
 430         $ibx = PublicInbox::Inbox->new($ibx);
 431         foreach (@{$ibx->{address}}) {
 432                 my $lc_addr = lc($_);
 433                 $self->{-by_addr}->{$lc_addr} = $ibx;
 434                 $self->{-no_obfuscate}->{$lc_addr} = 1;
 435         }
 436         if (my $listids = $ibx->{listid}) {
 437                 foreach my $list_id (@$listids) {
 438                         $self->{-by_list_id}->{$list_id} = $ibx;
 439                 }
 440         }
 441         if (my $ng = $ibx->{newsgroup}) {
 442                 $self->{-by_newsgroup}->{$ng} = $ibx;
 443         }
 444         $self->{-by_name}->{$name} = $ibx;
 445         if ($ibx->{obfuscate}) {
 446                 $ibx->{-no_obfuscate} = $self->{-no_obfuscate};
 447                 $ibx->{-no_obfuscate_re} = $self->{-no_obfuscate_re};
 448                 fill_all($self); # noop to populate -no_obfuscate
 449         }
 450
 451         if (my $ibx_code_repos = $ibx->{coderepo}) {
 452                 my $code_repos = $self->{-code_repos};
 453                 my $repo_objs = $ibx->{-repo_objs} = [];
 454                 foreach my $nick (@$ibx_code_repos) {
 455                         my @parts = split(m!/!, $nick);
 456                         my $valid = 0;
 457                         $valid += valid_inbox_name($_) foreach (@parts);
 458                         $valid == scalar(@parts) or next;
 459
 460                         my $repo = $code_repos->{$nick} //=
 461                                                 _fill_code_repo($self, $nick);
 462                         push @$repo_objs, $repo if $repo;
 463                 }
 464         }
 465
 466         $ibx
 467 }
 468
 469 sub urlmatch {
 470         my ($self, $key, $url) = @_;
 471         state $urlmatch_broken; # requires git 1.8.5
 472         return if $urlmatch_broken;
 473         my $file = default_file();
 474         my $cmd = [qw/git config -z --includes --get-urlmatch/,
 475                 "--file=$file", $key, $url ];
 476         my $fh = popen_rd($cmd);
 477         local $/ = "\0";
 478         my $val = <$fh>;
 479         if (close($fh)) {
 480                 chomp($val);
 481                 $val;
 482         } else {
 483                 $urlmatch_broken = 1 if (($? >> 8) != 1);
 484                 undef;
 485         }
 486 }
 487
 488 1;