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 config => [qw(%config)],
84 Exporter::export_ok_tags(qw(globals text config));
85 $EXPORT_TAGS{all} = [@EXPORT_OK];
86 $ENV{HOME} = '' if not defined $ENV{HOME};
89 use File::Basename qw(dirname);
93 =head1 CONFIGURATION VARIABLES
95 =head2 General Configuration
103 # untaint $ENV{DEBBUGS_CONFIG_FILE} if it's owned by us
104 # This enables us to test things that are -T.
105 if (exists $ENV{DEBBUGS_CONFIG_FILE}) {
106 # This causes all sorts of problems for mirrors of debbugs; disable
108 # if (${[stat($ENV{DEBBUGS_CONFIG_FILE})]}[4] == $<) {
109 $ENV{DEBBUGS_CONFIG_FILE} =~ /(.+)/;
110 $ENV{DEBBUGS_CONFIG_FILE} = $1;
113 # die "Environmental variable DEBBUGS_CONFIG_FILE set, and $ENV{DEBBUGS_CONFIG_FILE} is not owned by the user running this script.";
116 read_config(exists $ENV{DEBBUGS_CONFIG_FILE}?$ENV{DEBBUGS_CONFIG_FILE}:'/etc/debbugs/config');
118 =item email_domain $gEmailDomain
120 The email domain of the bts
124 set_default(\%config,'email_domain','bugs.something');
126 =item list_domain $gListDomain
128 The list domain of the bts, defaults to the email domain
132 set_default(\%config,'list_domain',$config{email_domain});
134 =item web_host $gWebHost
136 The web host of the bts; defaults to the email domain
140 set_default(\%config,'web_host',$config{email_domain});
142 =item web_host_bug_dir $gWebHostDir
144 The directory of the web host on which bugs are kept, defaults to C<''>
148 set_default(\%config,'web_host_bug_dir','');
150 =item web_domain $gWebDomain
152 Full path of the web domain where bugs are kept, defaults to the
153 concatenation of L</web_host> and L</web_host_bug_dir>
157 set_default(\%config,'web_domain',$config{web_host}.($config{web_host}=~m{/$}?'':'/').$config{web_host_bug_dir});
159 =item html_suffix $gHTMLSuffix
161 Suffix of html pages, defaults to .html
165 set_default(\%config,'html_suffix','.html');
167 =item cgi_domain $gCGIDomain
169 Full path of the web domain where cgi scripts are kept. Defaults to
170 the concatentation of L</web_host> and cgi.
174 set_default(\%config,'cgi_domain',$config{web_domain}.($config{web_domain}=~m{/$}?'':'/').'cgi');
176 =item mirrors @gMirrors
178 List of mirrors [What these mirrors are used for, no one knows.]
183 set_default(\%config,'mirrors',[]);
185 =item package_pages $gPackagePages
187 Domain where the package pages are kept; links should work in a
188 package_pages/foopackage manner. Defaults to undef, which means that
189 package links will not be made.
194 set_default(\%config,'package_pages',undef);
196 =item package_pages $gUsertagPackageDomain
198 Domain where where usertags of packages belong; defaults to $gPackagePages
202 set_default(\%config,'usertag_package_domain',$config{package_pages});
205 =item subscription_domain $gSubscriptionDomain
207 Domain where subscriptions to package lists happen
211 set_default(\%config,'subscription_domain',undef);
214 =item cve_tracker $gCVETracker
216 URI to CVE security tracker; in bugreport.cgi, CVE-2001-0002 becomes
217 linked to http://$config{cve_tracker}CVE-2001-002
219 Default: security-tracker.debian.org/tracker/
223 set_default(\%config,'cve_tracker','security-tracker.debian.org/tracker/');
231 =head2 Project Identification
235 =item project $gProject
243 set_default(\%config,'project','Something');
245 =item project_title $gProjectTitle
247 Name of this install of Debbugs, defaults to "L</project> Debbugs Install"
249 Default: "$config{project} Debbugs Install"
253 set_default(\%config,'project_title',"$config{project} Debbugs Install");
255 =item maintainer $gMaintainer
257 Name of the maintainer of this debbugs install
259 Default: 'Local DebBugs Owner's
263 set_default(\%config,'maintainer','Local DebBugs Owner');
265 =item maintainer_webpage $gMaintainerWebpage
267 Webpage of the maintainer of this install of debbugs
269 Default: "$config{web_domain}/~owner"
273 set_default(\%config,'maintainer_webpage',"$config{web_domain}/~owner");
275 =item maintainer_email $gMaintainerEmail
277 Email address of the maintainer of this Debbugs install
279 Default: 'root@'.$config{email_domain}
283 set_default(\%config,'maintainer_email','root@'.$config{email_domain});
285 =item unknown_maintainer_email
287 Email address where packages with an unknown maintainer will be sent
289 Default: $config{maintainer_email}
293 set_default(\%config,'unknown_maintainer_email',$config{maintainer_email});
297 The name of the machine that this instance of debbugs is running on
298 (currently used for debbuging purposes and web page output.)
300 Default: qx(hostname --fqdn)
306 my $_old_path = $ENV{PATH};
307 $ENV{PATH} = '/bin:/usr/bin:/usr/local/bin';
308 my $temp_hostname = qx(hostname --fqdn);
309 chomp $temp_hostname;
310 set_default(\%config,'machine_name',$temp_hostname);
311 $ENV{PATH} = $_old_path;
313 =head2 BTS Mailing Lists
340 set_default(\%config, 'submit_list', 'bug-submit-list');
341 set_default(\%config, 'maint_list', 'bug-maint-list');
342 set_default(\%config, 'quiet_list', 'bug-quiet-list');
343 set_default(\%config, 'forward_list', 'bug-forward-list');
344 set_default(\%config, 'done_list', 'bug-done-list');
345 set_default(\%config, 'request_list', 'bug-request-list');
346 set_default(\%config,'submitter_list','bug-submitter-list');
347 set_default(\%config, 'control_list', 'bug-control-list');
348 set_default(\%config, 'summary_list', 'bug-summary-list');
349 set_default(\%config, 'mirror_list', 'bug-mirror-list');
350 set_default(\%config, 'strong_list', 'bug-strong-list');
352 =item bug_subscription_domain
354 Domain of list for messages regarding a single bug; prefixed with
355 bug=${bugnum}@ when bugs are actually sent out. Set to undef or '' to
356 disable sending messages to the bug subscription list.
364 set_default(\%config,'bug_subscription_domain',$config{list_domain});
373 URI to a libravatar configuration. If empty or undefined, libravatar
374 support will be disabled. Defaults to
375 http://cdn.libravatar.org/avatar/ which uses a federated Avatar system
376 and falls back to gravatar if necessary.
380 set_default(\%config,'libravatar_uri',"http://cdn.libravatar.org/avatar/");
382 =item libravatar_uri_options
384 Options to append to the md5_hex of the e-mail. This sets the default
385 avatar used when an avatar isn't available. Currently defaults to
386 '?d=retro', which causes a bitmap-looking avatar to be displayed for
389 Other options which make sense include ?d=404, ?d=wavatar, etc. See
390 the API of libravatar for details.
394 set_default(\%config,'libravatar_uri_options','?d=retro');
405 Name of the mailer to use
411 set_default(\%config,'mailer','exim');
420 Default: ucfirst($config{bug});
428 Default: ucfirst($config{ubugs});
432 set_default(\%config,'bug','bug');
433 set_default(\%config,'ubug',ucfirst($config{bug}));
434 set_default(\%config,'bugs','bugs');
435 set_default(\%config,'ubugs',ucfirst($config{bugs}));
439 Age at which bugs are archived/removed
445 set_default(\%config,'remove_age',28);
449 Whether old bugs are saved or deleted
455 set_default(\%config,'save_old_bugs',1);
457 =item distribution_aliases
459 Map of distribution aliases to the distribution name
462 {experimental => 'experimental',
463 unstable => 'unstable',
464 testing => 'testing',
466 oldstable => 'oldstable',
470 sarge => 'oldstable',
475 set_default(\%config,'distribution_aliases',
476 {experimental => 'experimental',
477 unstable => 'unstable',
478 testing => 'testing',
480 oldstable => 'oldstable',
484 sarge => 'oldstable',
492 List of valid distributions
494 Default: The values of the distribution aliases map.
498 my %_distributions_default;
499 @_distributions_default{values %{$config{distribution_aliases}}} = values %{$config{distribution_aliases}};
500 set_default(\%config,'distributions',[keys %_distributions_default]);
503 =item default_architectures
505 List of default architectures to use when architecture(s) are not
508 Default: i386 amd64 arm ppc sparc alpha
512 set_default(\%config,'default_architectures',
513 [qw(i386 amd64 arm powerpc sparc alpha)]
516 =item affects_distribution_tags
518 List of tags which restrict the buggy state to a set of distributions.
520 The set of distributions that are buggy is the intersection of the set
521 of distributions that would be buggy without reference to these tags
522 and the set of these tags that are distributions which are set on a
525 Setting this to [] will remove this feature.
527 Default: @{$config{distributions}}
531 set_default(\%config,'affects_distribution_tags',
532 [@{$config{distributions}}],
535 =item removal_unremovable_tags
537 Bugs which have these tags set cannot be archived
543 set_default(\%config,'removal_unremovable_tags',
547 =item removal_distribution_tags
549 Tags which specifiy distributions to check
551 Default: @{$config{distributions}}
555 set_default(\%config,'removal_distribution_tags',
556 [@{$config{distributions}}]);
558 =item removal_default_distribution_tags
560 For removal/archival purposes, all bugs are assumed to have these tags
563 Default: qw(unstable testing);
567 set_default(\%config,'removal_default_distribution_tags',
568 [qw(unstable testing)]
571 =item removal_strong_severity_default_distribution_tags
573 For removal/archival purposes, all bugs with strong severity are
574 assumed to have these tags set.
576 Default: qw(unstable testing stable);
580 set_default(\%config,'removal_strong_severity_default_distribution_tags',
581 [qw(unstable testing stable)]
585 =item removal_architectures
587 For removal/archival purposes, these architectures are consulted if
588 there is more than one architecture applicable. If the bug is in a
589 package not in any of these architectures, the architecture actually
590 checked is undefined.
592 Default: value of default_architectures
596 set_default(\%config,'removal_architectures',
597 $config{default_architectures},
601 =item package_name_re
603 The regex which will match a package name
605 Default: '[a-z0-9][a-z0-9\.+-]+'
609 set_default(\%config,'package_name_re',
610 '[a-z0-9][a-z0-9\.+-]+');
612 =item package_version_re
614 The regex which will match a package version
616 Default: '[A-Za-z0-9:+\.-]+'
621 set_default(\%config,'package_version_re',
622 '[A-Za-z0-9:+\.~-]+');
625 =item default_package
627 This is the name of the default package. If set, bugs assigned to
628 packages without a maintainer and bugs missing a Package: psuedoheader
629 will be assigned to this package instead.
631 Defaults to unset, which is the traditional debbugs behavoir
635 set_default(\%config,'default_package',
640 =item control_internal_requester
642 This address is used by Debbugs::Control as the request address which
643 sent a control request for faked log messages.
645 Default:"Debbugs Internal Request <$config{maintainer_email}>"
649 set_default(\%config,'control_internal_requester',
650 "Debbugs Internal Request <$config{maintainer_email}>",
653 =item control_internal_request_addr
655 This address is used by Debbugs::Control as the address to which a
656 faked log message request was sent.
658 Default: "internal_control\@$config{email_domain}";
662 set_default(\%config,'control_internal_request_addr',
663 'internal_control@'.$config{email_domain},
667 =item exclude_from_control
669 Addresses which are not allowed to send messages to control
673 set_default(\%config,'exclude_from_control',[]);
677 =item default_severity
679 The default severity of bugs which have no severity set
685 set_default(\%config,'default_severity','normal');
687 =item severity_display
689 A hashref of severities and the informative text which describes them.
693 {critical => "Critical $config{bugs}",
694 grave => "Grave $config{bugs}",
695 normal => "Normal $config{bugs}",
696 wishlist => "Wishlist $config{bugs}",
701 set_default(\%config,'severity_display',{critical => "Critical $config{bugs}",
702 grave => "Grave $config{bugs}",
703 serious => "Serious $config{bugs}",
704 important=> "Important $config{bugs}",
705 normal => "Normal $config{bugs}",
706 minor => "Minor $config{bugs}",
707 wishlist => "Wishlist $config{bugs}",
710 =item show_severities
712 A scalar list of the severities to show
714 Defaults to the concatenation of the keys of the severity_display
715 hashlist with ', ' above.
719 set_default(\%config,'show_severities',join(', ',keys %{$config{severity_display}}));
721 =item strong_severities
723 An arrayref of the serious severities which shoud be emphasized
725 Default: [qw(critical grave)]
729 set_default(\%config,'strong_severities',[qw(critical grave)]);
733 An arrayref of a list of the severities
735 Defaults to the keys of the severity display hashref
739 set_default(\%config,'severity_list',[keys %{$config{severity_display}}]);
741 =item obsolete_severities
743 A hashref of obsolete severities with the replacing severity
749 set_default(\%config,'obsolete_severities',{});
753 An arrayref of the tags used
755 Default: [qw(patch wontfix moreinfo unreproducible fixed)] and also
756 includes the distributions.
760 set_default(\%config,'tags',[qw(patch wontfix moreinfo unreproducible fixed),
761 @{$config{distributions}}
764 set_default(\%config,'tags_single_letter',
768 unreproducible => 'R',
773 set_default(\%config,'bounce_froms','^mailer|^da?emon|^post.*mast|^root|^wpuser|^mmdf|^smt.*|'.
774 '^mrgate|^vmmail|^mail.*system|^uucp|-maiser-|^mal\@|'.
775 '^mail.*agent|^tcpmail|^bitmail|^mailman');
777 set_default(\%config,'config_dir',dirname(exists $ENV{DEBBUGS_CONFIG_FILE}?$ENV{DEBBUGS_CONFIG_FILE}:'/etc/debbugs/config'));
778 set_default(\%config,'spool_dir','/var/lib/debbugs/spool');
782 Directory which contains the usertags
784 Default: $config{spool_dir}/user
788 set_default(\%config,'usertag_dir',$config{spool_dir}.'/user');
789 set_default(\%config,'incoming_dir','incoming');
790 set_default(\%config,'web_dir','/var/lib/debbugs/www');
791 set_default(\%config,'doc_dir','/var/lib/debbugs/www/txt');
792 set_default(\%config,'lib_path','/usr/lib/debbugs');
797 directory of templates; defaults to /usr/share/debbugs/templates.
801 set_default(\%config,'template_dir','/usr/share/debbugs/templates');
804 set_default(\%config,'maintainer_file',$config{config_dir}.'/Maintainers');
805 set_default(\%config,'maintainer_file_override',$config{config_dir}.'/Maintainers.override');
806 set_default(\%config,'source_maintainer_file',$config{config_dir}.'/Source_maintainers');
807 set_default(\%config,'source_maintainer_file_override',undef);
808 set_default(\%config,'pseudo_maint_file',$config{config_dir}.'/pseudo-packages.maintainers');
809 set_default(\%config,'pseudo_desc_file',$config{config_dir}.'/pseudo-packages.description');
810 set_default(\%config,'package_source',$config{config_dir}.'/indices/sources');
813 =item simple_versioning
815 If true this causes debbugs to ignore version information and just
816 look at whether a bug is done or not done. Primarily of interest for
817 debbugs installs which don't track versions. defaults to false.
821 set_default(\%config,'simple_versioning',0);
824 =item version_packages_dir
826 Location where the version package information is kept; defaults to
827 spool_dir/../versions/pkg
831 set_default(\%config,'version_packages_dir',$config{spool_dir}.'/../versions/pkg');
833 =item version_time_index
835 Location of the version/time index file. Defaults to
836 spool_dir/../versions/idx/versions_time.idx if spool_dir/../versions
837 exists; otherwise defaults to undef.
842 set_default(\%config,'version_time_index', -d $config{spool_dir}.'/../versions' ? $config{spool_dir}.'/../versions/indices/versions_time.idx' : undef);
846 Location of the version index file. Defaults to
847 spool_dir/../versions/indices/versions.idx if spool_dir/../versions
848 exists; otherwise defaults to undef.
852 set_default(\%config,'version_index',-d $config{spool_dir}.'/../versions' ? $config{spool_dir}.'/../versions/indices/versions.idx' : undef);
854 =item binary_source_map
856 Location of the binary -> source map. Defaults to
857 spool_dir/../versions/indices/bin2src.idx if spool_dir/../versions
858 exists; otherwise defaults to undef.
862 set_default(\%config,'binary_source_map',-d $config{spool_dir}.'/../versions' ? $config{spool_dir}.'/../versions/indices/binsrc.idx' : undef);
864 =item source_binary_map
866 Location of the source -> binary map. Defaults to
867 spool_dir/../versions/indices/src2bin.idx if spool_dir/../versions
868 exists; otherwise defaults to undef.
872 set_default(\%config,'source_binary_map',-d $config{spool_dir}.'/../versions' ? $config{spool_dir}.'/../versions/indices/srcbin.idx' : undef);
876 set_default(\%config,'post_processall',[]);
880 Sets the sendmail binary to execute; defaults to /usr/lib/sendmail
884 set_default(\%config,'sendmail','/usr/lib/sendmail');
886 =item sendmail_arguments
888 Default arguments to pass to sendmail. Defaults to C<qw(-oem -oi)>.
892 set_default(\%config,'sendmail_arguments',[qw(-oem -oi)]);
896 Whether or not spamscan is being used; defaults to 0 (not being used
900 set_default(\%config,'spam_scan',0);
902 =item spam_crossassassin_db
904 Location of the crosassassin database, defaults to
905 spool_dir/../CrossAssassinDb
909 set_default(\%config,'spam_crossassassin_db',$config{spool_dir}.'/../CrossAssassinDb');
913 Maximum number of cross-posted messages
917 set_default(\%config,'spam_max_cross',6);
920 =item spam_spams_per_thread
922 Number of spams for each thread (on average). Defaults to 200
926 set_default(\%config,'spam_spams_per_thread',200);
928 =item spam_max_threads
930 Maximum number of threads to start. Defaults to 20
934 set_default(\%config,'spam_max_threads',20);
936 =item spam_keep_running
938 Maximum number of seconds to run without restarting. Defaults to 3600.
942 set_default(\%config,'spam_keep_running',3600);
946 Location to store spam messages; is run through strftime to allow for
947 %d,%m,%Y, et al. Defaults to 'spool_dir/../mail/spam/assassinated.%Y-%m-%d'
951 set_default(\%config,'spam_mailbox',$config{spool_dir}.'/../mail/spam/assassinated.%Y-%m-%d');
953 =item spam_crossassassin_mailbox
955 Location to store crossassassinated messages; is run through strftime
956 to allow for %d,%m,%Y, et al. Defaults to
957 'spool_dir/../mail/spam/crossassassinated.%Y-%m-%d'
961 set_default(\%config,'spam_crossassassin_mailbox',$config{spool_dir}.'/../mail/spam/crossassassinated.%Y-%m-%d');
963 =item spam_local_tests_only
965 Whether only local tests are run, defaults to 0
969 set_default(\%config,'spam_local_tests_only',0);
971 =item spam_user_prefs
973 User preferences for spamassassin, defaults to $ENV{HOME}/.spamassassin/user_prefs
977 set_default(\%config,'spam_user_prefs',"$ENV{HOME}/.spamassassin/user_prefs");
981 Site rules directory for spamassassin, defaults to
982 '/usr/share/spamassassin'
986 set_default(\%config,'spam_rules_dir','/usr/share/spamassassin');
993 The following are the only text fields in general use in the scripts;
994 a few additional text fields are defined in text.in, but are only used
995 in db2html and a few other specialty scripts.
997 Earlier versions of debbugs defined these values in /etc/debbugs/text,
998 but now they are required to be in the configuration file. [Eventually
999 the longer ones will move out into a fully fledged template system.]
1005 =item bad_email_prefix
1007 This prefixes the text of all lines in a bad e-mail message ack.
1011 set_default(\%config,'bad_email_prefix','');
1014 =item text_instructions
1016 This gives more information about bad e-mails to receive.in
1020 set_default(\%config,'text_instructions',$config{bad_email_prefix});
1024 This shows up at the end of (most) html pages
1026 In many pages this has been replaced by the html/tail template.
1030 set_default(\%config,'html_tail',<<END);
1031 <ADDRESS>$config{maintainer} <<A HREF=\"mailto:$config{maintainer_email}\">$config{maintainer_email}</A>>.
1037 <A HREF=\"http://$config{web_domain}/\">Debian $config{bug} tracking system</A><BR>
1038 Copyright (C) 1999 Darren O. Benham,
1039 1997,2003 nCipher Corporation Ltd,
1040 1994-97 Ian Jackson.
1045 =item html_expire_note
1047 This message explains what happens to archive/remove-able bugs
1051 set_default(\%config,'html_expire_note',
1052 "(Closed $config{bugs} are archived $config{remove_age} days after the last related message is received.)");
1060 my ($conf_file) = @_;
1061 if (not -e $conf_file) {
1062 print STDERR "configuration file '$conf_file' doesn't exist; skipping it\n" if $DEBUG;
1065 # first, figure out what type of file we're reading in.
1066 my $fh = new IO::File $conf_file,'r'
1067 or die "Unable to open configuration file $conf_file for reading: $!";
1068 # A new version configuration file must have a comment as its first line
1069 my $first_line = <$fh>;
1070 my ($version) = defined $first_line?$first_line =~ /VERSION:\s*(\d+)/i:undef;
1071 if (defined $version) {
1072 if ($version == 1) {
1073 # Do something here;
1074 die "Version 1 configuration files not implemented yet";
1077 die "Version $version configuration files are not supported";
1081 # Ugh. Old configuration file
1082 # What we do here is we create a new Safe compartment
1083 # so fucked up crap in the config file doesn't sink us.
1084 my $cpt = new Safe or die "Unable to create safe compartment";
1085 # perldoc Opcode; for details
1086 $cpt->permit('require',':filesys_read','entereval','caller','pack','unpack','dofile');
1087 $cpt->reval(qq(require '$conf_file';));
1088 die "Error in configuration file: $@" if $@;
1089 # Now what we do is check out the contents of %EXPORT_TAGS to see exactly which variables
1090 # we want to glob in from the configuration file
1091 for my $variable (@{$EXPORT_TAGS{globals}}) {
1092 my ($hash_name,$glob_name,$glob_type) = __convert_name($variable);
1093 my $var_glob = $cpt->varglob($glob_name);
1094 my $value; #= $cpt->reval("return $variable");
1095 # print STDERR "$variable $value",qq(\n);
1096 if (defined $var_glob) {{
1098 if ($glob_type eq '%') {
1099 $value = {%{*{$var_glob}}} if defined *{$var_glob}{HASH};
1101 elsif ($glob_type eq '@') {
1102 $value = [@{*{$var_glob}}] if defined *{$var_glob}{ARRAY};
1105 $value = ${*{$var_glob}};
1107 # We punt here, because we can't tell if the value was
1108 # defined intentionally, or if it was just left alone;
1109 # this tries to set sane defaults.
1110 set_default(\%config,$hash_name,$value) if defined $value;
1117 my ($variable) = @_;
1118 my $hash_name = $variable;
1119 $hash_name =~ s/^([\$\%\@])g//;
1121 my $glob_name = 'g'.$hash_name;
1122 $hash_name =~ s/(HTML|CGI|CVE)/ucfirst(lc($1))/ge;
1123 $hash_name =~ s/^([A-Z]+)/lc($1)/e;
1124 $hash_name =~ s/([A-Z]+)/'_'.lc($1)/ge;
1125 return $hash_name unless wantarray;
1126 return ($hash_name,$glob_name,$glob_type);
1131 # sets the configuration hash to the default value if it's not set,
1132 # otherwise doesn't do anything
1133 # If $USING_GLOBALS, then sets an appropriate global.
1136 my ($config,$option,$value) = @_;
1138 if ($USING_GLOBALS) {
1139 # fix up the variable name
1140 $varname = 'g'.join('',map {ucfirst $_} split /_/, $option);
1141 # Fix stupid HTML names
1142 $varname =~ s/(Html|Cgi)/uc($1)/ge;
1144 # update the configuration value
1145 if (not $USING_GLOBALS and not exists $config->{$option}) {
1146 $config->{$option} = $value;
1148 elsif ($USING_GLOBALS) {{
1150 # Need to check if a value has already been set in a global
1151 if (defined *{"Debbugs::Config::${varname}"}) {
1152 $config->{$option} = *{"Debbugs::Config::${varname}"};
1155 $config->{$option} = $value;
1158 if ($USING_GLOBALS) {{
1160 *{"Debbugs::Config::${varname}"} = $config->{$option};
1167 # All we care about here is whether we've been called with the globals or text option;
1168 # if so, then we need to export some symbols back up.
1169 # In any event, we call exporter.
1172 if (grep /^:(?:text|globals)$/, @_) {
1174 for my $variable (map {@$_} @EXPORT_TAGS{map{(/^:(text|globals)$/?($1):())} @_}) {
1175 my $tmp = $variable;
1177 # Yes, I don't care if these are only used once
1179 # No, it doesn't bother me that I'm assigning an undefined value to a typeglob
1181 my ($hash_name,$glob_name,$glob_type) = __convert_name($variable);
1182 $tmp =~ s/^[\%\$\@]//;
1183 *{"Debbugs::Config::${tmp}"} = ref($config{$hash_name})?$config{$hash_name}:\$config{$hash_name};
1186 Debbugs::Config->export_to_level(1,@_);