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),
79 text => [qw($gBadEmailPrefix $gHTMLTail $gHTMLExpireNote),
81 cgi => [qw($gLibravatarUri $gLibravatarCacheDir $gLibravatarUriOptions @gLibravatarBlacklist)],
82 config => [qw(%config)],
85 Exporter::export_ok_tags(keys %EXPORT_TAGS);
86 $EXPORT_TAGS{all} = [@EXPORT_OK];
87 $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 cc_all_mails_to_addr $gCcAllMailsToAddr
218 Address to Cc (well, Bcc) all e-mails to
222 set_default(\%config,'cc_all_mails_to_addr',undef);
225 =item cve_tracker $gCVETracker
227 URI to CVE security tracker; in bugreport.cgi, CVE-2001-0002 becomes
228 linked to http://$config{cve_tracker}CVE-2001-002
230 Default: security-tracker.debian.org/tracker/
234 set_default(\%config,'cve_tracker','security-tracker.debian.org/tracker/');
242 =head2 Project Identification
246 =item project $gProject
254 set_default(\%config,'project','Something');
256 =item project_title $gProjectTitle
258 Name of this install of Debbugs, defaults to "L</project> Debbugs Install"
260 Default: "$config{project} Debbugs Install"
264 set_default(\%config,'project_title',"$config{project} Debbugs Install");
266 =item maintainer $gMaintainer
268 Name of the maintainer of this debbugs install
270 Default: 'Local DebBugs Owner's
274 set_default(\%config,'maintainer','Local DebBugs Owner');
276 =item maintainer_webpage $gMaintainerWebpage
278 Webpage of the maintainer of this install of debbugs
280 Default: "$config{web_domain}/~owner"
284 set_default(\%config,'maintainer_webpage',"$config{web_domain}/~owner");
286 =item maintainer_email $gMaintainerEmail
288 Email address of the maintainer of this Debbugs install
290 Default: 'root@'.$config{email_domain}
294 set_default(\%config,'maintainer_email','root@'.$config{email_domain});
296 =item unknown_maintainer_email
298 Email address where packages with an unknown maintainer will be sent
300 Default: $config{maintainer_email}
304 set_default(\%config,'unknown_maintainer_email',$config{maintainer_email});
308 The name of the machine that this instance of debbugs is running on
309 (currently used for debbuging purposes and web page output.)
311 Default: Sys::Hostname::hostname()
317 set_default(\%config,'machine_name',Sys::Hostname::hostname());
319 =head2 BTS Mailing Lists
346 set_default(\%config, 'submit_list', 'bug-submit-list');
347 set_default(\%config, 'maint_list', 'bug-maint-list');
348 set_default(\%config, 'quiet_list', 'bug-quiet-list');
349 set_default(\%config, 'forward_list', 'bug-forward-list');
350 set_default(\%config, 'done_list', 'bug-done-list');
351 set_default(\%config, 'request_list', 'bug-request-list');
352 set_default(\%config,'submitter_list','bug-submitter-list');
353 set_default(\%config, 'control_list', 'bug-control-list');
354 set_default(\%config, 'summary_list', 'bug-summary-list');
355 set_default(\%config, 'mirror_list', 'bug-mirror-list');
356 set_default(\%config, 'strong_list', 'bug-strong-list');
358 =item bug_subscription_domain
360 Domain of list for messages regarding a single bug; prefixed with
361 bug=${bugnum}@ when bugs are actually sent out. Set to undef or '' to
362 disable sending messages to the bug subscription list.
370 set_default(\%config,'bug_subscription_domain',$config{list_domain});
380 Name of the mailer to use
386 set_default(\%config,'mailer','exim');
395 Default: ucfirst($config{bug});
403 Default: ucfirst($config{ubugs});
407 set_default(\%config,'bug','bug');
408 set_default(\%config,'ubug',ucfirst($config{bug}));
409 set_default(\%config,'bugs','bugs');
410 set_default(\%config,'ubugs',ucfirst($config{bugs}));
414 Age at which bugs are archived/removed
420 set_default(\%config,'remove_age',28);
424 Whether old bugs are saved or deleted
430 set_default(\%config,'save_old_bugs',1);
432 =item distribution_aliases
434 Map of distribution aliases to the distribution name
437 {experimental => 'experimental',
438 unstable => 'unstable',
439 testing => 'testing',
441 oldstable => 'oldstable',
445 sarge => 'oldstable',
450 set_default(\%config,'distribution_aliases',
451 {experimental => 'experimental',
452 unstable => 'unstable',
453 testing => 'testing',
455 oldstable => 'oldstable',
459 sarge => 'oldstable',
467 List of valid distributions
469 Default: The values of the distribution aliases map.
473 my %_distributions_default;
474 @_distributions_default{values %{$config{distribution_aliases}}} = values %{$config{distribution_aliases}};
475 set_default(\%config,'distributions',[keys %_distributions_default]);
478 =item default_architectures
480 List of default architectures to use when architecture(s) are not
483 Default: i386 amd64 arm ppc sparc alpha
487 set_default(\%config,'default_architectures',
488 [qw(i386 amd64 arm powerpc sparc alpha)]
491 =item affects_distribution_tags
493 List of tags which restrict the buggy state to a set of distributions.
495 The set of distributions that are buggy is the intersection of the set
496 of distributions that would be buggy without reference to these tags
497 and the set of these tags that are distributions which are set on a
500 Setting this to [] will remove this feature.
502 Default: @{$config{distributions}}
506 set_default(\%config,'affects_distribution_tags',
507 [@{$config{distributions}}],
510 =item removal_unremovable_tags
512 Bugs which have these tags set cannot be archived
518 set_default(\%config,'removal_unremovable_tags',
522 =item removal_distribution_tags
524 Tags which specifiy distributions to check
526 Default: @{$config{distributions}}
530 set_default(\%config,'removal_distribution_tags',
531 [@{$config{distributions}}]);
533 =item removal_default_distribution_tags
535 For removal/archival purposes, all bugs are assumed to have these tags
538 Default: qw(experimental unstable testing);
542 set_default(\%config,'removal_default_distribution_tags',
543 [qw(experimental unstable testing)]
546 =item removal_strong_severity_default_distribution_tags
548 For removal/archival purposes, all bugs with strong severity are
549 assumed to have these tags set.
551 Default: qw(experimental unstable testing stable);
555 set_default(\%config,'removal_strong_severity_default_distribution_tags',
556 [qw(experimental unstable testing stable)]
560 =item removal_architectures
562 For removal/archival purposes, these architectures are consulted if
563 there is more than one architecture applicable. If the bug is in a
564 package not in any of these architectures, the architecture actually
565 checked is undefined.
567 Default: value of default_architectures
571 set_default(\%config,'removal_architectures',
572 $config{default_architectures},
576 =item package_name_re
578 The regex which will match a package name
580 Default: '[a-z0-9][a-z0-9\.+-]+'
584 set_default(\%config,'package_name_re',
585 '[a-z0-9][a-z0-9\.+-]+');
587 =item package_version_re
589 The regex which will match a package version
591 Default: '[A-Za-z0-9:+\.-]+'
596 set_default(\%config,'package_version_re',
597 '[A-Za-z0-9:+\.~-]+');
600 =item default_package
602 This is the name of the default package. If set, bugs assigned to
603 packages without a maintainer and bugs missing a Package: psuedoheader
604 will be assigned to this package instead.
606 Defaults to unset, which is the traditional debbugs behavoir
610 set_default(\%config,'default_package',
615 =item control_internal_requester
617 This address is used by Debbugs::Control as the request address which
618 sent a control request for faked log messages.
620 Default:"Debbugs Internal Request <$config{maintainer_email}>"
624 set_default(\%config,'control_internal_requester',
625 "Debbugs Internal Request <$config{maintainer_email}>",
628 =item control_internal_request_addr
630 This address is used by Debbugs::Control as the address to which a
631 faked log message request was sent.
633 Default: "internal_control\@$config{email_domain}";
637 set_default(\%config,'control_internal_request_addr',
638 'internal_control@'.$config{email_domain},
642 =item exclude_from_control
644 Addresses which are not allowed to send messages to control
648 set_default(\%config,'exclude_from_control',[]);
652 =item default_severity
654 The default severity of bugs which have no severity set
660 set_default(\%config,'default_severity','normal');
662 =item severity_display
664 A hashref of severities and the informative text which describes them.
668 {critical => "Critical $config{bugs}",
669 grave => "Grave $config{bugs}",
670 normal => "Normal $config{bugs}",
671 wishlist => "Wishlist $config{bugs}",
676 set_default(\%config,'severity_display',{critical => "Critical $config{bugs}",
677 grave => "Grave $config{bugs}",
678 serious => "Serious $config{bugs}",
679 important=> "Important $config{bugs}",
680 normal => "Normal $config{bugs}",
681 minor => "Minor $config{bugs}",
682 wishlist => "Wishlist $config{bugs}",
685 =item show_severities
687 A scalar list of the severities to show
689 Defaults to the concatenation of the keys of the severity_display
690 hashlist with ', ' above.
694 set_default(\%config,'show_severities',join(', ',keys %{$config{severity_display}}));
696 =item strong_severities
698 An arrayref of the serious severities which shoud be emphasized
700 Default: [qw(critical grave)]
704 set_default(\%config,'strong_severities',[qw(critical grave)]);
708 An arrayref of a list of the severities
710 Defaults to the keys of the severity display hashref
714 set_default(\%config,'severity_list',[keys %{$config{severity_display}}]);
716 =item obsolete_severities
718 A hashref of obsolete severities with the replacing severity
724 set_default(\%config,'obsolete_severities',{});
728 An arrayref of the tags used
730 Default: [qw(patch wontfix moreinfo unreproducible fixed)] and also
731 includes the distributions.
735 set_default(\%config,'tags',[qw(patch wontfix moreinfo unreproducible fixed),
736 @{$config{distributions}}
739 set_default(\%config,'tags_single_letter',
743 unreproducible => 'R',
748 set_default(\%config,'bounce_froms','^mailer|^da?emon|^post.*mast|^root|^wpuser|^mmdf|^smt.*|'.
749 '^mrgate|^vmmail|^mail.*system|^uucp|-maiser-|^mal\@|'.
750 '^mail.*agent|^tcpmail|^bitmail|^mailman');
752 set_default(\%config,'config_dir',dirname(exists $ENV{DEBBUGS_CONFIG_FILE}?$ENV{DEBBUGS_CONFIG_FILE}:'/etc/debbugs/config'));
753 set_default(\%config,'spool_dir','/var/lib/debbugs/spool');
757 Directory which contains the usertags
759 Default: $config{spool_dir}/user
763 set_default(\%config,'usertag_dir',$config{spool_dir}.'/user');
764 set_default(\%config,'incoming_dir','incoming');
766 =item web_dir $gWebDir
768 Directory where base html files are kept. Should normally be the same
769 as the web server's document root.
771 Default: /var/lib/debbugs/www
775 set_default(\%config,'web_dir','/var/lib/debbugs/www');
776 set_default(\%config,'doc_dir','/var/lib/debbugs/www/txt');
777 set_default(\%config,'lib_path','/usr/lib/debbugs');
782 directory of templates; defaults to /usr/share/debbugs/templates.
786 set_default(\%config,'template_dir','/usr/share/debbugs/templates');
789 set_default(\%config,'maintainer_file',$config{config_dir}.'/Maintainers');
790 set_default(\%config,'maintainer_file_override',$config{config_dir}.'/Maintainers.override');
791 set_default(\%config,'source_maintainer_file',$config{config_dir}.'/Source_maintainers');
792 set_default(\%config,'source_maintainer_file_override',undef);
793 set_default(\%config,'pseudo_maint_file',$config{config_dir}.'/pseudo-packages.maintainers');
794 set_default(\%config,'pseudo_desc_file',$config{config_dir}.'/pseudo-packages.description');
795 set_default(\%config,'package_source',$config{config_dir}.'/indices/sources');
798 =item simple_versioning
800 If true this causes debbugs to ignore version information and just
801 look at whether a bug is done or not done. Primarily of interest for
802 debbugs installs which don't track versions. defaults to false.
806 set_default(\%config,'simple_versioning',0);
809 =item version_packages_dir
811 Location where the version package information is kept; defaults to
812 spool_dir/../versions/pkg
816 set_default(\%config,'version_packages_dir',$config{spool_dir}.'/../versions/pkg');
818 =item version_time_index
820 Location of the version/time index file. Defaults to
821 spool_dir/../versions/idx/versions_time.idx if spool_dir/../versions
822 exists; otherwise defaults to undef.
827 set_default(\%config,'version_time_index', -d $config{spool_dir}.'/../versions' ? $config{spool_dir}.'/../versions/indices/versions_time.idx' : undef);
831 Location of the version index file. Defaults to
832 spool_dir/../versions/indices/versions.idx if spool_dir/../versions
833 exists; otherwise defaults to undef.
837 set_default(\%config,'version_index',-d $config{spool_dir}.'/../versions' ? $config{spool_dir}.'/../versions/indices/versions.idx' : undef);
839 =item binary_source_map
841 Location of the binary -> source map. Defaults to
842 spool_dir/../versions/indices/bin2src.idx if spool_dir/../versions
843 exists; otherwise defaults to undef.
847 set_default(\%config,'binary_source_map',-d $config{spool_dir}.'/../versions' ? $config{spool_dir}.'/../versions/indices/binsrc.idx' : undef);
849 =item source_binary_map
851 Location of the source -> binary map. Defaults to
852 spool_dir/../versions/indices/src2bin.idx if spool_dir/../versions
853 exists; otherwise defaults to undef.
857 set_default(\%config,'source_binary_map',-d $config{spool_dir}.'/../versions' ? $config{spool_dir}.'/../versions/indices/srcbin.idx' : undef);
861 set_default(\%config,'post_processall',[]);
865 Sets the sendmail binary to execute; defaults to /usr/lib/sendmail
869 set_default(\%config,'sendmail','/usr/lib/sendmail');
871 =item sendmail_arguments
873 Default arguments to pass to sendmail. Defaults to C<qw(-oem -oi)>.
877 set_default(\%config,'sendmail_arguments',[qw(-oem -oi)]);
881 Whether or not spamscan is being used; defaults to 0 (not being used
885 set_default(\%config,'spam_scan',0);
887 =item spam_crossassassin_db
889 Location of the crosassassin database, defaults to
890 spool_dir/../CrossAssassinDb
894 set_default(\%config,'spam_crossassassin_db',$config{spool_dir}.'/../CrossAssassinDb');
898 Maximum number of cross-posted messages
902 set_default(\%config,'spam_max_cross',6);
905 =item spam_spams_per_thread
907 Number of spams for each thread (on average). Defaults to 200
911 set_default(\%config,'spam_spams_per_thread',200);
913 =item spam_max_threads
915 Maximum number of threads to start. Defaults to 20
919 set_default(\%config,'spam_max_threads',20);
921 =item spam_keep_running
923 Maximum number of seconds to run without restarting. Defaults to 3600.
927 set_default(\%config,'spam_keep_running',3600);
931 Location to store spam messages; is run through strftime to allow for
932 %d,%m,%Y, et al. Defaults to 'spool_dir/../mail/spam/assassinated.%Y-%m-%d'
936 set_default(\%config,'spam_mailbox',$config{spool_dir}.'/../mail/spam/assassinated.%Y-%m-%d');
938 =item spam_crossassassin_mailbox
940 Location to store crossassassinated messages; is run through strftime
941 to allow for %d,%m,%Y, et al. Defaults to
942 'spool_dir/../mail/spam/crossassassinated.%Y-%m-%d'
946 set_default(\%config,'spam_crossassassin_mailbox',$config{spool_dir}.'/../mail/spam/crossassassinated.%Y-%m-%d');
948 =item spam_local_tests_only
950 Whether only local tests are run, defaults to 0
954 set_default(\%config,'spam_local_tests_only',0);
956 =item spam_user_prefs
958 User preferences for spamassassin, defaults to $ENV{HOME}/.spamassassin/user_prefs
962 set_default(\%config,'spam_user_prefs',"$ENV{HOME}/.spamassassin/user_prefs");
966 Site rules directory for spamassassin, defaults to
967 '/usr/share/spamassassin'
971 set_default(\%config,'spam_rules_dir','/usr/share/spamassassin');
979 =item libravatar_uri $gLibravatarUri
981 URI to a libravatar configuration. If empty or undefined, libravatar
982 support will be disabled. Defaults to
983 libravatar.cgi, our internal federated libravatar system.
987 set_default(\%config,'libravatar_uri','http://'.$config{cgi_domain}.'/libravatar.cgi?email=');
989 =item libravatar_uri_options $gLibravatarUriOptions
991 Options to append to the md5_hex of the e-mail. This sets the default
992 avatar used when an avatar isn't available. Currently defaults to
993 '?d=retro', which causes a bitmap-looking avatar to be displayed for
996 Other options which make sense include ?d=404, ?d=wavatar, etc. See
997 the API of libravatar for details.
1001 set_default(\%config,'libravatar_uri_options','');
1003 =item libravatar_default_image
1005 Default image to serve for libravatar if there is no avatar for an
1006 e-mail address. By default, this is a 1x1 png. [This will also be the
1007 image served if someone specifies avatar=no.]
1009 Default: $config{web_dir}/1x1.png
1013 set_default(\%config,'libravatar_default_image',$config{web_dir}.'/1x1.png');
1015 =item libravatar_cache_dir
1017 Directory where cached libravatar images are stored
1019 Default: $config{web_dir}/libravatar/
1023 set_default(\%config,'libravatar_cache_dir',$config{web_dir}.'/libravatar/');
1025 =item libravatar_blacklist
1027 Array of regular expressions to match against emails, domains, or
1028 images to only show the default image
1030 Default: empty array
1034 set_default(\%config,'libravatar_blacklist',[]);
1040 The following are the only text fields in general use in the scripts;
1041 a few additional text fields are defined in text.in, but are only used
1042 in db2html and a few other specialty scripts.
1044 Earlier versions of debbugs defined these values in /etc/debbugs/text,
1045 but now they are required to be in the configuration file. [Eventually
1046 the longer ones will move out into a fully fledged template system.]
1052 =item bad_email_prefix
1054 This prefixes the text of all lines in a bad e-mail message ack.
1058 set_default(\%config,'bad_email_prefix','');
1061 =item text_instructions
1063 This gives more information about bad e-mails to receive.in
1067 set_default(\%config,'text_instructions',$config{bad_email_prefix});
1071 This shows up at the end of (most) html pages
1073 In many pages this has been replaced by the html/tail template.
1077 set_default(\%config,'html_tail',<<END);
1078 <ADDRESS>$config{maintainer} <<A HREF=\"mailto:$config{maintainer_email}\">$config{maintainer_email}</A>>.
1084 <A HREF=\"http://$config{web_domain}/\">Debian $config{bug} tracking system</A><BR>
1085 Copyright (C) 1999 Darren O. Benham,
1086 1997,2003 nCipher Corporation Ltd,
1087 1994-97 Ian Jackson.
1093 =item html_expire_note
1095 This message explains what happens to archive/remove-able bugs
1099 set_default(\%config,'html_expire_note',
1100 "(Closed $config{bugs} are archived $config{remove_age} days after the last related message is received.)");
1108 my ($conf_file) = @_;
1109 if (not -e $conf_file) {
1110 print STDERR "configuration file '$conf_file' doesn't exist; skipping it\n" if $DEBUG;
1113 # first, figure out what type of file we're reading in.
1114 my $fh = new IO::File $conf_file,'r'
1115 or die "Unable to open configuration file $conf_file for reading: $!";
1116 # A new version configuration file must have a comment as its first line
1117 my $first_line = <$fh>;
1118 my ($version) = defined $first_line?$first_line =~ /VERSION:\s*(\d+)/i:undef;
1119 if (defined $version) {
1120 if ($version == 1) {
1121 # Do something here;
1122 die "Version 1 configuration files not implemented yet";
1125 die "Version $version configuration files are not supported";
1129 # Ugh. Old configuration file
1130 # What we do here is we create a new Safe compartment
1131 # so fucked up crap in the config file doesn't sink us.
1132 my $cpt = new Safe or die "Unable to create safe compartment";
1133 # perldoc Opcode; for details
1134 $cpt->permit('require',':filesys_read','entereval','caller','pack','unpack','dofile');
1135 $cpt->reval(qq(require '$conf_file';));
1136 die "Error in configuration file: $@" if $@;
1137 # Now what we do is check out the contents of %EXPORT_TAGS to see exactly which variables
1138 # we want to glob in from the configuration file
1139 for my $variable (map {$_ =~ /^(?:config|all)$/ ? () : @{$EXPORT_TAGS{$_}}} keys %EXPORT_TAGS) {
1140 my ($hash_name,$glob_name,$glob_type) = __convert_name($variable);
1141 my $var_glob = $cpt->varglob($glob_name);
1142 my $value; #= $cpt->reval("return $variable");
1143 # print STDERR "$variable $value",qq(\n);
1144 if (defined $var_glob) {{
1146 if ($glob_type eq '%') {
1147 $value = {%{*{$var_glob}}} if defined *{$var_glob}{HASH};
1149 elsif ($glob_type eq '@') {
1150 $value = [@{*{$var_glob}}] if defined *{$var_glob}{ARRAY};
1153 $value = ${*{$var_glob}};
1155 # We punt here, because we can't tell if the value was
1156 # defined intentionally, or if it was just left alone;
1157 # this tries to set sane defaults.
1158 set_default(\%config,$hash_name,$value) if defined $value;
1165 my ($variable) = @_;
1166 my $hash_name = $variable;
1167 $hash_name =~ s/^([\$\%\@])g//;
1169 my $glob_name = 'g'.$hash_name;
1170 $hash_name =~ s/(HTML|CGI|CVE)/ucfirst(lc($1))/ge;
1171 $hash_name =~ s/^([A-Z]+)/lc($1)/e;
1172 $hash_name =~ s/([A-Z]+)/'_'.lc($1)/ge;
1173 return $hash_name unless wantarray;
1174 return ($hash_name,$glob_name,$glob_type);
1179 # sets the configuration hash to the default value if it's not set,
1180 # otherwise doesn't do anything
1181 # If $USING_GLOBALS, then sets an appropriate global.
1184 my ($config,$option,$value) = @_;
1186 if ($USING_GLOBALS) {
1187 # fix up the variable name
1188 $varname = 'g'.join('',map {ucfirst $_} split /_/, $option);
1189 # Fix stupid HTML names
1190 $varname =~ s/(Html|Cgi)/uc($1)/ge;
1192 # update the configuration value
1193 if (not $USING_GLOBALS and not exists $config->{$option}) {
1194 $config->{$option} = $value;
1196 elsif ($USING_GLOBALS) {{
1198 # Need to check if a value has already been set in a global
1199 if (defined *{"Debbugs::Config::${varname}"}) {
1200 $config->{$option} = *{"Debbugs::Config::${varname}"};
1203 $config->{$option} = $value;
1206 if ($USING_GLOBALS) {{
1208 *{"Debbugs::Config::${varname}"} = $config->{$option};
1215 # All we care about here is whether we've been called with the globals or text option;
1216 # if so, then we need to export some symbols back up.
1217 # In any event, we call exporter.
1220 if (grep /^:(?:text|globals)$/, @_) {
1222 for my $variable (map {@$_} @EXPORT_TAGS{map{(/^:(text|globals)$/?($1):())} @_}) {
1223 my $tmp = $variable;
1225 # Yes, I don't care if these are only used once
1227 # No, it doesn't bother me that I'm assigning an undefined value to a typeglob
1229 my ($hash_name,$glob_name,$glob_type) = __convert_name($variable);
1230 $tmp =~ s/^[\%\$\@]//;
1231 *{"Debbugs::Config::${tmp}"} = ref($config{$hash_name})?$config{$hash_name}:\$config{$hash_name};
1234 Debbugs::Config->export_to_level(1,@_);