lib/PublicInbox/Config.pm

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