# We only want to increment the number of keys if there is
# something to match
my $key_inc = 0;
- for my $package ((map { getsrcpkgs($_)} make_list($param{src})),make_list($param{src})) {
+ for my $package ((map { getsrcpkgs($_)} make_list($param{src}))) {
$packages{$package}++;
$key_inc=1;
}
+ for my $package (make_list($param{src})) {
+ $packages{"src:$package"}++;
+ $key_inc=1;
+ }
$package_keys += $key_inc;
}
if (exists $param{maint}) {
use strict;
use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
use base qw(Exporter);
+
use Debbugs::URI;
use HTML::Entities;
use Debbugs::Common qw(getparsedaddrs make_list);
use Params::Validate qw(validate_with :types);
+
use Debbugs::Config qw(:config);
use Debbugs::Status qw(splitpackages isstrongseverity);
+use Debbugs::User qw();
+
use Mail::Address;
use POSIX qw(ceil);
use Storable qw(dclone);
util => [qw(cgi_parameters quitcgi),
],
forms => [qw(option_form form_options_and_normal_param)],
+ usertags => [qw(add_user)],
misc => [qw(maint_decode)],
package_search => [qw(@package_search_key_order %package_search_keys)],
#status => [qw(getbugstatus)],
sub maybelink {
my ($links,$regex,$join) = @_;
+ if (not defined $regex and not defined $join) {
+ $links =~ s{((?:ftp|http|https)://[\S~-]+?/?)([\)\'\:\.\,]?(?:\s|\.<|$))}
+ {q(<a href=\").html_escape($1).q(\">).html_escape($1).q(</a>).$2}geimo;
+ return $links;
+ }
$join = ' ' if not defined $join;
my @return;
my @segments;
}
+sub add_user {
+ my ($user,$usertags,$bug_usertags,$seen_users,$cats,$hidden) = @_;
+ $seen_users = {} if not defined $seen_users;
+ $bug_usertags = {} if not defined $bug_usertags;
+ $usertags = {} if not defined $usertags;
+ $cats = {} if not defined $cats;
+ $hidden = {} if not defined $hidden;
+ return if exists $seen_users->{$user};
+ $seen_users->{$user} = 1;
+
+ my $u = Debbugs::User::get_user($user);
+
+ my %vis = map { $_, 1 } @{$u->{"visible_cats"}};
+ for my $c (keys %{$u->{"categories"}}) {
+ $cats->{$c} = $u->{"categories"}->{$c};
+ $hidden->{$c} = 1 unless defined $vis{$c};
+ }
+ for my $t (keys %{$u->{"tags"}}) {
+ $usertags->{$t} = [] unless defined $usertags->{$t};
+ push @{$usertags->{$t}}, @{$u->{"tags"}->{$t}};
+ }
+
+ %{$bug_usertags} = ();
+ for my $t (keys %{$usertags}) {
+ for my $b (@{$usertags->{$t}}) {
+ $bug_usertags->{$b} = [] unless defined $bug_usertags->{$b};
+ push @{$bug_usertags->{$b}}, $t;
+ }
+ }
+}
+
+
=head1 Forms
if (defined $value and $o_value eq $value) {
$selected = ' selected';
}
- $output .= qq(<option value="$o_value"$selected>$name</option>\n);
+ $output .= q(<option value=").html_escape($o_value).qq("$selected>).
+ html_escape($name).qq(</option>\n);
}
return $output;
};
return Debbugs::Text::fill_in_template(template=>$param{template},
(exists $param{language}?(language=>$param{language}):()),
variables => $variables,
+ hole_var => {'&html_escape' => \&html_escape,
+ },
);
}
local $_ = $record->{type};
if (/html/) {
my ($time) = $record->{text} =~ /<!--\s+time:(\d+)\s+-->/;
- my $class = $record->{text} =~ /^<strong>(?:Acknowledgement|Reply|Information|Report|Notification)/ ? 'infmessage':'msgreceived';
+ my $class = $record->{text} =~ /^<strong>(?:Acknowledgement|Reply|Information|Report|Notification)/m ? 'infmessage':'msgreceived';
$output .= decode_rfc1522($record->{text});
# Link to forwarded http:// urls in the midst of the report
# (even though these links already exist at the top)
print {$output} ".</p>\n";
}
else {
- print {$output} "<p>No maintainer for $showpkg. Please do not report new bugs against this package.</p>\n";
+ print {$output} "<p>There is no maintainer for $showpkg. ".
+ "Please do not report new bugs against this package.</p>\n";
}
my @pkgs = getsrcpkgs($srcforpkg);
@pkgs = grep( !/^\Q$package\E$/, @pkgs );
push @references, "to the <a href=\"http://$config{web_domain}/pseudo-packages$config{html_suffix}\">".
"list of other pseudo-packages</a>";
}
+ elsif (not defined $maint and not @{$param{bugs}}) {
+ print {$output} "<p>There is no record of the " . html_escape($package) .
+ ($param{binary} ? " package" : " source package") .
+ ", and no bugs have been filed against it.</p>";
+ }
else {
if ($package and defined $config{package_pages} and length $config{package_pages}) {
push @references, sprintf "to the <a href=\"%s\">%s package page</a>",
printf {$output} "<a href=\"%s\">report it</a>.</p>\n",
html_escape("http://$config{web_domain}/Reporting$config{html_suffix}");
}
- if (not defined $maint and not @{$param{bugs}}) {
- print {$output} "<p>There is no record of the " . html_escape($package) .
- ($param{binary} ? " package" : " source package") .
- ", and no bugs have been filed against it.</p>";
- }
return $output_scalar;
}
qw(@gPostProcessall @gRemovalDefaultDistributionTags @gRemovalDistributionTags @gRemovalArchitectures),
qw(@gRemovalStrongSeverityDefaultDistributionTags),
qw(@gDefaultArchitectures),
+ qw($gMachineName),
qw($gTemplateDir),
qw($gDefaultPackage),
qw($gSpamMaxThreads $gSpamSpamsPerThread $gSpamKeepRunning $gSpamScan $gSpamCrossassassinDb),
set_default(\%config,'unknown_maintainer_email',$config{maintainer_email});
+=item machine_name
+
+The name of the machine that this instance of debbugs is running on
+(currently used for debbuging purposes and web page output.)
+
+Default: qx(hostname --fqdn)
+
+=back
+
+=cut
+
+my $_old_path = $ENV{PATH};
+$ENV{PATH} = '/bin:/usr/bin:/usr/local/bin';
+set_default(\%config,'machine_name',qx(hostname --fqdn));
+$ENV{PATH} = $_old_path;
+
=head2 BTS Mailing Lists
=item mirror_list
+=item strong_list
+
=cut
set_default(\%config, 'submit_list', 'bug-submit-list');
die "No bug found for $param{bug}";
}
print {$debug} "$param{bug} read done\n";
- my @bugs = map {$_->{bug_num}} @data;
+ my @bugs = map {(defined $_ and exists $_->{bug_num} and defined $_->{bug_num})?$_->{bug_num}:()} @data;
print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
print {$debug} "$param{bug} unarchiving\n";
my @files_to_remove;
allow_extra => 1,
);
for my $data (make_list($param{data})) {
+ next unless exists $data->{package} and defined $data->{package};
$param{affected_packages}{$data->{package}} = 1;
}
}
use File::Path;
use MIME::Parser;
+use POSIX qw(strftime);
+use List::MoreUtils qw(apply);
+
# for decode_rfc1522
use MIME::WordDecoder qw();
use Encode qw(decode encode encode_utf8 decode_utf8 is_utf8);
=head2 create_mime_message
- create_mime_message([To=>'don@debian.org'],$body,[$attach1, $attach2]);
+ create_mime_message([To=>'don@debian.org'],$body,[$attach1, $attach2],$include_date);
Creates a MIME encoded message with headers given by the first
argument, and a message given by the second.
Optional attachments can be specified in the third arrayref argument.
+Whether to include the date in the header is the final argument; it
+defaults to true, setting the Date header if one is not already
+present.
+
Headers are passed directly to MIME::Entity::build, the message is the
first attachment.
=cut
sub create_mime_message{
- my ($headers,$body,$attachments) = @_;
+ my ($headers,$body,$attachments,$include_date) = @_;
$attachments = [] if not defined $attachments;
+ $include_date = 1 if not defined $include_date;
die "The first argument to create_mime_message must be an arrayref" unless ref($headers) eq 'ARRAY';
die "The third argument to create_mime_message must be an arrayref" unless ref($attachments) eq 'ARRAY';
+ if ($include_date) {
+ my %headers = apply {lc($_)} @{$headers};
+ if (not exists $headers{date}) {
+ push @{$headers},
+ ('Date',
+ strftime("%a, %d %b %Y %H:%M:%S +0000",gmtime)
+ );
+ }
+ }
+
# Build the message
# MIME::Entity is stupid, and doesn't rfc1522 encode its headers, so we do it for it.
my $msg = MIME::Entity->build('Content-Type' => 'text/plain; charset=utf-8',
use Debbugs::Log qw(read_log_records);
use Debbugs::CGI qw(:url :html :util);
use Debbugs::CGI::Bugreport qw(:all);
-use Debbugs::Common qw(buglog getmaintainers);
+use Debbugs::Common qw(buglog getmaintainers make_list);
use Debbugs::Packages qw(getpkgsrc);
use Debbugs::Status qw(splitpackages get_bug_status isstrongseverity);
use Debbugs::Text qw(:templates);
+
use CGI::Simple;
my $q = new CGI::Simple;
my $mbox = $param{'mbox'} eq 'yes';
my $mime = $param{'mime'} eq 'yes';
+my %bugusertags;
+my %ut;
+my %seen_users;
+
+for my $user (map {split /[\s*,\s*]+/} make_list($param{users}||[])) {
+ next unless length($user);
+ add_user($user,\%ut,\%bugusertags,\%seen_users);
+}
+
+if (defined $param{usertag}) {
+ for my $usertag (make_list($param{usertag})) {
+ my %select_ut = ();
+ my ($u, $t) = split /:/, $usertag, 2;
+ Debbugs::User::read_usertags(\%select_ut, $u);
+ unless (defined $t && $t ne "") {
+ $t = join(",", keys(%select_ut));
+ }
+ add_user($u,\%ut,\%bugusertags,\%seen_users);
+ push @{$param{tag}}, split /,/, $t;
+ }
+}
+
+
my $trim_headers = ($param{trim} || ((defined $msg and $msg)?'no':'yes')) eq 'yes';
my $mbox_status_message = $param{mboxstat} eq 'yes';
}
-my %status = %{get_bug_status(bug=>$ref)};
+my %status = %{get_bug_status(bug=>$ref,
+ bugusertags => \%bugusertags,
+ )};
my @records;
eval{
if ( $mbox ) {
my $date = strftime "%a %b %d %T %Y", localtime;
if (@records > 1) {
- print qq(Content-Disposition: attachment; filename="bug_${ref}.mbox"\n);
- print "Content-Type: text/plain\n\n";
+ print $q->header(-type => "text/plain",
+ content_disposition => qq(attachment; filename="bug_${ref}.mbox"),
+ (length $mtime)?(-last_modified => $mtime):(),
+ );
}
else {
$msg_num++;
- print qq(Content-Disposition: attachment; filename="bug_${ref}_message_${msg_num}.mbox"\n);
- print "Content-Type: message/rfc822\n\n";
+ print $q->header(-type => "message/rfc822",
+ content_disposition => qq(attachment; filename="bug_${ref}_message_${msg_num}.mbox"),
+ (length $mtime)?(-last_modified => $mtime):(),
+ );
}
if ($mbox_status_message and @records > 1) {
my $status_message='';
log => $log,
bug_num => $ref,
version_graph => $version_graph,
+ msg => $msg,
isstrongseverity => \&Debbugs::Status::isstrongseverity,
html_escape => \&Debbugs::CGI::html_escape,
looks_like_number => \&Scalar::Util::looks_like_number,
delete $param{pkg};
}
-our %bugusertags;
-our %ut;
+my %bugusertags;
+my %ut;
+my %seen_users;
+
for my $user (map {split /[\s*,\s*]+/} make_list($param{users}||[])) {
next unless length($user);
- add_user($user);
+ add_user($user,\%ut,\%bugusertags,\%seen_users,\%cats,\%hidden);
}
if (defined $param{usertag}) {
unless (defined $t && $t ne "") {
$t = join(",", keys(%select_ut));
}
- add_user($u);
+ add_user($u,\%ut,\%bugusertags,\%seen_users,\%cats,\%hidden);
push @{$param{tag}}, split /,/, $t;
}
}
my %indexentry;
my %strings = ();
-my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime;
-my $tail_html = $gHTMLTail;
-$tail_html = $gHTMLTail;
-$tail_html =~ s/SUBSTITUTE_DTIME/$dtime/;
-
-our %seen_users;
-sub add_user {
- my $ut = \%ut;
- my $u = shift;
-
- return if $seen_users{$u};
- $seen_users{$u} = 1;
-
- my $user = Debbugs::User::get_user($u);
-
- my %vis = map { $_, 1 } @{$user->{"visible_cats"}};
- for my $c (keys %{$user->{"categories"}}) {
- $cats{$c} = $user->{"categories"}->{$c};
- $hidden{$c} = 1 unless defined $vis{$c};
- }
-
- for my $t (keys %{$user->{"tags"}}) {
- $ut->{$t} = [] unless defined $ut->{$t};
- push @{$ut->{$t}}, @{$user->{"tags"}->{$t}};
- }
-
- %bugusertags = ();
- for my $t (keys %{$ut}) {
- for my $b (@{$ut->{$t}}) {
- $bugusertags{$b} = [] unless defined $bugusertags{$b};
- push @{$bugusertags{$b}}, $t;
- }
- }
-# set_option("bugusertags", \%bugusertags);
-}
-
my @bugs;
# addusers for source and binary packages being searched for
),
) {
next unless defined $package;
- add_user($package.'@'.$config{usertag_package_domain})
+ add_user($package.'@'.$config{usertag_package_domain},
+ \%ut,\%bugusertags,\%seen_users,\%cats,\%hidden)
if defined $config{usertag_package_domain};
}
print "different addresses.\n";
}
-# my $archive_links;
-# my @archive_links;
-# my %archive_values = (both => 'archived and unarchived',
-# 0 => 'not archived',
-# 1 => 'archived',
-# );
-# while (my ($key,$value) = each %archive_values) {
-# next if $key eq lc($param{archive});
-# push @archive_links, qq(<a href=").
-# html_escape(pkg_url((
-# map {
-# $_ eq 'archive'?():($_,$param{$_})
-# } keys %param),
-# archive => $key
-# )).qq(">$value reports </a>);
-# }
-# print '<p>See the '.join (' or ',@archive_links)."</p>\n";
-
print $result;
print pkg_javascript() . "\n";
variables => $form_option_variables,
);
-# print "<h2 class=\"outstanding\"><a class=\"options\" href=\"javascript:toggle(1)\">Options</a></h2>\n";
-# print "<div id=\"a_1\">\n";
-# printf "<form action=\"%s\" method=POST>\n", myurl();
-#
-# print "<table class=\"forms\">\n";
-#
-# my ($checked_any, $checked_sui, $checked_ver) = ("", "", "");
-# if (defined $dist) {
-# $checked_sui = "CHECKED";
-# } elsif (defined $version) {
-# $checked_ver = "CHECKED";
-# } else {
-# $checked_any = "CHECKED";
-# }
-#
-# print "<tr><td>Show bugs applicable to</td>\n";
-# print " <td><input id=\"b_1_1\" name=vt value=none type=radio onchange=\"enable(1);\" $checked_any>anything</td></tr>\n";
-# print "<tr><td></td>";
-# print " <td><input id=\"b_1_2\" name=vt value=bysuite type=radio onchange=\"enable(1);\" $checked_sui>" . pkg_htmlselectsuite(1,2,1) . " for " . pkg_htmlselectarch(1,2,2) . "</td></tr>\n";
-#
-# if (defined $pkg) {
-# my $v = html_escape($version) || "";
-# my $pkgsane = html_escape($pkg->[0]);
-# print "<tr><td></td>";
-# print " <td><input id=\"b_1_3\" name=vt value=bypkg type=radio onchange=\"enable(1);\" $checked_ver>$pkgsane version <input id=\"b_1_3_1\" name=version value=\"$v\"></td></tr>\n";
-# } elsif (defined $src) {
-# my $v = html_escape($version) || "";
-# my $srcsane = html_escape($src->[0]);
-# print "<tr><td></td>";
-# print " <td><input name=vt value=bysrc type=radio onchange=\"enable(1);\" $checked_ver>$srcsane version <input id=\"b_1_3_1\" name=version value=\"$v\"></td></tr>\n";
-# }
-# print "<tr><td> </td></tr>\n";
-#
-# my $includetags = html_escape(join(" ", grep { !m/^subj:/i } map {split /[\s,]+/} ref($include)?@{$include}:$include));
-# my $excludetags = html_escape(join(" ", grep { !m/^subj:/i } map {split /[\s,]+/} ref($exclude)?@{$exclude}:$exclude));
-# my $includesubj = html_escape(join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } map {split /[\s,]+/} ref($include)?@{$include}:$include));
-# my $excludesubj = html_escape(join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } map {split /[\s,]+/} ref($exclude)?@{$exclude}:$exclude));
-# my $vismindays = ($mindays == 0 ? "" : $mindays);
-# my $vismaxdays = ($maxdays == -1 ? "" : $maxdays);
-#
-# my $sel_rmy = ($param{repeatmerged} ? " selected" : "");
-# my $sel_rmn = ($param{repeatmerged} ? "" : " selected");
-# my $sel_ordraw = ($ordering eq "raw" ? " selected" : "");
-# my $sel_ordold = ($ordering eq "oldview" ? " selected" : "");
-# my $sel_ordnor = ($ordering eq "normal" ? " selected" : "");
-# my $sel_ordage = ($ordering eq "age" ? " selected" : "");
-#
-# my $chk_bugrev = ($bug_rev ? " checked" : "");
-# my $chk_pendrev = ($pend_rev ? " checked" : "");
-# my $chk_sevrev = ($sev_rev ? " checked" : "");
-#
-# print <<EOF;
-# <tr><td>Only include bugs tagged with </td><td><input name=include value="$includetags"> or that have <input name=includesubj value="$includesubj"> in their subject</td></tr>
-# <tr><td>Exclude bugs tagged with </td><td><input name=exclude value="$excludetags"> or that have <input name=excludesubj value="$excludesubj"> in their subject</td></tr>
-# <tr><td>Only show bugs older than</td><td><input name=mindays value="$vismindays" size=5> days, and younger than <input name=maxdays value="$vismaxdays" size=5> days</td></tr>
-#
-# <tr><td> </td></tr>
-#
-# <tr><td>Merged bugs should be</td><td>
-# <select name=repeatmerged>
-# <option value=yes$sel_rmy>displayed separately</option>
-# <option value=no$sel_rmn>combined</option>
-# </select>
-# <tr><td>Categorise bugs by</td><td>
-# <select name=ordering>
-# <option value=raw$sel_ordraw>bug number only</option>
-# <option value=old$sel_ordold>status and severity</option>
-# <option value=normal$sel_ordnor>status, severity and classification</option>
-# <option value=age$sel_ordage>status, severity, classification, and age</option>
-# EOF
-#
-# {
-# my $any = 0;
-# my $o = $param{"ordering"} || "";
-# for my $n (keys %cats) {
-# next if ($n eq "normal" || $n eq "oldview");
-# next if defined $hidden{$n};
-# unless ($any) {
-# $any = 1;
-# print "<option disabled>------</option>\n";
-# }
-# my @names = map { ref($_) eq "HASH" ? $_->{"nam"} : $_ } @{$cats{$n}};
-# my $name;
-# if (@names == 1) { $name = $names[0]; }
-# else { $name = " and " . pop(@names); $name = join(", ", @names) . $name; }
-#
-# printf "<option value=\"%s\"%s>%s</option>\n",
-# $n, ($o eq $n ? " selected" : ""), $name;
-# }
-# }
-#
-# print "</select></td></tr>\n";
-#
-# printf "<tr><td>Order bugs by</td><td>%s</td></tr>\n",
-# pkg_htmlselectyesno("pend-rev", "outstanding bugs first", "done bugs first", $pend_rev);
-# printf "<tr><td></td><td>%s</td></tr>\n",
-# pkg_htmlselectyesno("sev-rev", "highest severity first", "lowest severity first", $sev_rev);
-# printf "<tr><td></td><td>%s</td></tr>\n",
-# pkg_htmlselectyesno("bug-rev", "oldest bugs first", "newest bugs first", $bug_rev);
-#
-# print <<EOF;
-# <tr><td> </td></tr>
-# <tr><td colspan=2><input value="Reload page" type="submit"> with new settings</td></tr>
-# EOF
-#
-# print "</table></form></div>\n";
-
print "<hr>\n";
-print "<p>$tail_html";
-
+print fill_in_template(template=>'html/html_tail',
+ hole_var => {'&strftime' => \&POSIX::strftime,
+ },
+ );
print "</body></html>\n";
-#!/usr/bin/perl -wT
+#!/usr/bin/perl -T
+
+use warnings;
+use strict;
#use SOAP::Transport::HTTP;
next unless defined $_ and /Month|Day|Year|date|time|duration/i;
delete $typelookup->{$key};
}
-$soap->handle;
+our $warnings = '';
+eval {
+ # Ignore stupid warning because elements (hashes) can't start with
+ # numbers
+ local $SIG{__WARN__} = sub {$warnings .= $_[0] unless $_[0] =~ /Cannot encode unnamed element/};
+ $soap->handle;
+};
+die $@ if $@;
+warn $warnings if length $warnings;
* Fix casing of versions (closes: #441022)
* Output last-modified in bugreport.cgi (closes: #459709)
* Fix various html syntax errors in pkgreport.cgi (closes: #462322)
- * Make search case insensitive (closes: #448861)
+ * Make search case insensitive (closes: #448861, #444416)
* Add the ability to return source/package mapping
(closes: #465332,#458822)
* Deal properly with \r line endings (closes: #467190)
* Distinguish between reports and followups (closes: #459866)
- * Allow for the archiving of bugs in removed packages (closes: #475622)
+ * Allow for the archiving of bugs in removed packages (closes: #475622, #470146)
* Add Text::Template based templating system (closes: #36814)
* Add new uservalue feature to Debbugs::User
* Don't serialize things as date/time in soap (closes: #484789)
(closes: #499997)
* Comment out CGI::Alert use for the time being (closes: #499681)
* No longer hard-code paths in age-1 (closes: #499682)
+ * Change how maybelink links links (closes: #501757)
+ * Use bug_subscription_domain in process (closes: #499680)
+ * Clean up links when there is no information about a package
+ (closes: #452905)
+ * Deal properly with leading spaces in query arguments (closes: #158375)
+ * Only send out control help when control is mailed (closes: #499941)
+ * Resolve two XSS (closes: #504608)
+ * Strip BOM before regexes involving spaces (closes: #488554)
+ * Display link to full log again (closes: #507506)
+ * Add Last-Modified: header support to mbox download (closes: #456786)
+ * Add Date headers if missing (closes: #458757)
+ * Indiciate what machine has built webpages (closes: #507022)
-- Colin Watson <cjwatson@debian.org> Fri, 20 Jun 2003 18:57:25 +0100
# extract pseudo-headers
for my $phline (@bodylines)
{
+ # Remove BOM markers from UTF-8 strings
+ # Fixes #488554
+ $phline =~ s/\xef\xbb\xbf//g;
last if $phline !~ m/^([\w-]+):\s*(\S.*)/;
my ($fn, $fv) = ($1, $2);
$fv =~ s/\s*$//;
my ($bug_fn) = @_;
# Read the bug information and package information for passing to
# the mailing list
+ my $bug_fh = IO::File->new("incoming/P$bug_fn",'r') or
+ die "Unable to open incoming/P$bug_fn $!";
+
+ if (not defined $config{bug_subscription_domain} or not
+ length $config{bug_subscription_domain}) {
+ unlink("incoming/P$bug_fn") or
+ die "unlinking incoming/P$bug_fn: $!";
+ exit 0;
+ }
+
my ($bug_number) = $bug_fn =~ /^L(\d+)\./;
- my ($bfound, $data)= lockreadbugmerge($bug_number);
- my $bug_fh = IO::File->new("incoming/P$bug_fn",'r') or die "Unable to open incoming/P$bug_fn $!";
+ my $data = read_bug(bug => $bug_number);
local $/ = undef;
my $bug_message = <$bug_fh>;
# If we don't have a bug address, something has gone horribly wrong.
print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address;
$bug_address =~ s/\@.+//;
- print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n";
+ print DEBUG "Sending message to bugs=$bug_address\@$config{bug_subscription_domain}\n";
print DEBUG $header.qq(\n\n).$body;
send_mail_message(message => $header.qq(\n\n).$body,
- recipients => ["bugs=$bug_address\@$gListDomain"],
+ recipients => ["bugs=$bug_address\@$config{bug_subscription_domain}"],
envelope_from => $envelope_from,
encode_headers => 0,
);
}
}
$header{'message-id'} ||= '';
+$header{subject} ||= '';
grep(s/\s+$//,@bodylines);
last;
}
$_= $bodylines[$procline]; s/\s+$//;
+ # Remove BOM markers from UTF-8 strings
+ # Fixes #488554
+ s/\xef\xbb\xbf//g;
next unless m/\S/;
print {$transcript} "> $_\n";
next if m/^\s*\#/;
}
sub sendhelp {
- &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
- &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
- if $control;
+ if ($control) {
+ &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
+ }
+ else {
+ &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
+ }
}
#sub unimplemented {
eval q(
use Debbugs::SOAP::Server;
@Debbugs::SOAP::Server::ISA = qw(SOAP::Transport::HTTP::Daemon);
- Debbugs::SOAP::Server
+ our $warnings = '';
+ eval {
+ # Ignore stupid warning because elements (hashes) can't start with
+ # numbers
+ local $SIG{__WARN__} = sub {$warnings .= $_[0] unless $_[0] =~ /Cannot encode unnamed element/};
+ Debbugs::SOAP::Server
->new(LocalAddr => 'localhost', LocalPort => $port)
->dispatch_to('/','Debbugs::SOAP')
->handle;
+ };
+ die $@ if $@;
+ warn $warnings if length $warnings;
+
);
}
use SOAP::Lite;
my $soap = SOAP::Lite->uri('Debbugs/SOAP')->proxy('http://localhost:'.$port.'/');
#ok($soap->get_soap_version->result == 1,'Version set and got correctly');
-my $bugs = $soap->get_bugs(package => 'foo')->result;
+my $bugs_result = $soap->get_bugs(package => 'foo');
+my $bugs = $bugs_result->result;
use Data::Dumper;
+#print STDERR Dumper($bugs_result);
ok(@{$bugs} == 1 && $bugs->[0] == 1, 'get_bugs returns bug number 1') or fail(Dumper($bugs));
-my $status = $soap->get_status(1)->result;
+my $status_result = $soap->get_status(1);
+#print STDERR Dumper($status_result);
+my $status = $status_result->result;
ok($status->{1}{package} eq 'foo','get_status thinks that bug 1 belongs in foo') or fail(Dumper($status));
# Test the usertags at some point
{include(q(cgi/bugreport_buginfo))}
{ my $output = '';
if (looks_like_number($msg)) {
- $output .= sprintf qq(<p><a href="%s">Full log</a></p>),html_escape(bug_links(bug=>$ref,links_only=>1));
+ $output .= sprintf qq(<p><a href="%s">Full log</a></p>),html_escape(bug_links(bug=>$bug_num,links_only=>1));
}
else {
$output .= qq(<p><a href="mailto:$bug_num\@$config{email_domain}">Reply</a> ).
<nobr><select name="_fo_searchkey">
{output_select_options(\@search_key_order,$search||'')}
</select>
-<input type="text" name="_fo_searchvalue" value ="{$search_value||''}">
+<input type="text" name="_fo_searchvalue" value ="{html_escape($search_value||'')}">
<!-- {$value_index} -->
</nobr>
<!--timestamp-->
{$last_modified||strftime('%c',gmtime)}
<!--timestamp-->
+Machine Name:
+<!--machinename-->
+{$config{machine_name}||'Unknown'}
+<!--machinename-->
<P>
<A HREF="http://{$config{web_domain}}/">{$config{project}} {$config{bug}} tracking system</A><BR>
Copyright (C) 1999 Darren O. Benham,
projects / debbugs.git / commitdiff