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.
36 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT $USING_GLOBALS %config);
37 use base qw(Exporter);
40 # set the version for version checking
42 $DEBUG = 0 unless defined $DEBUG;
46 %EXPORT_TAGS = (globals => [qw($gEmailDomain $gListDomain $gWebHost $gWebHostBugDir),
47 qw($gWebDomain $gHTMLSuffix $gCGIDomain $gMirrors),
48 qw($gPackagePages $gSubscriptionDomain $gProject $gProjectTitle),
49 qw($gMaintainer $gMaintainerWebpage $gMaintainerEmail $gUnknownMaintainerEmail),
50 qw($gSubmitList $gMaintList $gQuietList $gForwardList),
51 qw($gDoneList $gRequestList $gSubmitterList $gControlList),
53 qw($gBugSubscriptionDomain),
54 qw($gPackageVersionRe),
55 qw($gSummaryList $gMirrorList $gMailer $gBug),
56 qw($gBugs $gRemoveAge $gSaveOldBugs $gDefaultSeverity),
57 qw($gShowSeverities $gBounceFroms $gConfigDir $gSpoolDir),
58 qw($gIncomingDir $gWebDir $gDocDir $gMaintainerFile),
59 qw($gMaintainerFileOverride $gPseudoMaintFile $gPseudoDescFile $gPackageSource),
60 qw($gVersionPackagesDir $gVersionIndex $gBinarySourceMap $gSourceBinaryMap),
61 qw($gVersionTimeIndex),
62 qw($gSimpleVersioning),
64 qw($gSendmail @gSendmailArguments $gLibPath $gSpamScan @gExcludeFromControl),
65 qw(%gSeverityDisplay @gTags @gSeverityList @gStrongSeverities),
66 qw(%gTagsSingleLetter),
68 qw(%gDistributionAliases),
69 qw(%gObsoleteSeverities),
70 qw(@gPostProcessall @gRemovalDefaultDistributionTags @gRemovalDistributionTags @gRemovalArchitectures),
71 qw(@gRemovalStrongSeverityDefaultDistributionTags),
72 qw(@gAffectsDistributionTags),
73 qw(@gDefaultArchitectures),
77 qw($gSpamMaxThreads $gSpamSpamsPerThread $gSpamKeepRunning $gSpamScan $gSpamCrossassassinDb),
80 text => [qw($gBadEmailPrefix $gHTMLTail $gHTMLExpireNote),
82 cgi => [qw($gLibravatarUri $gLibravatarCacheDir $gLibravatarUriOptions @gLibravatarBlacklist)],
83 config => [qw(%config)],
86 Exporter::export_ok_tags(keys %EXPORT_TAGS);
87 $EXPORT_TAGS{all} = [@EXPORT_OK];
88 $ENV{HOME} = '' if not defined $ENV{HOME};
91 use File::Basename qw(dirname);
95 =head1 CONFIGURATION VARIABLES
97 =head2 General Configuration
105 # untaint $ENV{DEBBUGS_CONFIG_FILE} if it's owned by us
106 # This enables us to test things that are -T.
107 if (exists $ENV{DEBBUGS_CONFIG_FILE}) {
108 # This causes all sorts of problems for mirrors of debbugs; disable
110 # if (${[stat($ENV{DEBBUGS_CONFIG_FILE})]}[4] == $<) {
111 $ENV{DEBBUGS_CONFIG_FILE} =~ /(.+)/;
112 $ENV{DEBBUGS_CONFIG_FILE} = $1;
115 # die "Environmental variable DEBBUGS_CONFIG_FILE set, and $ENV{DEBBUGS_CONFIG_FILE} is not owned by the user running this script.";
118 read_config(exists $ENV{DEBBUGS_CONFIG_FILE}?$ENV{DEBBUGS_CONFIG_FILE}:'/etc/debbugs/config');
120 =item email_domain $gEmailDomain
122 The email domain of the bts
126 set_default(\%config,'email_domain','bugs.something');
128 =item list_domain $gListDomain
130 The list domain of the bts, defaults to the email domain
134 set_default(\%config,'list_domain',$config{email_domain});
136 =item web_host $gWebHost
138 The web host of the bts; defaults to the email domain
142 set_default(\%config,'web_host',$config{email_domain});
144 =item web_host_bug_dir $gWebHostDir
146 The directory of the web host on which bugs are kept, defaults to C<''>
150 set_default(\%config,'web_host_bug_dir','');
152 =item web_domain $gWebDomain
154 Full path of the web domain where bugs are kept, defaults to the
155 concatenation of L</web_host> and L</web_host_bug_dir>
159 set_default(\%config,'web_domain',$config{web_host}.($config{web_host}=~m{/$}?'':'/').$config{web_host_bug_dir});
161 =item html_suffix $gHTMLSuffix
163 Suffix of html pages, defaults to .html
167 set_default(\%config,'html_suffix','.html');
169 =item cgi_domain $gCGIDomain
171 Full path of the web domain where cgi scripts are kept. Defaults to
172 the concatentation of L</web_host> and cgi.
176 set_default(\%config,'cgi_domain',$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',[]);
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
191 package links will not be made.
196 set_default(\%config,'package_pages',undef);
198 =item package_pages $gUsertagPackageDomain
200 Domain where where usertags of packages belong; defaults to $gPackagePages
204 set_default(\%config,'usertag_package_domain',$config{package_pages});
207 =item subscription_domain $gSubscriptionDomain
209 Domain where subscriptions to package lists happen
213 set_default(\%config,'subscription_domain',undef);
216 =item cve_tracker $gCVETracker
218 URI to CVE security tracker; in bugreport.cgi, CVE-2001-0002 becomes
219 linked to http://$config{cve_tracker}CVE-2001-002
221 Default: security-tracker.debian.org/tracker/
225 set_default(\%config,'cve_tracker','security-tracker.debian.org/tracker/');
233 =head2 Project Identification
237 =item project $gProject
245 set_default(\%config,'project','Something');
247 =item project_title $gProjectTitle
249 Name of this install of Debbugs, defaults to "L</project> Debbugs Install"
251 Default: "$config{project} Debbugs Install"
255 set_default(\%config,'project_title',"$config{project} Debbugs Install");
257 =item maintainer $gMaintainer
259 Name of the maintainer of this debbugs install
261 Default: 'Local DebBugs Owner's
265 set_default(\%config,'maintainer','Local DebBugs Owner');
267 =item maintainer_webpage $gMaintainerWebpage
269 Webpage of the maintainer of this install of debbugs
271 Default: "$config{web_domain}/~owner"
275 set_default(\%config,'maintainer_webpage',"$config{web_domain}/~owner");
277 =item maintainer_email $gMaintainerEmail
279 Email address of the maintainer of this Debbugs install
281 Default: 'root@'.$config{email_domain}
285 set_default(\%config,'maintainer_email','root@'.$config{email_domain});
287 =item unknown_maintainer_email
289 Email address where packages with an unknown maintainer will be sent
291 Default: $config{maintainer_email}
295 set_default(\%config,'unknown_maintainer_email',$config{maintainer_email});
299 The name of the machine that this instance of debbugs is running on
300 (currently used for debbuging purposes and web page output.)
302 Default: qx(hostname --fqdn)
308 my $_old_path = $ENV{PATH};
309 $ENV{PATH} = '/bin:/usr/bin:/usr/local/bin';
310 my $temp_hostname = qx(hostname --fqdn);
311 chomp $temp_hostname;
312 set_default(\%config,'machine_name',$temp_hostname);
313 $ENV{PATH} = $_old_path;
315 =head2 BTS Mailing Lists
342 set_default(\%config, 'submit_list', 'bug-submit-list');
343 set_default(\%config, 'maint_list', 'bug-maint-list');
344 set_default(\%config, 'quiet_list', 'bug-quiet-list');
345 set_default(\%config, 'forward_list', 'bug-forward-list');
346 set_default(\%config, 'done_list', 'bug-done-list');
347 set_default(\%config, 'request_list', 'bug-request-list');
348 set_default(\%config,'submitter_list','bug-submitter-list');
349 set_default(\%config, 'control_list', 'bug-control-list');
350 set_default(\%config, 'summary_list', 'bug-summary-list');
351 set_default(\%config, 'mirror_list', 'bug-mirror-list');
352 set_default(\%config, 'strong_list', 'bug-strong-list');
354 =item bug_subscription_domain
356 Domain of list for messages regarding a single bug; prefixed with
357 bug=${bugnum}@ when bugs are actually sent out. Set to undef or '' to
358 disable sending messages to the bug subscription list.
366 set_default(\%config,'bug_subscription_domain',$config{list_domain});
376 Name of the mailer to use
382 set_default(\%config,'mailer','exim');
391 Default: ucfirst($config{bug});
399 Default: ucfirst($config{ubugs});
403 set_default(\%config,'bug','bug');
404 set_default(\%config,'ubug',ucfirst($config{bug}));
405 set_default(\%config,'bugs','bugs');
406 set_default(\%config,'ubugs',ucfirst($config{bugs}));
410 Age at which bugs are archived/removed
416 set_default(\%config,'remove_age',28);
420 Whether old bugs are saved or deleted
426 set_default(\%config,'save_old_bugs',1);
428 =item distribution_aliases
430 Map of distribution aliases to the distribution name
433 {experimental => 'experimental',
434 unstable => 'unstable',
435 testing => 'testing',
437 oldstable => 'oldstable',
441 sarge => 'oldstable',
446 set_default(\%config,'distribution_aliases',
447 {experimental => 'experimental',
448 unstable => 'unstable',
449 testing => 'testing',
451 oldstable => 'oldstable',
455 sarge => 'oldstable',
463 List of valid distributions
465 Default: The values of the distribution aliases map.
469 my %_distributions_default;
470 @_distributions_default{values %{$config{distribution_aliases}}} = values %{$config{distribution_aliases}};
471 set_default(\%config,'distributions',[keys %_distributions_default]);
474 =item default_architectures
476 List of default architectures to use when architecture(s) are not
479 Default: i386 amd64 arm ppc sparc alpha
483 set_default(\%config,'default_architectures',
484 [qw(i386 amd64 arm powerpc sparc alpha)]
487 =item affects_distribution_tags
489 List of tags which restrict the buggy state to a set of distributions.
491 The set of distributions that are buggy is the intersection of the set
492 of distributions that would be buggy without reference to these tags
493 and the set of these tags that are distributions which are set on a
496 Setting this to [] will remove this feature.
498 Default: @{$config{distributions}}
502 set_default(\%config,'affects_distribution_tags',
503 [@{$config{distributions}}],
506 =item removal_unremovable_tags
508 Bugs which have these tags set cannot be archived
514 set_default(\%config,'removal_unremovable_tags',
518 =item removal_distribution_tags
520 Tags which specifiy distributions to check
522 Default: @{$config{distributions}}
526 set_default(\%config,'removal_distribution_tags',
527 [@{$config{distributions}}]);
529 =item removal_default_distribution_tags
531 For removal/archival purposes, all bugs are assumed to have these tags
534 Default: qw(unstable testing);
538 set_default(\%config,'removal_default_distribution_tags',
539 [qw(unstable testing)]
542 =item removal_strong_severity_default_distribution_tags
544 For removal/archival purposes, all bugs with strong severity are
545 assumed to have these tags set.
547 Default: qw(unstable testing stable);
551 set_default(\%config,'removal_strong_severity_default_distribution_tags',
552 [qw(unstable testing stable)]
556 =item removal_architectures
558 For removal/archival purposes, these architectures are consulted if
559 there is more than one architecture applicable. If the bug is in a
560 package not in any of these architectures, the architecture actually
561 checked is undefined.
563 Default: value of default_architectures
567 set_default(\%config,'removal_architectures',
568 $config{default_architectures},
572 =item package_name_re
574 The regex which will match a package name
576 Default: '[a-z0-9][a-z0-9\.+-]+'
580 set_default(\%config,'package_name_re',
581 '[a-z0-9][a-z0-9\.+-]+');
583 =item package_version_re
585 The regex which will match a package version
587 Default: '[A-Za-z0-9:+\.-]+'
592 set_default(\%config,'package_version_re',
593 '[A-Za-z0-9:+\.~-]+');
596 =item default_package
598 This is the name of the default package. If set, bugs assigned to
599 packages without a maintainer and bugs missing a Package: psuedoheader
600 will be assigned to this package instead.
602 Defaults to unset, which is the traditional debbugs behavoir
606 set_default(\%config,'default_package',
611 =item control_internal_requester
613 This address is used by Debbugs::Control as the request address which
614 sent a control request for faked log messages.
616 Default:"Debbugs Internal Request <$config{maintainer_email}>"
620 set_default(\%config,'control_internal_requester',
621 "Debbugs Internal Request <$config{maintainer_email}>",
624 =item control_internal_request_addr
626 This address is used by Debbugs::Control as the address to which a
627 faked log message request was sent.
629 Default: "internal_control\@$config{email_domain}";
633 set_default(\%config,'control_internal_request_addr',
634 'internal_control@'.$config{email_domain},
638 =item exclude_from_control
640 Addresses which are not allowed to send messages to control
644 set_default(\%config,'exclude_from_control',[]);
648 =item default_severity
650 The default severity of bugs which have no severity set
656 set_default(\%config,'default_severity','normal');
658 =item severity_display
660 A hashref of severities and the informative text which describes them.
664 {critical => "Critical $config{bugs}",
665 grave => "Grave $config{bugs}",
666 normal => "Normal $config{bugs}",
667 wishlist => "Wishlist $config{bugs}",
672 set_default(\%config,'severity_display',{critical => "Critical $config{bugs}",
673 grave => "Grave $config{bugs}",
674 serious => "Serious $config{bugs}",
675 important=> "Important $config{bugs}",
676 normal => "Normal $config{bugs}",
677 minor => "Minor $config{bugs}",
678 wishlist => "Wishlist $config{bugs}",
681 =item show_severities
683 A scalar list of the severities to show
685 Defaults to the concatenation of the keys of the severity_display
686 hashlist with ', ' above.
690 set_default(\%config,'show_severities',join(', ',keys %{$config{severity_display}}));
692 =item strong_severities
694 An arrayref of the serious severities which shoud be emphasized
696 Default: [qw(critical grave)]
700 set_default(\%config,'strong_severities',[qw(critical grave)]);
704 An arrayref of a list of the severities
706 Defaults to the keys of the severity display hashref
710 set_default(\%config,'severity_list',[keys %{$config{severity_display}}]);
712 =item obsolete_severities
714 A hashref of obsolete severities with the replacing severity
720 set_default(\%config,'obsolete_severities',{});
724 An arrayref of the tags used
726 Default: [qw(patch wontfix moreinfo unreproducible fixed)] and also
727 includes the distributions.
731 set_default(\%config,'tags',[qw(patch wontfix moreinfo unreproducible fixed),
732 @{$config{distributions}}
735 set_default(\%config,'tags_single_letter',
739 unreproducible => 'R',
744 set_default(\%config,'bounce_froms','^mailer|^da?emon|^post.*mast|^root|^wpuser|^mmdf|^smt.*|'.
745 '^mrgate|^vmmail|^mail.*system|^uucp|-maiser-|^mal\@|'.
746 '^mail.*agent|^tcpmail|^bitmail|^mailman');
748 set_default(\%config,'config_dir',dirname(exists $ENV{DEBBUGS_CONFIG_FILE}?$ENV{DEBBUGS_CONFIG_FILE}:'/etc/debbugs/config'));
749 set_default(\%config,'spool_dir','/var/lib/debbugs/spool');
753 Directory which contains the usertags
755 Default: $config{spool_dir}/user
759 set_default(\%config,'usertag_dir',$config{spool_dir}.'/user');
760 set_default(\%config,'incoming_dir','incoming');
762 =item web_dir $gWebDir
764 Directory where base html files are kept. Should normally be the same
765 as the web server's document root.
767 Default: /var/lib/debbugs/www
771 set_default(\%config,'web_dir','/var/lib/debbugs/www');
772 set_default(\%config,'doc_dir','/var/lib/debbugs/www/txt');
773 set_default(\%config,'lib_path','/usr/lib/debbugs');
778 directory of templates; defaults to /usr/share/debbugs/templates.
782 set_default(\%config,'template_dir','/usr/share/debbugs/templates');
785 set_default(\%config,'maintainer_file',$config{config_dir}.'/Maintainers');
786 set_default(\%config,'maintainer_file_override',$config{config_dir}.'/Maintainers.override');
787 set_default(\%config,'source_maintainer_file',$config{config_dir}.'/Source_maintainers');
788 set_default(\%config,'source_maintainer_file_override',undef);
789 set_default(\%config,'pseudo_maint_file',$config{config_dir}.'/pseudo-packages.maintainers');
790 set_default(\%config,'pseudo_desc_file',$config{config_dir}.'/pseudo-packages.description');
791 set_default(\%config,'package_source',$config{config_dir}.'/indices/sources');
794 =item simple_versioning
796 If true this causes debbugs to ignore version information and just
797 look at whether a bug is done or not done. Primarily of interest for
798 debbugs installs which don't track versions. defaults to false.
802 set_default(\%config,'simple_versioning',0);
805 =item version_packages_dir
807 Location where the version package information is kept; defaults to
808 spool_dir/../versions/pkg
812 set_default(\%config,'version_packages_dir',$config{spool_dir}.'/../versions/pkg');
814 =item version_time_index
816 Location of the version/time index file. Defaults to
817 spool_dir/../versions/idx/versions_time.idx if spool_dir/../versions
818 exists; otherwise defaults to undef.
823 set_default(\%config,'version_time_index', -d $config{spool_dir}.'/../versions' ? $config{spool_dir}.'/../versions/indices/versions_time.idx' : undef);
827 Location of the version index file. Defaults to
828 spool_dir/../versions/indices/versions.idx if spool_dir/../versions
829 exists; otherwise defaults to undef.
833 set_default(\%config,'version_index',-d $config{spool_dir}.'/../versions' ? $config{spool_dir}.'/../versions/indices/versions.idx' : undef);
835 =item binary_source_map
837 Location of the binary -> source map. Defaults to
838 spool_dir/../versions/indices/bin2src.idx if spool_dir/../versions
839 exists; otherwise defaults to undef.
843 set_default(\%config,'binary_source_map',-d $config{spool_dir}.'/../versions' ? $config{spool_dir}.'/../versions/indices/binsrc.idx' : undef);
845 =item source_binary_map
847 Location of the source -> binary map. Defaults to
848 spool_dir/../versions/indices/src2bin.idx if spool_dir/../versions
849 exists; otherwise defaults to undef.
853 set_default(\%config,'source_binary_map',-d $config{spool_dir}.'/../versions' ? $config{spool_dir}.'/../versions/indices/srcbin.idx' : undef);
857 set_default(\%config,'post_processall',[]);
861 Sets the sendmail binary to execute; defaults to /usr/lib/sendmail
865 set_default(\%config,'sendmail','/usr/lib/sendmail');
867 =item sendmail_arguments
869 Default arguments to pass to sendmail. Defaults to C<qw(-oem -oi)>.
873 set_default(\%config,'sendmail_arguments',[qw(-oem -oi)]);
877 Whether or not spamscan is being used; defaults to 0 (not being used
881 set_default(\%config,'spam_scan',0);
883 =item spam_crossassassin_db
885 Location of the crosassassin database, defaults to
886 spool_dir/../CrossAssassinDb
890 set_default(\%config,'spam_crossassassin_db',$config{spool_dir}.'/../CrossAssassinDb');
894 Maximum number of cross-posted messages
898 set_default(\%config,'spam_max_cross',6);
901 =item spam_spams_per_thread
903 Number of spams for each thread (on average). Defaults to 200
907 set_default(\%config,'spam_spams_per_thread',200);
909 =item spam_max_threads
911 Maximum number of threads to start. Defaults to 20
915 set_default(\%config,'spam_max_threads',20);
917 =item spam_keep_running
919 Maximum number of seconds to run without restarting. Defaults to 3600.
923 set_default(\%config,'spam_keep_running',3600);
927 Location to store spam messages; is run through strftime to allow for
928 %d,%m,%Y, et al. Defaults to 'spool_dir/../mail/spam/assassinated.%Y-%m-%d'
932 set_default(\%config,'spam_mailbox',$config{spool_dir}.'/../mail/spam/assassinated.%Y-%m-%d');
934 =item spam_crossassassin_mailbox
936 Location to store crossassassinated messages; is run through strftime
937 to allow for %d,%m,%Y, et al. Defaults to
938 'spool_dir/../mail/spam/crossassassinated.%Y-%m-%d'
942 set_default(\%config,'spam_crossassassin_mailbox',$config{spool_dir}.'/../mail/spam/crossassassinated.%Y-%m-%d');
944 =item spam_local_tests_only
946 Whether only local tests are run, defaults to 0
950 set_default(\%config,'spam_local_tests_only',0);
952 =item spam_user_prefs
954 User preferences for spamassassin, defaults to $ENV{HOME}/.spamassassin/user_prefs
958 set_default(\%config,'spam_user_prefs',"$ENV{HOME}/.spamassassin/user_prefs");
962 Site rules directory for spamassassin, defaults to
963 '/usr/share/spamassassin'
967 set_default(\%config,'spam_rules_dir','/usr/share/spamassassin');
975 =item libravatar_uri $gLibravatarUri
977 URI to a libravatar configuration. If empty or undefined, libravatar
978 support will be disabled. Defaults to
979 libravatar.cgi, our internal federated libravatar system.
983 set_default(\%config,'libravatar_uri',$config{cgi_domain}.'/libravatar.cgi?email=');
985 =item libravatar_uri_options $gLibravatarUriOptions
987 Options to append to the md5_hex of the e-mail. This sets the default
988 avatar used when an avatar isn't available. Currently defaults to
989 '?d=retro', which causes a bitmap-looking avatar to be displayed for
992 Other options which make sense include ?d=404, ?d=wavatar, etc. See
993 the API of libravatar for details.
997 set_default(\%config,'libravatar_uri_options','');
999 =item libravatar_default_image
1001 Default image to serve for libravatar if there is no avatar for an
1002 e-mail address. By default, this is a 1x1 png. [This will also be the
1003 image served if someone specifies avatar=no.]
1005 Default: $config{web_dir}/1x1.png
1009 set_default(\%config,'libravatar_default_image',$config{web_dir}.'/1x1.png');
1011 =item libravatar_cache_dir
1013 Directory where cached libravatar images are stored
1015 Default: $config{web_dir}/libravatar/
1019 set_default(\%config,'libravatar_cache_dir',$config{web_dir}.'/libravatar/');
1021 =item libravatar_blacklist
1023 Array of regular expressions to match against emails, domains, or
1024 images to only show the default image
1026 Default: empty array
1030 set_default(\%config,'libravatar_blacklist',[]);
1040 Name of debbugs PostgreSQL database service
1044 set_default(\%config,'debbugs_db',undef);
1048 The following are the only text fields in general use in the scripts;
1049 a few additional text fields are defined in text.in, but are only used
1050 in db2html and a few other specialty scripts.
1052 Earlier versions of debbugs defined these values in /etc/debbugs/text,
1053 but now they are required to be in the configuration file. [Eventually
1054 the longer ones will move out into a fully fledged template system.]
1060 =item bad_email_prefix
1062 This prefixes the text of all lines in a bad e-mail message ack.
1066 set_default(\%config,'bad_email_prefix','');
1069 =item text_instructions
1071 This gives more information about bad e-mails to receive.in
1075 set_default(\%config,'text_instructions',$config{bad_email_prefix});
1079 This shows up at the end of (most) html pages
1081 In many pages this has been replaced by the html/tail template.
1085 set_default(\%config,'html_tail',<<END);
1086 <ADDRESS>$config{maintainer} <<A HREF=\"mailto:$config{maintainer_email}\">$config{maintainer_email}</A>>.
1092 <A HREF=\"http://$config{web_domain}/\">Debian $config{bug} tracking system</A><BR>
1093 Copyright (C) 1999 Darren O. Benham,
1094 1997,2003 nCipher Corporation Ltd,
1095 1994-97 Ian Jackson.
1100 =item html_expire_note
1102 This message explains what happens to archive/remove-able bugs
1106 set_default(\%config,'html_expire_note',
1107 "(Closed $config{bugs} are archived $config{remove_age} days after the last related message is received.)");
1115 my ($conf_file) = @_;
1116 if (not -e $conf_file) {
1117 print STDERR "configuration file '$conf_file' doesn't exist; skipping it\n" if $DEBUG;
1120 # first, figure out what type of file we're reading in.
1121 my $fh = new IO::File $conf_file,'r'
1122 or die "Unable to open configuration file $conf_file for reading: $!";
1123 # A new version configuration file must have a comment as its first line
1124 my $first_line = <$fh>;
1125 my ($version) = defined $first_line?$first_line =~ /VERSION:\s*(\d+)/i:undef;
1126 if (defined $version) {
1127 if ($version == 1) {
1128 # Do something here;
1129 die "Version 1 configuration files not implemented yet";
1132 die "Version $version configuration files are not supported";
1136 # Ugh. Old configuration file
1137 # What we do here is we create a new Safe compartment
1138 # so fucked up crap in the config file doesn't sink us.
1139 my $cpt = new Safe or die "Unable to create safe compartment";
1140 # perldoc Opcode; for details
1141 $cpt->permit('require',':filesys_read','entereval','caller','pack','unpack','dofile');
1142 $cpt->reval(qq(require '$conf_file';));
1143 die "Error in configuration file: $@" if $@;
1144 # Now what we do is check out the contents of %EXPORT_TAGS to see exactly which variables
1145 # we want to glob in from the configuration file
1146 for my $variable (map {$_ =~ /^(?:config|all)$/ ? () : @{$EXPORT_TAGS{$_}}} keys %EXPORT_TAGS) {
1147 my ($hash_name,$glob_name,$glob_type) = __convert_name($variable);
1148 my $var_glob = $cpt->varglob($glob_name);
1149 my $value; #= $cpt->reval("return $variable");
1150 # print STDERR "$variable $value",qq(\n);
1151 if (defined $var_glob) {{
1153 if ($glob_type eq '%') {
1154 $value = {%{*{$var_glob}}} if defined *{$var_glob}{HASH};
1156 elsif ($glob_type eq '@') {
1157 $value = [@{*{$var_glob}}] if defined *{$var_glob}{ARRAY};
1160 $value = ${*{$var_glob}};
1162 # We punt here, because we can't tell if the value was
1163 # defined intentionally, or if it was just left alone;
1164 # this tries to set sane defaults.
1165 set_default(\%config,$hash_name,$value) if defined $value;
1172 my ($variable) = @_;
1173 my $hash_name = $variable;
1174 $hash_name =~ s/^([\$\%\@])g//;
1176 my $glob_name = 'g'.$hash_name;
1177 $hash_name =~ s/(HTML|CGI|CVE)/ucfirst(lc($1))/ge;
1178 $hash_name =~ s/^([A-Z]+)/lc($1)/e;
1179 $hash_name =~ s/([A-Z]+)/'_'.lc($1)/ge;
1180 return $hash_name unless wantarray;
1181 return ($hash_name,$glob_name,$glob_type);
1186 # sets the configuration hash to the default value if it's not set,
1187 # otherwise doesn't do anything
1188 # If $USING_GLOBALS, then sets an appropriate global.
1191 my ($config,$option,$value) = @_;
1193 if ($USING_GLOBALS) {
1194 # fix up the variable name
1195 $varname = 'g'.join('',map {ucfirst $_} split /_/, $option);
1196 # Fix stupid HTML names
1197 $varname =~ s/(Html|Cgi)/uc($1)/ge;
1199 # update the configuration value
1200 if (not $USING_GLOBALS and not exists $config->{$option}) {
1201 $config->{$option} = $value;
1203 elsif ($USING_GLOBALS) {{
1205 # Need to check if a value has already been set in a global
1206 if (defined *{"Debbugs::Config::${varname}"}) {
1207 $config->{$option} = *{"Debbugs::Config::${varname}"};
1210 $config->{$option} = $value;
1213 if ($USING_GLOBALS) {{
1215 *{"Debbugs::Config::${varname}"} = $config->{$option};
1222 # All we care about here is whether we've been called with the globals or text option;
1223 # if so, then we need to export some symbols back up.
1224 # In any event, we call exporter.
1227 if (grep /^:(?:text|globals)$/, @_) {
1229 for my $variable (map {@$_} @EXPORT_TAGS{map{(/^:(text|globals)$/?($1):())} @_}) {
1230 my $tmp = $variable;
1232 # Yes, I don't care if these are only used once
1234 # No, it doesn't bother me that I'm assigning an undefined value to a typeglob
1236 my ($hash_name,$glob_name,$glob_type) = __convert_name($variable);
1237 $tmp =~ s/^[\%\$\@]//;
1238 *{"Debbugs::Config::${tmp}"} = ref($config{$hash_name})?$config{$hash_name}:\$config{$hash_name};
1241 Debbugs::Config->export_to_level(1,@_);