lib/Debbugs/Config.pm

   1 # This module is part of debbugs, and is released
   2 # under the terms of the GPL version 2, or any later
   3 # version at your option.
   4 # See the file README and COPYING for more information.
   5 #
   6 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
   7
   8 package Debbugs::Config;
   9
  10 =head1 NAME
  11
  12 Debbugs::Config -- Configuration information for debbugs
  13
  14 =head1 SYNOPSIS
  15
  16  use Debbugs::Config;
  17
  18 # to get the compatiblity interface
  19
  20  use Debbugs::Config qw(:globals);
  21
  22 =head1 DESCRIPTION
  23
  24 This module provides configuration variables for all of debbugs.
  25
  26 =head1 CONFIGURATION FILES
  27
  28 The default configuration file location is /etc/debbugs/config; this
  29 configuration file location can be set by modifying the
  30 DEBBUGS_CONFIG_FILE env variable to point at a different location.
  31
  32 =cut
  33
  34 use Mouse;
  35 use strictures 2;
  36 use namespace::clean;
  37
  38 use Carp qw(croak);
  39 use List::Util qw(uniq);
  40
  41 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT $USING_GLOBALS %config);
  42 use base qw(Exporter);
  43
  44 BEGIN {
  45      # set the version for version checking
  46      $VERSION     = 1.00;
  47      $DEBUG = 0 unless defined $DEBUG;
  48      $USING_GLOBALS = 0;
  49
  50      @EXPORT = ();
  51      %EXPORT_TAGS = (globals => [qw($gEmailDomain $gListDomain $gWebHost $gWebHostBugDir),
  52                                  qw($gWebDomain $gHTMLSuffix $gCGIDomain $gMirrors),
  53                                  qw($gPackagePages $gSubscriptionDomain $gProject $gProjectTitle),
  54                                  qw($gMaintainer $gMaintainerWebpage $gMaintainerEmail $gUnknownMaintainerEmail),
  55                                  qw($gPackageTrackingDomain $gUsertagPackageDomain),
  56                                  qw($gSubmitList $gMaintList $gQuietList $gForwardList),
  57                                  qw($gDoneList $gRequestList $gSubmitterList $gControlList),
  58                                  qw($gStrongList),
  59                                  qw($gBugSubscriptionDomain),
  60                                  qw($gPackageVersionRe),
  61                                  qw($gSummaryList $gMirrorList $gMailer $gBug),
  62                                  qw($gBugs $gRemoveAge $gSaveOldBugs $gDefaultSeverity),
  63                                  qw($gShowSeverities $gBounceFroms $gConfigDir $gSpoolDir),
  64                                  qw($gIncomingDir $gWebDir $gDocDir $gMaintainerFile),
  65                                  qw($gMaintainerFileOverride $gPseudoMaintFile $gPseudoDescFile $gPackageSource),
  66                                  qw($gVersionPackagesDir $gVersionIndex $gBinarySourceMap $gSourceBinaryMap),
  67                                  qw($gVersionTimeIndex),
  68                                  qw($gSimpleVersioning),
  69                                  qw($gCVETracker),
  70                                  qw($gSendmail @gSendmailArguments $gLibPath $gSpamScan @gExcludeFromControl),
  71                                  qw(%gSeverityDisplay @gTags @gSeverityList @gStrongSeverities),
  72                                  qw(%gTagsSingleLetter),
  73                                  qw(%gDistributionAliases),
  74                                  qw(%gObsoleteSeverities),
  75                                  qw(@gPostProcessall @gRemovalDefaultDistributionTags @gRemovalDistributionTags @gRemovalArchitectures),
  76                                  qw(@gRemovalStrongSeverityDefaultDistributionTags),
  77                                  qw(@gAffectsDistributionTags),
  78                                  qw(@gDefaultArchitectures),
  79                                  qw($gMachineName),
  80                                  qw($gTemplateDir),
  81                                  qw($gDefaultPackage),
  82                                  qw($gSpamMaxThreads $gSpamSpamsPerThread $gSpamKeepRunning $gSpamScan $gSpamCrossassassinDb),
  83                                  qw($gDatabase),
  84                                 ],
  85                      text     => [qw($gBadEmailPrefix $gHTMLTail $gHTMLExpireNote),
  86                                  ],
  87                      cgi => [qw($gLibravatarUri $gLibravatarCacheDir $gLibravatarUriOptions @gLibravatarBlacklist)],
  88                      config   => [qw(%config config)],
  89                     );
  90      @EXPORT_OK = ();
  91      Exporter::export_ok_tags(keys %EXPORT_TAGS);
  92      $EXPORT_TAGS{all} = [@EXPORT_OK];
  93      $ENV{HOME} = '' if not defined $ENV{HOME};
  94 }
  95
  96 use Sys::Hostname;
  97 use File::Basename qw(dirname);
  98 use IO::File;
  99 use Safe;
 100
 101 =head1 CONFIGURATION VARIABLES
 102
 103 =head2 General Configuration
 104
 105 =over
 106
 107 =cut
 108
 109 # read in the files;
 110 %config = ();
 111
 112 =item email_domain $gEmailDomain
 113
 114 The email domain of the bts
 115
 116 =cut
 117
 118 set_default(\%config,'email_domain','bugs.something');
 119
 120 =item list_domain $gListDomain
 121
 122 The list domain of the bts, defaults to the email domain
 123
 124 =cut
 125
 126 set_default(\%config,'list_domain',sub {$_[0]->email_domain});
 127
 128 =item web_host $gWebHost
 129
 130 The web host of the bts; defaults to the email domain
 131
 132 =cut
 133
 134 set_default(\%config,'web_host',sub {$_[0]->email_domain});
 135
 136 =item web_host_bug_dir $gWebHostDir
 137
 138 The directory of the web host on which bugs are kept, defaults to C<''>
 139
 140 =cut
 141
 142 set_default(\%config,'web_host_bug_dir','');
 143
 144 =item web_domain $gWebDomain
 145
 146 Full path of the web domain where bugs are kept including the protocol (http://
 147 or https://). Defaults to the concatenation of 'http://', L</web_host> and
 148 L</web_host_bug_dir>
 149
 150 =cut
 151
 152 set_default(\%config,'web_domain',
 153             sub {my $config = shift;
 154                  return 'http://'.$config->web_host.($config->web_host=~m{/$}?'':'/').
 155                      $config->web_host_bug_dir;
 156                  });
 157
 158 =item html_suffix $gHTMLSuffix
 159
 160 Suffix of html pages, defaults to .html
 161
 162 =cut
 163
 164 set_default(\%config,'html_suffix','.html');
 165
 166 =item cgi_domain $gCGIDomain
 167
 168 Full path of the web domain where cgi scripts are kept. Defaults to
 169 the concatentation of L</web_domain> and cgi.
 170
 171 =cut
 172
 173 set_default(\%config,'cgi_domain',
 174             sub {my $config = shift;
 175                  return $config->web_domain.($config->web_domain=~m{/$}?'':'/').'cgi'
 176                 });
 177
 178 =item mirrors @gMirrors
 179
 180 List of mirrors [What these mirrors are used for, no one knows.]
 181
 182 =cut
 183
 184
 185 set_default(\%config,'mirrors',sub {[]});
 186
 187 =item package_pages  $gPackagePages
 188
 189 Domain where the package pages are kept; links should work in a
 190 package_pages/foopackage manner. Defaults to undef, which means that package
 191 links will not be made. Should be prefixed with the appropriate protocol
 192 (http/https).
 193
 194 =cut
 195
 196
 197 set_default(\%config,'package_pages',undef);
 198
 199 =item package_tracking_domain  $gPackageTrackingDomain
 200
 201 Domain where the package pages are kept; links should work in a
 202 package_tracking_domain/foopackage manner. Defaults to undef, which means that
 203 package links will not be made. Should be prefixed with the appropriate protocol
 204 (http or https).
 205
 206 =cut
 207
 208 set_default(\%config,'package_tracking_domain',undef);
 209
 210 =item package_pages  $gUsertagPackageDomain
 211
 212 Domain where where usertags of packages belong; defaults to $gPackagePages
 213
 214 =cut
 215
 216 set_default(\%config,'usertag_package_domain',
 217             sub {my $config = shift;
 218                  my $a = $config->package_pages;
 219                  return $a unless defined $a;
 220                  $a =~ s{https?://}{};
 221                  return $a;
 222              });
 223
 224
 225 =item subscription_domain $gSubscriptionDomain
 226
 227 Domain where subscriptions to package lists happen
 228
 229 =cut
 230
 231 set_default(\%config,'subscription_domain',undef);
 232
 233
 234 =item cc_all_mails_to_addr $gCcAllMailsToAddr
 235
 236 Address to Cc (well, Bcc) all e-mails to
 237
 238 =cut
 239
 240 set_default(\%config,'cc_all_mails_to_addr',undef);
 241
 242
 243 =item cve_tracker $gCVETracker
 244
 245 URI to CVE security tracker; in bugreport.cgi, CVE-2001-0002 becomes
 246 linked to $config->cve_trackerCVE-2001-002
 247
 248 Default: https://security-tracker.debian.org/tracker/
 249
 250 =cut
 251
 252 set_default(\%config,'cve_tracker','https://security-tracker.debian.org/tracker/');
 253
 254
 255 =back
 256
 257 =cut
 258
 259
 260 =head2 Project Identification
 261
 262 =over
 263
 264 =item project $gProject
 265
 266 Name of the project
 267
 268 Default: 'Something'
 269
 270 =cut
 271
 272 set_default(\%config,'project','Something');
 273
 274 =item project_title $gProjectTitle
 275
 276 Name of this install of Debbugs, defaults to "L</project> Debbugs Install"
 277
 278 Default: "$config->project Debbugs Install"
 279
 280 =cut
 281
 282 set_default(\%config,'project_title',sub {$_[0]->project." Debbugs Install"});
 283
 284 =item maintainer $gMaintainer
 285
 286 Name of the maintainer of this debbugs install
 287
 288 Default: 'Local DebBugs Owner's
 289
 290 =cut
 291
 292 set_default(\%config,'maintainer','Local DebBugs Owner');
 293
 294 =item maintainer_webpage $gMaintainerWebpage
 295
 296 Webpage of the maintainer of this install of debbugs
 297
 298 Default: "$config->web_domain/~owner"
 299
 300 =cut
 301
 302 set_default(\%config,'maintainer_webpage',sub {$_[0]->web_domain."/~owner"});
 303
 304 =item maintainer_email $gMaintainerEmail
 305
 306 Email address of the maintainer of this Debbugs install
 307
 308 Default: 'root@'.$config->email_domain
 309
 310 =cut
 311
 312 set_default(\%config,'maintainer_email',sub {'root@'.$_[0]->email_domain});
 313
 314 =item unknown_maintainer_email
 315
 316 Email address where packages with an unknown maintainer will be sent
 317
 318 Default: $config->maintainer_email
 319
 320 =cut
 321
 322 set_default(\%config,'unknown_maintainer_email',sub {$_[0]->maintainer_email});
 323
 324 =item machine_name
 325
 326 The name of the machine that this instance of debbugs is running on
 327 (currently used for debbuging purposes and web page output.)
 328
 329 Default: Sys::Hostname::hostname()
 330
 331 =back
 332
 333 =cut
 334
 335 set_default(\%config,'machine_name',sub {Sys::Hostname::hostname()});
 336
 337 =head2 BTS Mailing Lists
 338
 339
 340 =over
 341
 342 =item submit_list
 343
 344 =item maint_list
 345
 346 =item forward_list
 347
 348 =item done_list
 349
 350 =item request_list
 351
 352 =item submitter_list
 353
 354 =item control_list
 355
 356 =item summary_list
 357
 358 =item mirror_list
 359
 360 =item strong_list
 361
 362 =cut
 363
 364 set_default(\%config,   'submit_list',   'bug-submit-list');
 365 set_default(\%config,    'maint_list',    'bug-maint-list');
 366 set_default(\%config,    'quiet_list',    'bug-quiet-list');
 367 set_default(\%config,  'forward_list',  'bug-forward-list');
 368 set_default(\%config,     'done_list',     'bug-done-list');
 369 set_default(\%config,  'request_list',  'bug-request-list');
 370 set_default(\%config,'submitter_list','bug-submitter-list');
 371 set_default(\%config,  'control_list',  'bug-control-list');
 372 set_default(\%config,  'summary_list',  'bug-summary-list');
 373 set_default(\%config,   'mirror_list',   'bug-mirror-list');
 374 set_default(\%config,   'strong_list',   'bug-strong-list');
 375
 376 =item bug_subscription_domain
 377
 378 Domain of list for messages regarding a single bug; prefixed with
 379 bug=${bugnum}@ when bugs are actually sent out. Set to undef or '' to
 380 disable sending messages to the bug subscription list.
 381
 382 Default: list_domain
 383
 384 =back
 385
 386 =cut
 387
 388 set_default(\%config,'bug_subscription_domain',sub {$_[0]->list_domain});
 389
 390
 391
 392 =head2 Misc Options
 393
 394 =over
 395
 396 =item mailer
 397
 398 Name of the mailer to use
 399
 400 Default: exim
 401
 402 =cut
 403
 404 set_default(\%config,'mailer','exim');
 405
 406
 407 =item bug
 408
 409 Default: bug
 410
 411 =item ubug
 412
 413 Default: ucfirst($config->bug);
 414
 415 =item bugs
 416
 417 Default: bugs
 418
 419 =item ubugs
 420
 421 Default: ucfirst($config->ubugs);
 422
 423 =cut
 424
 425 set_default(\%config,'bug','bug');
 426 set_default(\%config,'ubug',sub {ucfirst($_[0]->bug)});
 427 set_default(\%config,'bugs','bugs');
 428 set_default(\%config,'ubugs',sub {ucfirst($_[0]->bugs)});
 429
 430 =item remove_age
 431
 432 Age at which bugs are archived/removed
 433
 434 Default: 28
 435
 436 =cut
 437
 438 set_default(\%config,'remove_age',28);
 439
 440 =item save_old_bugs
 441
 442 Whether old bugs are saved or deleted
 443
 444 Default: 1
 445
 446 =cut
 447
 448 set_default(\%config,'save_old_bugs',1);
 449
 450 =item distribution_aliases
 451
 452 Map of distribution aliases to the distribution name
 453
 454 Default:
 455          {experimental => 'experimental',
 456           unstable     => 'unstable',
 457           testing      => 'testing',
 458           stable       => 'stable',
 459           oldstable    => 'oldstable',
 460           sid          => 'unstable',
 461           lenny        => 'testing',
 462           etch         => 'stable',
 463           sarge        => 'oldstable',
 464          }
 465
 466 =cut
 467
 468 set_default(\%config,'distribution_aliases',
 469             sub {{experimental => 'experimental',
 470              unstable     => 'unstable',
 471              testing      => 'testing',
 472              stable       => 'stable',
 473              oldstable    => 'oldstable',
 474              sid          => 'unstable',
 475              lenny        => 'testing',
 476              etch         => 'stable',
 477              sarge        => 'oldstable',
 478             }},
 479            );
 480
 481
 482
 483 =item distributions
 484
 485 List of valid distributions
 486
 487 Default: The values of the distribution aliases map.
 488
 489 =cut
 490
 491 set_default(\%config,'distributions',
 492             sub {
 493                 my $config = shift;
 494                 return [uniq keys %{$config->distribution_aliases}];
 495             });
 496
 497
 498 =item default_architectures
 499
 500 List of default architectures to use when architecture(s) are not
 501 specified
 502
 503 Default: i386 amd64 arm ppc sparc alpha
 504
 505 =cut
 506
 507 set_default(\%config,'default_architectures',
 508             sub {[qw(i386 amd64 arm powerpc sparc alpha)]}
 509            );
 510
 511 =item affects_distribution_tags
 512
 513 List of tags which restrict the buggy state to a set of distributions.
 514
 515 The set of distributions that are buggy is the intersection of the set
 516 of distributions that would be buggy without reference to these tags
 517 and the set of these tags that are distributions which are set on a
 518 bug.
 519
 520 Setting this to [] will remove this feature.
 521
 522 Default: @{$config->distributions}
 523
 524 =cut
 525
 526 set_default(\%config,'affects_distribution_tags',
 527             sub {return [@{$_[0]->distributions}]},
 528            );
 529
 530 =item removal_unremovable_tags
 531
 532 Bugs which have these tags set cannot be archived
 533
 534 Default: []
 535
 536 =cut
 537
 538 set_default(\%config,'removal_unremovable_tags',
 539             sub {[]},
 540            );
 541
 542 =item removal_distribution_tags
 543
 544 Tags which specifiy distributions to check
 545
 546 Default: @{$config->distributions}
 547
 548 =cut
 549
 550 set_default(\%config,'removal_distribution_tags',
 551             sub {[@{$_[0]->distributions}]});
 552
 553 =item removal_default_distribution_tags
 554
 555 For removal/archival purposes, all bugs are assumed to have these tags
 556 set.
 557
 558 Default: qw(experimental unstable testing);
 559
 560 =cut
 561
 562 set_default(\%config,'removal_default_distribution_tags',
 563             sub {[qw(experimental unstable testing)]}
 564            );
 565
 566 =item removal_strong_severity_default_distribution_tags
 567
 568 For removal/archival purposes, all bugs with strong severity are
 569 assumed to have these tags set.
 570
 571 Default: qw(experimental unstable testing stable);
 572
 573 =cut
 574
 575 set_default(\%config,'removal_strong_severity_default_distribution_tags',
 576             sub {[qw(experimental unstable testing stable)]}
 577            );
 578
 579
 580 =item removal_architectures
 581
 582 For removal/archival purposes, these architectures are consulted if
 583 there is more than one architecture applicable. If the bug is in a
 584 package not in any of these architectures, the architecture actually
 585 checked is undefined.
 586
 587 Default: value of default_architectures
 588
 589 =cut
 590
 591 set_default(\%config,'removal_architectures',
 592             sub {[@{$_[0]->default_architectures}]},
 593            );
 594
 595
 596 =item package_name_re
 597
 598 The regex which will match a package name
 599
 600 Default: '[a-z0-9][a-z0-9\.+-]+'
 601
 602 =cut
 603
 604 set_default(\%config,'package_name_re',
 605             '[a-z0-9][a-z0-9\.+-]+');
 606
 607 =item package_version_re
 608
 609 The regex which will match a package version
 610
 611 Default: '[A-Za-z0-9:+\.-]+'
 612
 613 =cut
 614
 615
 616 set_default(\%config,'package_version_re',
 617             '[A-Za-z0-9:+\.~-]+');
 618
 619
 620 =item default_package
 621
 622 This is the name of the default package. If set, bugs assigned to
 623 packages without a maintainer and bugs missing a Package: psuedoheader
 624 will be assigned to this package instead.
 625
 626 Defaults to unset, which is the traditional debbugs behavoir
 627
 628 =cut
 629
 630 set_default(\%config,'default_package',
 631             undef
 632            );
 633
 634
 635 =item control_internal_requester
 636
 637 This address is used by Debbugs::Control as the request address which
 638 sent a control request for faked log messages.
 639
 640 Default:"Debbugs Internal Request <$config->maintainer_email>"
 641
 642 =cut
 643
 644 set_default(\%config,'control_internal_requester',
 645             sub {"Debbugs Internal Request <".$_[0]->maintainer_email.">"},
 646            );
 647
 648 =item control_internal_request_addr
 649
 650 This address is used by Debbugs::Control as the address to which a
 651 faked log message request was sent.
 652
 653 Default: "internal_control\@$config->email_domain";
 654
 655 =cut
 656
 657 set_default(\%config,'control_internal_request_addr',
 658             sub {'internal_control@'.$_[0]->email_domain},
 659            );
 660
 661
 662 =item exclude_from_control
 663
 664 Addresses which are not allowed to send messages to control
 665
 666 =cut
 667
 668 set_default(\%config,'exclude_from_control',sub {[]});
 669
 670
 671
 672 =item default_severity
 673
 674 The default severity of bugs which have no severity set
 675
 676 Default: normal
 677
 678 =cut
 679
 680 set_default(\%config,'default_severity','normal');
 681
 682 =item severity_display
 683
 684 A hashref of severities and the informative text which describes them.
 685
 686 Default:
 687
 688  {critical => "Critical $config->bugs",
 689   grave    => "Grave $config->bugs",
 690   normal   => "Normal $config->bugs",
 691   wishlist => "Wishlist $config->bugs",
 692  }
 693
 694 =cut
 695
 696 set_default(\%config,'severity_display',
 697             sub {
 698                 my $config = shift;
 699                 my $s = {};
 700                 for (@{$config->severity_list}) {
 701                     $s->{$_} = ucfirst($_). ' '. $config->bugs;
 702                 }
 703                 return $s;
 704             });
 705
 706 =item show_severities
 707
 708 A scalar list of the severities to show
 709
 710 Defaults to the concatenation of the keys of the severity_display
 711 hashlist with ', ' above.
 712
 713 =cut
 714
 715 set_default(\%config,'show_severities',
 716             sub {
 717                 my $config = shift;
 718                 return join (', ',
 719                       @{$config->severity_list});
 720              }
 721            );
 722
 723 =item strong_severities
 724
 725 An arrayref of the serious severities which shoud be emphasized
 726
 727 Default: [qw(critical grave)]
 728
 729 =cut
 730
 731 set_default(\%config,'strong_severities',sub {[qw(critical grave)]});
 732
 733 =item severity_list
 734
 735 An arrayref of a list of the severities
 736
 737 Defaults to the keys of the severity display hashref
 738
 739 =cut
 740
 741 set_default(\%config,'severity_list',
 742             sub {[qw(critical grave serious important normal minor wishlist)]});
 743
 744 =item obsolete_severities
 745
 746 A hashref of obsolete severities with the replacing severity
 747
 748 Default: {}
 749
 750 =cut
 751
 752 set_default(\%config,'obsolete_severities',sub {{}});
 753
 754 =item tags
 755
 756 An arrayref of the tags used
 757
 758 Default: [qw(patch wontfix moreinfo unreproducible fixed)] and also
 759 includes the distributions.
 760
 761 =cut
 762
 763 set_default(\%config,'tags',
 764             sub {
 765                 my $config = shift;
 766                 return [qw(patch wontfix moreinfo unreproducible fixed),
 767                         @{$config->distributions}
 768                        ]
 769             });
 770
 771 set_default(\%config,'tags_single_letter',
 772             sub {
 773                return {patch => '+',
 774                        wontfix => '',
 775                        moreinfo => 'M',
 776                        unreproducible => 'R',
 777                        fixed   => 'F',
 778                       };
 779            }
 780            );
 781
 782 set_default(\%config,'bounce_froms',
 783             '^mailer|^da?emon|^post.*mast|^root|^wpuser|^mmdf|^smt.*|'.
 784             '^mrgate|^vmmail|^mail.*system|^uucp|-maiser-|^mal\@|'.
 785             '^mail.*agent|^tcpmail|^bitmail|^mailman');
 786
 787 set_default(\%config,'config_dir',dirname(exists $ENV{DEBBUGS_CONFIG_FILE}?$ENV{DEBBUGS_CONFIG_FILE}:'/etc/debbugs/config'));
 788 set_default(\%config,'spool_dir','/var/lib/debbugs/spool');
 789
 790 =item usertag_dir
 791
 792 Directory which contains the usertags
 793
 794 Default: $config->spool_dir/user
 795
 796 =cut
 797
 798 set_default(\%config,'usertag_dir',
 799             sub {$_[0]->spool_dir.'/user'});
 800 set_default(\%config,'incoming_dir','incoming');
 801
 802 =item web_dir $gWebDir
 803
 804 Directory where base html files are kept. Should normally be the same
 805 as the web server's document root.
 806
 807 Default: /var/lib/debbugs/www
 808
 809 =cut
 810
 811 set_default(\%config,'web_dir','/var/lib/debbugs/www');
 812 set_default(\%config,'doc_dir','/var/lib/debbugs/www/txt');
 813 set_default(\%config,'lib_path','/usr/lib/debbugs');
 814
 815
 816 =item template_dir
 817
 818 directory of templates; defaults to /usr/share/debbugs/templates.
 819
 820 =cut
 821
 822 set_default(\%config,'template_dir','/usr/share/debbugs/templates');
 823
 824
 825 set_default(\%config,'maintainer_file',sub {$_[0]->config_dir.'/Maintainers'});
 826 set_default(\%config,'maintainer_file_override',sub {$_[0]->config_dir.'/Maintainers.override'});
 827 set_default(\%config,'source_maintainer_file',sub {$_[0]->config_dir.'/Source_maintainers'});
 828 set_default(\%config,'source_maintainer_file_override',undef);
 829 set_default(\%config,'pseudo_maint_file',sub {$_[0]->config_dir.'/pseudo-packages.maintainers'});
 830 set_default(\%config,'pseudo_desc_file',sub {$_[0]->config_dir.'/pseudo-packages.description'});
 831 set_default(\%config,'package_source',sub {$_[0]->config_dir.'/indices/sources'});
 832
 833
 834 =item simple_versioning
 835
 836 If true this causes debbugs to ignore version information and just
 837 look at whether a bug is done or not done. Primarily of interest for
 838 debbugs installs which don't track versions. defaults to false.
 839
 840 =cut
 841
 842 set_default(\%config,'simple_versioning',0);
 843
 844
 845 =item version_packages_dir
 846
 847 Location where the version package information is kept; defaults to
 848 spool_dir/../versions/pkg
 849
 850 =cut
 851
 852 set_default(\%config,'version_packages_dir',sub {$_[0]->spool_dir.'/../versions/pkg'});
 853
 854 =item version_time_index
 855
 856 Location of the version/time index file. Defaults to
 857 spool_dir/../versions/idx/versions_time.idx if spool_dir/../versions
 858 exists; otherwise defaults to undef.
 859
 860 =cut
 861
 862
 863 set_default(\%config,'version_time_index',
 864             sub {my $config = shift;
 865                  return -d $config->spool_dir.'/../versions' ?
 866                      $config->spool_dir.'/../versions/indices/versions_time.idx' :
 867                      undef
 868                  });
 869
 870 =item version_index
 871
 872 Location of the version index file. Defaults to
 873 spool_dir/../versions/indices/versions.idx if spool_dir/../versions
 874 exists; otherwise defaults to undef.
 875
 876 =cut
 877
 878 set_default(\%config,'version_index',
 879             sub {my $config = shift;
 880                  return -d $config->spool_dir.'/../versions' ?
 881                      $config->spool_dir.'/../versions/indices/versions.idx' :
 882                      undef
 883                  });
 884
 885 =item binary_source_map
 886
 887 Location of the binary -> source map. Defaults to
 888 spool_dir/../versions/indices/bin2src.idx if spool_dir/../versions
 889 exists; otherwise defaults to undef.
 890
 891 =cut
 892
 893 set_default(\%config,'binary_source_map',
 894             sub {my $config = shift;
 895                  return -d $config->spool_dir.'/../versions' ?
 896                      $config->spool_dir.'/../versions/indices/binsrc.idx' :
 897                      undef
 898                  });
 899
 900 =item source_binary_map
 901
 902 Location of the source -> binary map. Defaults to
 903 spool_dir/../versions/indices/src2bin.idx if spool_dir/../versions
 904 exists; otherwise defaults to undef.
 905
 906 =cut
 907
 908 set_default(\%config,'source_binary_map',
 909             sub {my $config = shift;
 910                  return -d $config->spool_dir.'/../versions' ?
 911                      $config->spool_dir.'/../versions/indices/srcbin.idx' :
 912                      undef
 913                  });
 914
 915
 916
 917 set_default(\%config,'post_processall',sub {[]});
 918
 919 =item sendmail
 920
 921 Sets the sendmail binary to execute; defaults to /usr/lib/sendmail
 922
 923 =cut
 924
 925 set_default(\%config,'sendmail','/usr/lib/sendmail');
 926
 927 =item sendmail_arguments
 928
 929 Default arguments to pass to sendmail. Defaults to C<qw(-oem -oi)>.
 930
 931 =cut
 932
 933 set_default(\%config,'sendmail_arguments',sub {[qw(-oem -oi)]});
 934
 935 =item envelope_from
 936
 937 Envelope from to use for sent messages. If not set, whatever sendmail picks is
 938 used.
 939
 940 =cut
 941
 942 set_default(\%config,'envelope_from',undef);
 943
 944 =item spam_scan
 945
 946 Whether or not spamscan is being used; defaults to 0 (not being used
 947
 948 =cut
 949
 950 set_default(\%config,'spam_scan',0);
 951
 952 =item spam_crossassassin_db
 953
 954 Location of the crosassassin database, defaults to
 955 spool_dir/../CrossAssassinDb
 956
 957 =cut
 958
 959 set_default(\%config,'spam_crossassassin_db',
 960             sub {$_[0]->spool_dir.'/../CrossAssassinDb'});
 961
 962 =item spam_max_cross
 963
 964 Maximum number of cross-posted messages
 965
 966 =cut
 967
 968 set_default(\%config,'spam_max_cross',6);
 969
 970
 971 =item spam_spams_per_thread
 972
 973 Number of spams for each thread (on average). Defaults to 200
 974
 975 =cut
 976
 977 set_default(\%config,'spam_spams_per_thread',200);
 978
 979 =item spam_max_threads
 980
 981 Maximum number of threads to start. Defaults to 20
 982
 983 =cut
 984
 985 set_default(\%config,'spam_max_threads',20);
 986
 987 =item spam_keep_running
 988
 989 Maximum number of seconds to run without restarting. Defaults to 3600.
 990
 991 =cut
 992
 993 set_default(\%config,'spam_keep_running',3600);
 994
 995 =item spam_mailbox
 996
 997 Location to store spam messages; is run through strftime to allow for
 998 %d,%m,%Y, et al. Defaults to 'spool_dir/../mail/spam/assassinated.%Y-%m-%d'
 999
1000 =cut
1001
1002 set_default(\%config,'spam_mailbox',
1003             sub {$_[0]->spool_dir.'/../mail/spam/assassinated.%Y-%m-%d'});
1004
1005 =item spam_crossassassin_mailbox
1006
1007 Location to store crossassassinated messages; is run through strftime
1008 to allow for %d,%m,%Y, et al. Defaults to
1009 'spool_dir/../mail/spam/crossassassinated.%Y-%m-%d'
1010
1011 =cut
1012
1013 set_default(\%config,'spam_crossassassin_mailbox',
1014             sub {$_[0]->spool_dir.'/../mail/spam/crossassassinated.%Y-%m-%d'});
1015
1016 =item spam_local_tests_only
1017
1018 Whether only local tests are run, defaults to 0
1019
1020 =cut
1021
1022 set_default(\%config,'spam_local_tests_only',0);
1023
1024 =item spam_user_prefs
1025
1026 User preferences for spamassassin, defaults to $ENV{HOME}/.spamassassin/user_prefs
1027
1028 =cut
1029
1030 set_default(\%config,'spam_user_prefs',"$ENV{HOME}/.spamassassin/user_prefs");
1031
1032 =item spam_rules_dir
1033
1034 Site rules directory for spamassassin, defaults to
1035 '/usr/share/spamassassin'
1036
1037 =cut
1038
1039 set_default(\%config,'spam_rules_dir','/usr/share/spamassassin');
1040
1041 =back
1042
1043 =head2 CGI Options
1044
1045 =over
1046
1047 =item libravatar_uri $gLibravatarUri
1048
1049 URI to a libravatar configuration. If empty or undefined, libravatar
1050 support will be disabled. Defaults to
1051 libravatar.cgi, our internal federated libravatar system.
1052
1053 =cut
1054
1055 set_default(\%config,'libravatar_uri',
1056             sub {$_[0]->cgi_domain.'/libravatar.cgi?email='});
1057
1058 =item libravatar_uri_options $gLibravatarUriOptions
1059
1060 Options to append to the md5_hex of the e-mail. This sets the default
1061 avatar used when an avatar isn't available. Currently defaults to
1062 '?d=retro', which causes a bitmap-looking avatar to be displayed for
1063 unknown e-mails.
1064
1065 Other options which make sense include ?d=404, ?d=wavatar, etc. See
1066 the API of libravatar for details.
1067
1068 =cut
1069
1070 set_default(\%config,'libravatar_uri_options','');
1071
1072 =item libravatar_default_image
1073
1074 Default image to serve for libravatar if there is no avatar for an
1075 e-mail address. By default, this is a 1x1 png. [This will also be the
1076 image served if someone specifies avatar=no.]
1077
1078 Default: $config->web_dir/1x1.png
1079
1080 =cut
1081
1082 set_default(\%config,'libravatar_default_image',sub {$_[0]->web_dir.'/1x1.png'});
1083
1084 =item libravatar_cache_dir
1085
1086 Directory where cached libravatar images are stored
1087
1088 Default: $config->web_dir/libravatar/
1089
1090 =cut
1091
1092 set_default(\%config,'libravatar_cache_dir',sub {$_[0]->web_dir.'/libravatar/'});
1093
1094 =item libravatar_blacklist
1095
1096 Array of regular expressions to match against emails, domains, or
1097 images to only show the default image
1098
1099 Default: empty array
1100
1101 =cut
1102
1103 set_default(\%config,'libravatar_blacklist',sub {[]});
1104
1105 =back
1106
1107 =head2 Database
1108
1109 =over
1110
1111 =item database
1112
1113 Name of debbugs PostgreSQL database service. If you wish to not use a service
1114 file, provide a full DBD::Pg compliant data-source, for example:
1115 C<"dbi:Pg:dbname=dbname">
1116
1117 =back
1118
1119 =cut
1120
1121 set_default(\%config,'database',undef);
1122
1123 =head2 Text Fields
1124
1125 The following are the only text fields in general use in the scripts;
1126 a few additional text fields are defined in text.in, but are only used
1127 in db2html and a few other specialty scripts.
1128
1129 Earlier versions of debbugs defined these values in /etc/debbugs/text,
1130 but now they are required to be in the configuration file. [Eventually
1131 the longer ones will move out into a fully fledged template system.]
1132
1133 =cut
1134
1135 =over
1136
1137 =item bad_email_prefix
1138
1139 This prefixes the text of all lines in a bad e-mail message ack.
1140
1141 =cut
1142
1143 set_default(\%config,'bad_email_prefix','');
1144
1145
1146 =item text_instructions
1147
1148 This gives more information about bad e-mails to receive.in
1149
1150 =cut
1151
1152 set_default(\%config,'text_instructions',sub {$_[0]->bad_email_prefix});
1153
1154 =item html_tail
1155
1156 This shows up at the end of (most) html pages
1157
1158 In many pages this has been replaced by the html/tail template.
1159
1160 =cut
1161
1162 set_default(\%config,'html_tail',sub {
1163                 my $config = shift;
1164                 my $a = <<END; return $a; });
1165  <ADDRESS>@{[$config->maintainer]} &lt;<A HREF=\"mailto:@{[$config->maintainer_email]}\">@{[$config->maintainer_email]}</A>&gt;.
1166  Last modified:
1167  <!--timestamp-->
1168  SUBSTITUTE_DTIME
1169  <!--timestamp-->
1170  <P>
1171  <A HREF=\"@{[$config->web_domain]}\">Debian @{[$config->bug]} tracking system</A><BR>
1172  Copyright (C) 1999 Darren O. Benham,
1173  1997,2003 nCipher Corporation Ltd,
1174  1994-97 Ian Jackson.
1175  </P>
1176  </ADDRESS>
1177 END
1178
1179
1180 =item html_expire_note
1181
1182 This message explains what happens to archive/remove-able bugs
1183
1184 =cut
1185
1186 set_default(\%config,'html_expire_note',
1187             sub {
1188                 my $config = shift;
1189                 return "(Closed ".$config->bugs." are archived ".
1190                     $config->remove_age.
1191                     " days after the last related message is received.)"
1192                 });
1193
1194 =back
1195
1196 =cut
1197
1198
1199 sub read_config{
1200      my ($config,$conf_file) = @_;
1201      if (not -e $conf_file) {
1202          print STDERR "configuration file '$conf_file' doesn't exist; skipping it\n" if $DEBUG;
1203          return;
1204      }
1205      # first, figure out what type of file we're reading in.
1206      my $fh = IO::File->new($conf_file,'r')
1207           or die "Unable to open configuration file $conf_file for reading: $!";
1208      # A new version configuration file must have a comment as its first line
1209      my $first_line = <$fh>;
1210      my ($version) = defined $first_line?$first_line =~ /VERSION:\s*(\d+)/i:undef;
1211      if (defined $version) {
1212           if ($version == 1) {
1213                # Do something here;
1214                die "Version 1 configuration files not implemented yet";
1215           }
1216           else {
1217                die "Version $version configuration files are not supported";
1218           }
1219      }
1220      else {
1221           # Ugh. Old configuration file
1222           # What we do here is we create a new Safe compartment
1223           # so fucked up crap in the config file doesn't sink us.
1224           my $cpt = Safe->new() or die "Unable to create safe compartment";
1225           # perldoc Opcode; for details
1226           $cpt->permit('require',':filesys_read','entereval','caller','pack','unpack','dofile');
1227           $cpt->reval(qq(require '$conf_file';));
1228           die "Error in configuration file: $@" if $@;
1229           # Now what we do is check out the contents of %EXPORT_TAGS to see exactly which variables
1230           # we want to glob in from the configuration file
1231           for my $variable (map {$_ =~ /^(?:config|all)$/ ? () : @{$EXPORT_TAGS{$_}}} keys %EXPORT_TAGS) {
1232                my ($hash_name,$glob_name,$glob_type) = __convert_name($variable);
1233                my $var_glob = $cpt->varglob($glob_name);
1234                my $value; #= $cpt->reval("return $variable");
1235                # print STDERR "$variable $value",qq(\n);
1236                if (defined $var_glob) {{
1237                     no strict 'refs';
1238                     if ($glob_type eq '%') {
1239                          $value = {%{*{$var_glob}}} if defined *{$var_glob}{HASH};
1240                     }
1241                     elsif ($glob_type eq '@') {
1242                          $value = [@{*{$var_glob}}] if defined *{$var_glob}{ARRAY};
1243                     }
1244                     else {
1245                          $value = ${*{$var_glob}};
1246                     }
1247                     # We punt here, because we can't tell if the value was
1248                     # defined intentionally, or if it was just left alone;
1249                     # this tries to set sane defaults.
1250                     set_value($config,$hash_name,$value) if defined $value;
1251                }}
1252           }
1253      }
1254 }
1255
1256 sub __convert_name{
1257      my ($variable) = @_;
1258      my $hash_name = $variable;
1259      $hash_name =~ s/^([\$\%\@])g//;
1260      my $glob_type = $1;
1261      my $glob_name = 'g'.$hash_name;
1262      $hash_name =~ s/(HTML|CGI|CVE)/ucfirst(lc($1))/ge;
1263      $hash_name =~ s/^([A-Z]+)/lc($1)/e;
1264      $hash_name =~ s/([A-Z]+)/'_'.lc($1)/ge;
1265      return $hash_name unless wantarray;
1266      return ($hash_name,$glob_name,$glob_type);
1267 }
1268
1269 # set_default
1270
1271 # sets the configuration hash to the default value if it's not set,
1272 # otherwise doesn't do anything
1273 # If $USING_GLOBALS, then sets an appropriate global.
1274
1275 sub set_default {
1276     my ($config,$option,$value) = @_;
1277
1278     has $option =>
1279         (is => 'rw',
1280          lazy => 1,
1281          ref($value) eq 'CODE' ?
1282          (builder => $value):
1283          (builder => sub {
1284               my $self = shift;
1285               return $value;
1286           }),
1287         );
1288
1289     # set_value(@_);
1290 }
1291
1292 sub set_value{
1293      my ($config,$option,$value) = @_;
1294      my $varname;
1295      if ($USING_GLOBALS) {
1296           # fix up the variable name
1297           $varname = 'g'.join('',map {ucfirst $_} split /_/, $option);
1298           # Fix stupid HTML names
1299           $varname =~ s/(Html|Cgi)/uc($1)/ge;
1300      }
1301      my $m = $config->meta->find_method_by_name($option);
1302      if (not defined $m) {
1303          croak "Not a valid option $option";
1304      }
1305      $m->($config,$value);
1306      # update the configuration value
1307      if (not $USING_GLOBALS and not exists $config->{$option}) {
1308           $config->{$option} = $value;
1309      }
1310      elsif ($USING_GLOBALS) {{
1311           no strict 'refs';
1312           # Need to check if a value has already been set in a global
1313           if (defined *{"Debbugs::Config::${varname}"}) {
1314                $m->($config,*{"Debbugs::Config::${varname}"});
1315           }
1316           else {
1317                $m->($config,$value);
1318           }
1319      }}
1320      if ($USING_GLOBALS) {{
1321           no strict 'refs';
1322           *{"Debbugs::Config::${varname}"} = $m->($config);
1323      }}
1324 }
1325
1326 __PACKAGE__->meta->make_immutable();
1327
1328
1329 our $config = __PACKAGE__->new();
1330
1331 sub TIEHASH {
1332     return $config;
1333 }
1334
1335 sub FETCH {
1336     my ($this,$key) = @_;
1337     my $m = $config->meta->find_method_by_name($key);
1338     croak "No such element $key" if not defined $m;
1339     return $m->($this);
1340 }
1341
1342 sub STORE {
1343     my ($this,$key,$value) = @_;
1344     my $m = $config->meta->find_method_by_name($key);
1345     croak "No such element $key" if not defined $m;
1346     return $m->($this,$value);
1347 }
1348
1349 sub EXISTS {
1350     my ($this,$key) = @_;
1351     my $m = $config->meta->find_method_by_name($key);
1352     return defined $m;
1353 }
1354
1355 sub DELETE {
1356     # do nothing
1357 }
1358
1359 sub CLEAR {
1360     # do nothing
1361 }
1362
1363 sub SCALAR {
1364     return "Debbugs::Config(HASH)"
1365 }
1366
1367 sub UNTIE {
1368     # do nothing
1369 }
1370
1371 sub DESTROY {
1372     # do nothing
1373 }
1374
1375 our %config;
1376 tie %config,__PACKAGE__;
1377
1378
1379 # untaint $ENV{DEBBUGS_CONFIG_FILE} if it's owned by us
1380 # This enables us to test things that are -T.
1381 if (exists $ENV{DEBBUGS_CONFIG_FILE}) {
1382 # This causes all sorts of problems for mirrors of debbugs; disable
1383 # it.
1384 #     if (${[stat($ENV{DEBBUGS_CONFIG_FILE})]}[4] == $<) {
1385           $ENV{DEBBUGS_CONFIG_FILE} =~ /(.+)/;
1386           $ENV{DEBBUGS_CONFIG_FILE} = $1;
1387 #      }
1388 #      else {
1389 #         die "Environmental variable DEBBUGS_CONFIG_FILE set, and $ENV{DEBBUGS_CONFIG_FILE} is not owned by the user running this script.";
1390 #      }
1391 }
1392 read_config($config,exists $ENV{DEBBUGS_CONFIG_FILE}?$ENV{DEBBUGS_CONFIG_FILE}:'/etc/debbugs/config');
1393
1394
1395 ### import magick
1396
1397 # All we care about here is whether we've been called with the globals or text option;
1398 # if so, then we need to export some symbols back up.
1399 # In any event, we call exporter.
1400
1401 sub config {
1402     return $config;
1403 }
1404
1405 sub import {
1406      if (grep /^:(?:text|globals)$/, @_) {
1407           $USING_GLOBALS=1;
1408           for my $variable (map {@$_} @EXPORT_TAGS{map{(/^:(text|globals)$/?($1):())} @_}) {
1409                my $tmp = $variable;
1410                no strict 'refs';
1411                # Yes, I don't care if these are only used once
1412                no warnings 'once';
1413                # No, it doesn't bother me that I'm assigning an undefined value to a typeglob
1414                no warnings 'misc';
1415                my ($hash_name,$glob_name,$glob_type) = __convert_name($variable);
1416                $tmp =~ s/^[\%\$\@]//;
1417                *{"Debbugs::Config::${tmp}"} = ref($config{$hash_name})?$config{$hash_name}:\$config{$hash_name};
1418           }
1419      }
1420      Debbugs::Config->export_to_level(1,@_);
1421 }
1422
1423
1424 1;