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.
6 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
8 package Debbugs::Config;
12 Debbugs::Config -- Configuration information for debbugs
18 # to get the compatiblity interface
20 use Debbugs::Config qw(:globals);
24 This module provides configuration variables for all of debbugs.
26 =head1 CONFIGURATION FILES
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.
39 use List::Util qw(uniq);
41 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT $USING_GLOBALS %config);
42 use base qw(Exporter);
45 # set the version for version checking
47 $DEBUG = 0 unless defined $DEBUG;
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),
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),
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),
82 qw($gSpamMaxThreads $gSpamSpamsPerThread $gSpamKeepRunning $gSpamScan $gSpamCrossassassinDb),
85 text => [qw($gBadEmailPrefix $gHTMLTail $gHTMLExpireNote),
87 cgi => [qw($gLibravatarUri $gLibravatarCacheDir $gLibravatarUriOptions @gLibravatarBlacklist)],
88 config => [qw(%config config)],
91 Exporter::export_ok_tags(keys %EXPORT_TAGS);
92 $EXPORT_TAGS{all} = [@EXPORT_OK];
93 $ENV{HOME} = '' if not defined $ENV{HOME};
97 use File::Basename qw(dirname);
101 =head1 CONFIGURATION VARIABLES
103 =head2 General Configuration
112 =item email_domain $gEmailDomain
114 The email domain of the bts
118 set_default(\%config,'email_domain','bugs.something');
120 =item list_domain $gListDomain
122 The list domain of the bts, defaults to the email domain
126 set_default(\%config,'list_domain',sub {$_[0]->email_domain});
128 =item web_host $gWebHost
130 The web host of the bts; defaults to the email domain
134 set_default(\%config,'web_host',sub {$_[0]->email_domain});
136 =item web_host_bug_dir $gWebHostDir
138 The directory of the web host on which bugs are kept, defaults to C<''>
142 set_default(\%config,'web_host_bug_dir','');
144 =item web_domain $gWebDomain
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
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;
158 =item html_suffix $gHTMLSuffix
160 Suffix of html pages, defaults to .html
164 set_default(\%config,'html_suffix','.html');
166 =item cgi_domain $gCGIDomain
168 Full path of the web domain where cgi scripts are kept. Defaults to
169 the concatentation of L</web_domain> and cgi.
173 set_default(\%config,'cgi_domain',
174 sub {my $config = shift;
175 return $config->web_domain.($config->web_domain=~m{/$}?'':'/').'cgi'
178 =item mirrors @gMirrors
180 List of mirrors [What these mirrors are used for, no one knows.]
185 set_default(\%config,'mirrors',sub {[]});
187 =item package_pages $gPackagePages
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
197 set_default(\%config,'package_pages',undef);
199 =item package_tracking_domain $gPackageTrackingDomain
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
208 set_default(\%config,'package_tracking_domain',undef);
210 =item package_pages $gUsertagPackageDomain
212 Domain where where usertags of packages belong; defaults to $gPackagePages
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?://}{};
225 =item subscription_domain $gSubscriptionDomain
227 Domain where subscriptions to package lists happen
231 set_default(\%config,'subscription_domain',undef);
234 =item cc_all_mails_to_addr $gCcAllMailsToAddr
236 Address to Cc (well, Bcc) all e-mails to
240 set_default(\%config,'cc_all_mails_to_addr',undef);
243 =item cve_tracker $gCVETracker
245 URI to CVE security tracker; in bugreport.cgi, CVE-2001-0002 becomes
246 linked to $config->cve_trackerCVE-2001-002
248 Default: https://security-tracker.debian.org/tracker/
252 set_default(\%config,'cve_tracker','https://security-tracker.debian.org/tracker/');
260 =head2 Project Identification
264 =item project $gProject
272 set_default(\%config,'project','Something');
274 =item project_title $gProjectTitle
276 Name of this install of Debbugs, defaults to "L</project> Debbugs Install"
278 Default: "$config->project Debbugs Install"
282 set_default(\%config,'project_title',sub {$_[0]->project." Debbugs Install"});
284 =item maintainer $gMaintainer
286 Name of the maintainer of this debbugs install
288 Default: 'Local DebBugs Owner's
292 set_default(\%config,'maintainer','Local DebBugs Owner');
294 =item maintainer_webpage $gMaintainerWebpage
296 Webpage of the maintainer of this install of debbugs
298 Default: "$config->web_domain/~owner"
302 set_default(\%config,'maintainer_webpage',sub {$_[0]->web_domain."/~owner"});
304 =item maintainer_email $gMaintainerEmail
306 Email address of the maintainer of this Debbugs install
308 Default: 'root@'.$config->email_domain
312 set_default(\%config,'maintainer_email',sub {'root@'.$_[0]->email_domain});
314 =item unknown_maintainer_email
316 Email address where packages with an unknown maintainer will be sent
318 Default: $config->maintainer_email
322 set_default(\%config,'unknown_maintainer_email',sub {$_[0]->maintainer_email});
326 The name of the machine that this instance of debbugs is running on
327 (currently used for debbuging purposes and web page output.)
329 Default: Sys::Hostname::hostname()
335 set_default(\%config,'machine_name',sub {Sys::Hostname::hostname()});
337 =head2 BTS Mailing Lists
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');
376 =item bug_subscription_domain
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.
388 set_default(\%config,'bug_subscription_domain',sub {$_[0]->list_domain});
398 Name of the mailer to use
404 set_default(\%config,'mailer','exim');
413 Default: ucfirst($config->bug);
421 Default: ucfirst($config->ubugs);
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)});
432 Age at which bugs are archived/removed
438 set_default(\%config,'remove_age',28);
442 Whether old bugs are saved or deleted
448 set_default(\%config,'save_old_bugs',1);
450 =item distribution_aliases
452 Map of distribution aliases to the distribution name
455 {experimental => 'experimental',
456 unstable => 'unstable',
457 testing => 'testing',
459 oldstable => 'oldstable',
463 sarge => 'oldstable',
468 set_default(\%config,'distribution_aliases',
469 sub {{experimental => 'experimental',
470 unstable => 'unstable',
471 testing => 'testing',
473 oldstable => 'oldstable',
477 sarge => 'oldstable',
485 List of valid distributions
487 Default: The values of the distribution aliases map.
491 set_default(\%config,'distributions',
494 return [uniq keys %{$config->distribution_aliases}];
498 =item default_architectures
500 List of default architectures to use when architecture(s) are not
503 Default: i386 amd64 arm ppc sparc alpha
507 set_default(\%config,'default_architectures',
508 sub {[qw(i386 amd64 arm powerpc sparc alpha)]}
511 =item affects_distribution_tags
513 List of tags which restrict the buggy state to a set of distributions.
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
520 Setting this to [] will remove this feature.
522 Default: @{$config->distributions}
526 set_default(\%config,'affects_distribution_tags',
527 sub {return [@{$_[0]->distributions}]},
530 =item removal_unremovable_tags
532 Bugs which have these tags set cannot be archived
538 set_default(\%config,'removal_unremovable_tags',
542 =item removal_distribution_tags
544 Tags which specifiy distributions to check
546 Default: @{$config->distributions}
550 set_default(\%config,'removal_distribution_tags',
551 sub {[@{$_[0]->distributions}]});
553 =item removal_default_distribution_tags
555 For removal/archival purposes, all bugs are assumed to have these tags
558 Default: qw(experimental unstable testing);
562 set_default(\%config,'removal_default_distribution_tags',
563 sub {[qw(experimental unstable testing)]}
566 =item removal_strong_severity_default_distribution_tags
568 For removal/archival purposes, all bugs with strong severity are
569 assumed to have these tags set.
571 Default: qw(experimental unstable testing stable);
575 set_default(\%config,'removal_strong_severity_default_distribution_tags',
576 sub {[qw(experimental unstable testing stable)]}
580 =item removal_architectures
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.
587 Default: value of default_architectures
591 set_default(\%config,'removal_architectures',
592 sub {[@{$_[0]->default_architectures}]},
596 =item package_name_re
598 The regex which will match a package name
600 Default: '[a-z0-9][a-z0-9\.+-]+'
604 set_default(\%config,'package_name_re',
605 '[a-z0-9][a-z0-9\.+-]+');
607 =item package_version_re
609 The regex which will match a package version
611 Default: '[A-Za-z0-9:+\.-]+'
616 set_default(\%config,'package_version_re',
617 '[A-Za-z0-9:+\.~-]+');
620 =item default_package
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.
626 Defaults to unset, which is the traditional debbugs behavoir
630 set_default(\%config,'default_package',
635 =item control_internal_requester
637 This address is used by Debbugs::Control as the request address which
638 sent a control request for faked log messages.
640 Default:"Debbugs Internal Request <$config->maintainer_email>"
644 set_default(\%config,'control_internal_requester',
645 sub {"Debbugs Internal Request <".$_[0]->maintainer_email.">"},
648 =item control_internal_request_addr
650 This address is used by Debbugs::Control as the address to which a
651 faked log message request was sent.
653 Default: "internal_control\@$config->email_domain";
657 set_default(\%config,'control_internal_request_addr',
658 sub {'internal_control@'.$_[0]->email_domain},
662 =item exclude_from_control
664 Addresses which are not allowed to send messages to control
668 set_default(\%config,'exclude_from_control',sub {[]});
672 =item default_severity
674 The default severity of bugs which have no severity set
680 set_default(\%config,'default_severity','normal');
682 =item severity_display
684 A hashref of severities and the informative text which describes them.
688 {critical => "Critical $config->bugs",
689 grave => "Grave $config->bugs",
690 normal => "Normal $config->bugs",
691 wishlist => "Wishlist $config->bugs",
696 set_default(\%config,'severity_display',
700 for (@{$config->severity_list}) {
701 $s->{$_} = ucfirst($_). ' '. $config->bugs;
706 =item show_severities
708 A scalar list of the severities to show
710 Defaults to the concatenation of the keys of the severity_display
711 hashlist with ', ' above.
715 set_default(\%config,'show_severities',
719 @{$config->severity_list});
723 =item strong_severities
725 An arrayref of the serious severities which shoud be emphasized
727 Default: [qw(critical grave)]
731 set_default(\%config,'strong_severities',sub {[qw(critical grave)]});
735 An arrayref of a list of the severities
737 Defaults to the keys of the severity display hashref
741 set_default(\%config,'severity_list',
742 sub {[qw(critical grave serious important normal minor wishlist)]});
744 =item obsolete_severities
746 A hashref of obsolete severities with the replacing severity
752 set_default(\%config,'obsolete_severities',sub {{}});
756 An arrayref of the tags used
758 Default: [qw(patch wontfix moreinfo unreproducible fixed)] and also
759 includes the distributions.
763 set_default(\%config,'tags',
766 return [qw(patch wontfix moreinfo unreproducible fixed),
767 @{$config->distributions}
771 set_default(\%config,'tags_single_letter',
773 return {patch => '+',
776 unreproducible => 'R',
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');
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');
792 Directory which contains the usertags
794 Default: $config->spool_dir/user
798 set_default(\%config,'usertag_dir',
799 sub {$_[0]->spool_dir.'/user'});
800 set_default(\%config,'incoming_dir','incoming');
802 =item web_dir $gWebDir
804 Directory where base html files are kept. Should normally be the same
805 as the web server's document root.
807 Default: /var/lib/debbugs/www
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');
818 directory of templates; defaults to /usr/share/debbugs/templates.
822 set_default(\%config,'template_dir','/usr/share/debbugs/templates');
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'});
834 =item simple_versioning
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.
842 set_default(\%config,'simple_versioning',0);
845 =item version_packages_dir
847 Location where the version package information is kept; defaults to
848 spool_dir/../versions/pkg
852 set_default(\%config,'version_packages_dir',sub {$_[0]->spool_dir.'/../versions/pkg'});
854 =item version_time_index
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.
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' :
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.
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' :
885 =item binary_source_map
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.
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' :
900 =item source_binary_map
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.
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' :
917 set_default(\%config,'post_processall',sub {[]});
921 Sets the sendmail binary to execute; defaults to /usr/lib/sendmail
925 set_default(\%config,'sendmail','/usr/lib/sendmail');
927 =item sendmail_arguments
929 Default arguments to pass to sendmail. Defaults to C<qw(-oem -oi)>.
933 set_default(\%config,'sendmail_arguments',sub {[qw(-oem -oi)]});
937 Envelope from to use for sent messages. If not set, whatever sendmail picks is
942 set_default(\%config,'envelope_from',undef);
946 Whether or not spamscan is being used; defaults to 0 (not being used
950 set_default(\%config,'spam_scan',0);
952 =item spam_crossassassin_db
954 Location of the crosassassin database, defaults to
955 spool_dir/../CrossAssassinDb
959 set_default(\%config,'spam_crossassassin_db',
960 sub {$_[0]->spool_dir.'/../CrossAssassinDb'});
964 Maximum number of cross-posted messages
968 set_default(\%config,'spam_max_cross',6);
971 =item spam_spams_per_thread
973 Number of spams for each thread (on average). Defaults to 200
977 set_default(\%config,'spam_spams_per_thread',200);
979 =item spam_max_threads
981 Maximum number of threads to start. Defaults to 20
985 set_default(\%config,'spam_max_threads',20);
987 =item spam_keep_running
989 Maximum number of seconds to run without restarting. Defaults to 3600.
993 set_default(\%config,'spam_keep_running',3600);
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'
1002 set_default(\%config,'spam_mailbox',
1003 sub {$_[0]->spool_dir.'/../mail/spam/assassinated.%Y-%m-%d'});
1005 =item spam_crossassassin_mailbox
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'
1013 set_default(\%config,'spam_crossassassin_mailbox',
1014 sub {$_[0]->spool_dir.'/../mail/spam/crossassassinated.%Y-%m-%d'});
1016 =item spam_local_tests_only
1018 Whether only local tests are run, defaults to 0
1022 set_default(\%config,'spam_local_tests_only',0);
1024 =item spam_user_prefs
1026 User preferences for spamassassin, defaults to $ENV{HOME}/.spamassassin/user_prefs
1030 set_default(\%config,'spam_user_prefs',"$ENV{HOME}/.spamassassin/user_prefs");
1032 =item spam_rules_dir
1034 Site rules directory for spamassassin, defaults to
1035 '/usr/share/spamassassin'
1039 set_default(\%config,'spam_rules_dir','/usr/share/spamassassin');
1047 =item libravatar_uri $gLibravatarUri
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.
1055 set_default(\%config,'libravatar_uri',
1056 sub {$_[0]->cgi_domain.'/libravatar.cgi?email='});
1058 =item libravatar_uri_options $gLibravatarUriOptions
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
1065 Other options which make sense include ?d=404, ?d=wavatar, etc. See
1066 the API of libravatar for details.
1070 set_default(\%config,'libravatar_uri_options','');
1072 =item libravatar_default_image
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.]
1078 Default: $config->web_dir/1x1.png
1082 set_default(\%config,'libravatar_default_image',sub {$_[0]->web_dir.'/1x1.png'});
1084 =item libravatar_cache_dir
1086 Directory where cached libravatar images are stored
1088 Default: $config->web_dir/libravatar/
1092 set_default(\%config,'libravatar_cache_dir',sub {$_[0]->web_dir.'/libravatar/'});
1094 =item libravatar_blacklist
1096 Array of regular expressions to match against emails, domains, or
1097 images to only show the default image
1099 Default: empty array
1103 set_default(\%config,'libravatar_blacklist',sub {[]});
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">
1121 set_default(\%config,'database',undef);
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.
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.]
1137 =item bad_email_prefix
1139 This prefixes the text of all lines in a bad e-mail message ack.
1143 set_default(\%config,'bad_email_prefix','');
1146 =item text_instructions
1148 This gives more information about bad e-mails to receive.in
1152 set_default(\%config,'text_instructions',sub {$_[0]->bad_email_prefix});
1156 This shows up at the end of (most) html pages
1158 In many pages this has been replaced by the html/tail template.
1162 set_default(\%config,'html_tail',sub {
1164 my $a = <<END; return $a; });
1165 <ADDRESS>@{[$config->maintainer]} <<A HREF=\"mailto:@{[$config->maintainer_email]}\">@{[$config->maintainer_email]}</A>>.
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.
1180 =item html_expire_note
1182 This message explains what happens to archive/remove-able bugs
1186 set_default(\%config,'html_expire_note',
1189 return "(Closed ".$config->bugs." are archived ".
1190 $config->remove_age.
1191 " days after the last related message is received.)"
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;
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";
1217 die "Version $version configuration files are not supported";
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) {{
1238 if ($glob_type eq '%') {
1239 $value = {%{*{$var_glob}}} if defined *{$var_glob}{HASH};
1241 elsif ($glob_type eq '@') {
1242 $value = [@{*{$var_glob}}] if defined *{$var_glob}{ARRAY};
1245 $value = ${*{$var_glob}};
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;
1257 my ($variable) = @_;
1258 my $hash_name = $variable;
1259 $hash_name =~ s/^([\$\%\@])g//;
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);
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.
1276 my ($config,$option,$value) = @_;
1281 ref($value) eq 'CODE' ?
1282 (builder => $value):
1293 my ($config,$option,$value) = @_;
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;
1301 my $m = $config->meta->find_method_by_name($option);
1302 if (not defined $m) {
1303 croak "Not a valid option $option";
1305 $m->($config,$value);
1306 # update the configuration value
1307 if (not $USING_GLOBALS and not exists $config->{$option}) {
1308 $config->{$option} = $value;
1310 elsif ($USING_GLOBALS) {{
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}"});
1317 $m->($config,$value);
1320 if ($USING_GLOBALS) {{
1322 *{"Debbugs::Config::${varname}"} = $m->($config);
1326 __PACKAGE__->meta->make_immutable();
1329 our $config = __PACKAGE__->new();
1336 my ($this,$key) = @_;
1337 my $m = $config->meta->find_method_by_name($key);
1338 croak "No such element $key" if not defined $m;
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);
1350 my ($this,$key) = @_;
1351 my $m = $config->meta->find_method_by_name($key);
1364 return "Debbugs::Config(HASH)"
1376 tie %config,__PACKAGE__;
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
1384 # if (${[stat($ENV{DEBBUGS_CONFIG_FILE})]}[4] == $<) {
1385 $ENV{DEBBUGS_CONFIG_FILE} =~ /(.+)/;
1386 $ENV{DEBBUGS_CONFIG_FILE} = $1;
1389 # die "Environmental variable DEBBUGS_CONFIG_FILE set, and $ENV{DEBBUGS_CONFIG_FILE} is not owned by the user running this script.";
1392 read_config($config,exists $ENV{DEBBUGS_CONFIG_FILE}?$ENV{DEBBUGS_CONFIG_FILE}:'/etc/debbugs/config');
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.
1406 if (grep /^:(?:text|globals)$/, @_) {
1408 for my $variable (map {@$_} @EXPORT_TAGS{map{(/^:(text|globals)$/?($1):())} @_}) {
1409 my $tmp = $variable;
1411 # Yes, I don't care if these are only used once
1413 # No, it doesn't bother me that I'm assigning an undefined value to a typeglob
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};
1420 Debbugs::Config->export_to_level(1,@_);