diff --git a/en/cgi/query-pr-lib.pl b/en/cgi/query-pr-lib.pl new file mode 100644 index 0000000000..a0b19e7d41 --- /dev/null +++ b/en/cgi/query-pr-lib.pl @@ -0,0 +1,162 @@ +#!/usr/bin/perl -Tw + +sub get_categories { + @categories = (); + + open(Q, 'query-pr.web --list-categories 2>/dev/null |') || + die "Cannot get categories\n"; + + while() { + chop; + local ($cat, $desc, $responsible, $notify) = split(/:/); + push(@categories, $cat); + $catdesc{$cat} = $desc; + } +} + +sub get_states { + @states = (); + + open(Q, 'query-pr.web --list-states 2>/dev/null |') || + die "Cannot get states\n"; + + while() { + chop; + local ($state, $type, $desc) = split(/:/); + push(@states, $state); + $statedesc{$state} = $desc; + } +} + +sub get_classes { + @classes = (); + + open(Q, 'query-pr.web --list-classes 2>/dev/null |') || + die "Cannot get classes\n"; + + while() { + chop; + local ($class, $type, $desc) = split(/:/); + push(@classes, $class); + $classdesc{$class} = $desc; + } +} + +sub displayform { +print qq` +

To query the GNATS Database for specific PR number, please fill in +this form:

+
+ + + + +
PR number:
Category: (optional)
+
+
+ +

Alternatively, it is possible to select items you wish to search for. +Multiple items are AND'ed together.
+To generate current list of all open PRs in GNATS database, just press +the "Query PRs" button. +

+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Category:Severity:
Priority:Class:
State:Sort by:
Text in single-line fields:Responsible:
Text in multi-line fields:Originator:
Closed reports too:Release:
+
+
+`; +} + +1; diff --git a/en/cgi/query-pr-summary.cgi b/en/cgi/query-pr-summary.cgi index 85cab90a2b..d68a53d2eb 100755 --- a/en/cgi/query-pr-summary.cgi +++ b/en/cgi/query-pr-summary.cgi @@ -1,693 +1,547 @@ #!/usr/bin/perl -T -# $FreeBSD: www/en/cgi/query-pr-summary.cgi,v 1.56 2006/09/24 13:34:55 danger Exp $ +# $FreeBSD: www/en/cgi/query-pr-summary.cgi,v 1.57 2006/10/08 17:00:12 ceri Exp $ $html_mode = 1 if $ENV{'DOCUMENT_ROOT'}; $self_ref = $ENV{'SCRIPT_NAME'}; ($query_pr_ref = $self_ref) =~ s/-summary//; $ENV{'PATH'} = '/bin:/usr/bin:/usr/sbin:/sbin:/usr/local/bin'; $project = 'FreeBSD'; $mail_prefix = 'freebsd-'; $mail_unass = 'freebsd-bugs'; $ports_unass = 'ports-bugs'; $closed_too = 0; require './cgi-lib.pl'; require './cgi-style.pl'; +require './query-pr-lib.pl'; require 'getopts.pl'; if (!$ENV{'QUERY_STRING'} or $ENV{'QUERY_STRING'} eq 'query') { print &html_header("Query $project problem reports"); &displayform; print &html_footer; exit(0); } if ($html_mode) { $query_args = '--restricted '; &ReadParse(*input); } else { &Getopts('CcqRr:s:T:'); $input{'responsible'} = 'summary' if $opt_R; if ($opt_r) { ($input{'responsible'}) = ($opt_r =~ m/^(\^?[-_a-zA-Z0-9@.]*\$?)$/); die 'Insecure args' if ($input{'responsible'} ne $opt_r) } if ($opt_s) { ($input{'state'}) = ($opt_s =~ m/^([a-zA-Z]*)$/); die 'Insecure args' if ($input{'state'} ne $opt_s) } $input{'quiet'} = 'yes' if $opt_q; if ($opt_C) { $query_args = '--confidential=yes '; } elsif (!$opt_c) { $query_args = '--restricted '; } if ($opt_T) { ($tag) = ($opt_T =~ m/^(\^?[-_a-zA-Z0-9@.]*\$?)$/); die 'Insecure args' if ($tag ne $opt_T); $input{'text'} = '\[' . $tag . '\]'; } } $closed_too = 1 if $input{'state'} eq 'closed' || $input{'closedtoo'}; #------------------------------------------------------------------------ %mons = ('Jan', '01', 'Feb', '02', 'Mar', '03', 'Apr', '04', 'May', '05', 'Jun', '06', 'Jul', '07', 'Aug', '08', 'Sep', '09', 'Oct', '10', 'Nov', '11', 'Dec', '12'); if ($html_mode) { $pr = '
';    $pr_e = '
'; $h1 = '

'; $h1_e = '

'; $h3 = '

'; $h3_e = '

'; $hr = '
'; $table = ""; $table_e = '
'; # Customizations for the look and feel of the summary tables. $t_style = ""; } else { $pr = ''; $pr_e = ''; $h1 = ''; $h1_e = ''; $h3 = ''; $h3_e = ''; $hr = "\n----------------------------------------" . "---------------------------------------\n"; $table = ''; $table_e = ''; } sub cgiparam { local ($result) = @_; $result =~ s/[^A-Za-z0-9+.@-]/"%".sprintf("%02X", unpack("C", $&))/ge; $result; } sub header_info { if ($html_mode) { print &html_header("Current $project problem reports"); } else { print "Current $project problem reports\n"; } if (!$input{'quiet'}) { print "The following is a listing of current problems submitted by $project users. " . 'These represent problem reports covering all versions including ' . 'experimental development code and obsolete releases. '; if ($html_mode) { print < Bugs can be in one of several states:

o - open
A problem report has been submitted, no sanity checking performed.
a - analyzed
The problem is understood and a solution is being sought.
f - feedback
Further work requires additional information from the originator or the community - possibly confirmation of the effectiveness of a proposed solution.
p - patched
A patch has been committed, but some issues (MFC and / or confirmation from originator) are still open.
r - repocopy
The resolution of the problem report is dependent on a repocopy operation within the CVS repository which is awaiting completion.
s - suspended
The problem is not being worked on, due to lack of information or resources. This is a prime candidate for somebody who is looking for a project to do. If the problem cannot be solved at all, it will be closed, rather than suspended.
c - closed
A problem report is closed when any changes have been integrated, documented, and tested -- or when fixing the problem is abandoned.
EOM } else { print <You may view summaries by Severity, "; $self_ref1 .= '&' if ($self_ref1 !~/\?$/); print "State, "; print "Category, or "; print "Responsible Party."; $self_ref2 = $self_ref . '?'; foreach ('category', 'originator', 'priority', 'class', 'responsible', 'severity', 'state', 'submitter', 'text', 'multitext', 'closedtoo') { if ($input{$_}) { $self_ref2 .= '&' if ($self_ref2 !~/\?$/); $self_ref2 .= $_ . '=' . cgiparam($input{$_}); } } print 'You may also sort by '; print "Last-Modified, "; print "Category, or "; print "Responsible Party.\n"; print "Or formulate a specific query.\n"; $self_ref3 = $self_ref . '?'; foreach ('category', 'originator', 'priority', 'class', 'responsible', 'severity', 'state', 'submitter', 'text', 'multitext', 'sort') { if ($input{$_}) { $self_ref3 .= '&' if ($self_ref2 !~/\?$/); $self_ref3 .= $_ . '=' . cgiparam($input{$_}); } } if ($input{'closedtoo'}) { print "Do not show closed reports."; } else { print "Include closed reports too."; } print "

\n"; } } &header_info; #Usage: query-pr [-FGhiPRqVx] [-C confidential] [-c category] [-d directory] # [-e severity] [-m mtext] [-O originator] [-o outfile] [-p priority] # [-L class] [-r responsible] [-S submitter] [-s state] [-t text] # [-b date] [-a date] [-B date] [-M date] [-z date] [-Z date] # [-y synopsis] [-A release] [--full] [--help] [--print-path] [--version] # [--summary] [--sql] [--skip-closed] [--category=category] # [--confidential=yes|no] [--directory=directory] [--output=outfile] # [--originator=name] [--priority=level] [--class=class] # [--responsible=person] [--release=release] [--restricted] # [--quarter=quarter] [--keywords=regexp] # [--required-before=date] [--required-after=date] # [--arrived-before=date] [--arrived-after=date] # [--modified-before=date] [--modified-after=date] # [--closed-before=date] [--closed-after=date] # [--severity=severity] [--state=state] [--submitter=submitter] # [--list-categories] [--list-classes] [--list-responsible] # [--list-states] [--list-submitters] [--list-config] # [--synopsis=synopsis] [--text=text] [--multitext=mtext] [PR] [PR]... $query_args .= ' --skip-closed' unless $closed_too; # Only read the appropriate PR's. foreach ('category', 'originator', 'priority', 'class', 'responsible', 'release', 'severity', 'state', 'submitter', 'text', 'multitext') { if ($input{$_} && $input{$_} ne 'summary') { # Check if the arguments provided by user are secure. # This is required to be able to run this script in # taint mode (perl -T) if ($input{$_} =~ /^([-^'\/\[\]\@\s\w.]+)$/) { $d = $1; $d =~ s/^"(.*)"$/$&/; $d =~ s/'/\\'/; $query_args .= " --${_}='$d'"; } else { print "Insecure data in ${_}! Ignoring this filter.
". "Only alphanumeric characters and ', /, -, [, ], ^, @ are allowed."; } } } &read_gnats($query_args); if ($input{'sort'} eq 'lastmod') { @prs = sort {$lastmod{$b} cmp $lastmod{$a}} @prs; } elsif ($input{'sort'} eq 'category') { @prs = sort {($ca,$na)=split(m|/|,$a); ($cb,$nb)=split(m|/|,$b); $ca eq $cb ? $na <=> $nb : $ca cmp $cb} @prs; } elsif ($input{'sort'} eq 'responsible') { @prs = sort {$resp{$a} cmp $resp{$b}} @prs; } else { $input{'sort'} = 'none'; } if ($#prs < $[) { print "${h1}No matches to your query${h1_e}\n"; } elsif ($input{'responsible'} eq 'summary') { &resp_summary; } elsif ($input{'state'} eq 'summary') { &state_summary; } elsif ($input{'category'} eq 'summary') { &cat_summary; } elsif ($input{'severity'} eq '') { &severity_summary; } else { &printcnt(&gnats_summary(1, $html_mode)); } print &html_footer if $html_mode; exit(0); #------------------------------------------------------------------------ sub getline { local($_) = @_; ($tag,$remainder) = split(/[ \t]+/, $_, 2); return $remainder; } sub html_fixline { local($line) = @_[0]; $line =~ s/&/&/g; $line =~ s//>/g; $line; } sub printcnt { local($cnt) = $_[0]; if ($cnt) { printf("%d problem%s total.\n\n", $cnt, $cnt == 1 ? '' : 's'); } } sub cat_summary { &get_categories; foreach (keys %status) { s|/\d+||; $cat{$_}++; } foreach (@categories) { next unless $cat{$_}; # skip categories with no bugs. print "${h3}Problems in category: $_ ($catdesc{$_})${h3_e}\n"; if (/^(\w+)/) { &printcnt(&gnats_summary("\$cat eq \"$1\"", $html_mode)); } else { print "\n??? weird category $_\n"; } } } sub resp_query { local($resp) = @_[0]; local($cnt); $cnt = &gnats_summary("\$resp eq \"$resp\"", $html_mode); print "${hr}${b}No problem reports assigned to $resp${b_e}\n" if (!$input{"quiet"} && $cnt == 0); } sub resp_summary { local($who, %who); foreach (keys %resp) { $who{$resp{$_}}++; } foreach $who (sort keys %who) { $cnt = &gnats_summary("\$resp eq \"$who\"", $html_mode); } } sub state_summary { &get_states; foreach (@states) { next if ($_ eq "closed" && !$input{"closedtoo"}); print "${h3}Problems in state: $_${h3_e}\n"; if (/^(\w)/) { &printcnt(&gnats_summary("\$state eq \"$1\" ", $html_mode)); } else { print "\n??? bad state $state\n"; } } } sub severity_summary { print "${h3}Critical problems${h3_e}\n"; &printcnt(&gnats_summary('$severity eq "critical"', $html_mode)); print "${h3}Serious problems${h3_e}\n"; &printcnt(&gnats_summary('$severity eq "serious"', $html_mode)); print "${h3}Non-critical problems${h3_e}\n"; &printcnt(&gnats_summary('$severity eq "non-critical"', $html_mode)); } -sub get_categories { - @categories = (); - - open(Q, 'query-pr.web --list-categories 2>/dev/null |') || - die "Cannot get categories\n"; - - while() { - chop; - local ($cat, $desc, $responsible, $notify) = split(/:/); - push(@categories, $cat); - $catdesc{$cat} = $desc; - } -} - -sub get_states { - @states = (); - - open(Q, 'query-pr.web --list-states 2>/dev/null |') || - die "Cannot get states\n"; - - while() { - chop; - local ($state, $type, $desc) = split(/:/); - push(@states, $state); - $statedesc{$state} = $desc; - } -} - -sub get_classes { - @classes = (); - - open(Q, 'query-pr.web --list-classes 2>/dev/null |') || - die "Cannot get classes\n"; - - while() { - chop; - local ($class, $type, $desc) = split(/:/); - push(@classes, $class); - $classdesc{$class} = $desc; - } -} - sub read_gnats { local($report) = @_[0]; open(Q, "query-pr.web $report 2>/dev/null |") || die "Cannot query the PR's\n"; while() { chop; if(/^>Number:/) { $number = &getline($_); } elsif (/Arrival-Date:/) { $date = &getline($_); # strip timezone if any (between HH:MM:SS and YYYY at end of line): $date =~ s/(\d\d:\d\d:\d\d)\D+(\d{4})$/\1 \2/; ($dow,$mon,$day,$time,$year,$xtra) = split(/[ \t]+/, $date); $day = "0$day" if $day =~ /^[0-9]$/; $date = "$year/$mons{$mon}/$day"; } elsif (/>Last-Modified:/) { $lastmod = &getline($_); if ($lastmod =~ /^[ ]*$/) { $lastmod = $date; } else { # strip timezone if any (between HH:MM:SS and YYYY at end of line): $lastmod =~ s/(\d\d:\d\d:\d\d)\D+(\d{4})$/\1 \2/; ($dow,$mon,$day,$time,$year,$xtra) = split(/[ \t]+/, $lastmod); $day = "0$day" if $day =~ /^[0-9]$/; $lastmod = "$year/$mons{$mon}/$day"; } } elsif (/>Category:/) { $cat = &getline($_); } elsif (/>Severity:/) { $sev = &getline($_); } elsif (/>Responsible:/) { $resp = &getline($_); $resp =~ s/@.*//; $resp =~ tr/A-Z/a-z/; $resp = "" if (($resp =~ /$mail_unass/o) or ($resp =~ /$ports_unass/o)); $resp =~ s/^$mail_prefix//; } elsif (/>State:/) { $status = &getline($_); $status =~ s/(.).*/\1/; } elsif (/>Synopsis:/) { $syn = &getline($_); $syn =~ s/[\t]+/ /g; } elsif (/^$/) { $_ = sprintf("%s/%s", $cat, $number); $status{$_} = $status; $date{$_} = $date; $resp{$_} = $resp; $syn{$_} = $syn; $sev{$_} = $sev; $lastmod{$_} = $lastmod; push(@prs,$_); } } close(Q); } sub gnats_summary { local($report) = @_[0]; local($htmlmode) = @_[1]; local($counter) = 0; foreach (@prs) { $state = $status{$_}; $date = $date{$_}; $resp = $resp{$_}; $syn = $syn{$_}; $severity = $sev{$_}; ($cat, $number) = m|^([^/]+)/(\d+)$|; next if (($report ne '') && (eval($report) == 0)); if ($htmlmode) { $title = "$_"; $syn = &html_fixline($syn); gnats_summary_line_html($counter, $state, $date, $title, $resp, $syn); } else { $title = $_; gnats_summary_line_text($counter, $state, $date, $title, $resp, $syn); } $counter++; } if ($htmlmode) { print "${table_e}\n" if $counter; } else { print "${pr_e}\n" if $counter; } $counter; } sub gnats_summary_line_html { local($counter) = shift; local($state) = shift; local($date) = shift; local($title) = shift; local($resp) = shift; local($syn) = shift; if ($counter == 0) { print "$tableSSubmittedTrackerResp.Description\n" } print "$state$date$title$resp$syn\n"; } sub gnats_summary_line_text { local($counter) = shift; local($state) = shift; local($date) = shift; local($title) = shift; local($resp) = shift; local($syn) = shift; # Print the banner line if this is the first iteration. print "${pr}\nS Submitted Tracker Resp. Description${hr}" if ($counter == 0); print "$state $date $title" . (' ' x (17 - length($_))) . $resp . (' ' x (10 - length($resp))) . substr($syn,0,39) . "\n"; } - -sub displayform { -print qq` -

-Please select the items you wish to search for. Multiple items are AND'ed -together.
-To generate current list of all open PRs in GNATS database, just press -the "Query PRs" button. -

-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Category:Severity:
Priority:Class:
State:Sort by:
Text in single-line fields:Responsible:
Text in multi-line fields:Originator:
Closed reports too:Release:
- - -
-`; -} diff --git a/en/cgi/query-pr.cgi b/en/cgi/query-pr.cgi index edb51df2ed..10f4ac291c 100755 --- a/en/cgi/query-pr.cgi +++ b/en/cgi/query-pr.cgi @@ -1,1148 +1,1138 @@ #!/usr/bin/perl -Tw # # A "More Useful" GNATS query-pr Interface # # Copyright (C) 2006, Shaun Amott # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # -# $FreeBSD: www/en/cgi/query-pr.cgi,v 1.59 2006/11/27 17:12:50 shaun Exp $ +# $FreeBSD: www/en/cgi/query-pr.cgi,v 1.60 2006/12/09 15:46:06 shaun Exp $ # use strict; -#use warnings; use MIME::Base64; # ports/converters/p5-MIME-Base64 use MIME::QuotedPrint; # use Convert::UU qw(uudecode uuencode); # ports/converters/p5-Convert-UU require './cgi-style.pl'; +require './query-pr-lib.pl'; use constant HTTP_HEADER => "Content-type: text/html; charset=UTF-8\r\n\r\n"; use constant HTTP_HEADER_PATCH => "Content-type: text/plain; charset=UTF-8\r\n\r\n"; use constant SECT_HEADER => 1; use constant SECT_SFIELDS => 2; use constant SECT_MFIELDS => 3; use constant ENCODING_BASE64 => 1; use constant ENCODING_QP => 2; use constant PATCH_ANY => 0x0001; use constant PATCH_DIFF => 0x0002; use constant PATCH_UUENC => 0x0004; use constant PATCH_UUENC_BIN => 0x0008; use constant PATCH_SHAR => 0x0010; use constant PATCH_BASE64 => 0x0020; my @fields_single = ( "Number", "Category", "Synopsis", "Confidential", "Severity", "Priority", "Responsible", "State", "Quarter", "Keywords", "Date-Required", "Class", "Submitter-Id", "Arrival-Date", "Closed-Date", "Last-Modified", "Originator", "Release", ); my @fields_multiple = ( "Organization", "Environment", "Description", "How-To-Repeat", "Fix", "Release-Note", "Audit-Trail", "Unformatted", ); my $fields_skip = "Confidential|Quarter|Keywords|Date-Required|Submitter-Id"; my $valid_category = '[a-z0-9][A-Za-z0-9-_]{1,25}'; my $valid_pr = '\d{1,8}'; my $binary_filetypes = '(?:\.gz|\.bz2|\.zip|\.tar)$'; my %fmt; my $f = ""; my $PR = -1; my $getpatch = -1; my $inpatch = 0; my $patchendhint = 0; my $category; my @query; my (%header, %sfields, %mfields); my $iscgi = defined $ENV{'SCRIPT_NAME'}; $ENV{'PATH'} = "/bin:/usr/bin:/usr/sbin:/sbin:/usr/local/bin"; $ENV{'QUERY_STRING'} ||= ""; $ENV{'SCRIPT_NAME'} ||= $0; # Junk from cgi-style.pl $main::hsty_base ||= ""; $main::t_style ||= ""; my $scriptname = htmlclean($ENV{'SCRIPT_NAME'}); my $querystring = htmlclean($ENV{'QUERY_STRING'}); # Do not change $self_url_base, unless you understand what it is for! # In particular: it is used as a delimiter between comments in the # Audit-Trail. my $self_url_base = "http://www.FreeBSD.org/cgi/query-pr.cgi?pr="; my $cvsweb_url = "http://www.FreeBSD.org/cgi/cvsweb.cgi/"; my $stylesheet = "$main::hsty_base/layout/css/query-pr.css"; #----------------------------------------------------------------------- # Format strings #----------------------------------------------------------------------- $fmt{'header_thead'} = < EOF $fmt{'header_tfoot'} = <
EOF $fmt{'header_trow'} = <%%(1):%%(2) EOF $fmt{'sfields_thead'} = < EOF $fmt{'sfields_trow'} = <%%(1):%%(2) EOF $fmt{'sfields_tfoot'} = <
EOF $fmt{'mfields_header'} = <%%(1):
EOF $fmt{'mfields_header'} =~ s/\n+$//; $fmt{'mfields_footer'} = < EOF $fmt{'patchblock_thead'} = < Download %%(2) 
 EOF
 $fmt{'patchblock_thead'} =~ s/\n+$//;
 
 $fmt{'patchblock_tfoot'} = <
 

 EOF
 $fmt{'patchblock_tfoot'} =~ s/\n+$//;
 $fmt{'patchblock_tfoot'} =~ s/^\n+//;
 
 $fmt{'auditblock_thead'} = <
   %%(1) Changed
 EOF
 
 $fmt{'auditblock_tfoot'} = <
 

 EOF
 
 $fmt{'auditblock_trow'} = <%%(1):%%(2)
 EOF
 
 $fmt{'responseblock_thead'} = <
   Reply via E-mail
 EOF
 
 $fmt{'responseblock_tfoot'} = <

 EOF
 
 $fmt{'responseblock_textfoot'} = <
 EOF
 
 $fmt{'responseblock_texthead'} = <
 EOF
 
 $fmt{'responseblock_trow'} = <%%(1):%%(2)
 EOF
 
 $fmt{'unexpectedtext_thead'} = <
 EOF
 
 $fmt{'html_footerlinks'} = <
     Submit Followup
     | Raw PR
     | Find another PR
EOF -$fmt{'query_form'} = < - - - - -
PR number:
Category: (optional)
- -EOF - $fmt{'trylatermsg'} = < Please try again later.

EOF $fmt{'mime_boundary'} = < EOF $fmt{'quote_level_0'} = '> '; $fmt{'quote_level_1'} = '> '; $fmt{'quote_end'} = ''; $fmt{'empty'} = ' '; $fmt{'break'} = "
\n"; # From cgi-style.pl $main::t_style = ""; #----------------------------------------------------------------------- # Begin Code #----------------------------------------------------------------------- if ($ENV{'QUERY_STRING'}) { foreach (split(/&/, $ENV{'QUERY_STRING'})) { my ($key, $val) = map { s/%([0-9a-f]{2})/chr hex $1/egi; $_ } split /=/; $f = lc $val if ($key eq "f"); $PR = lc $val if ($key eq "pr" or $key eq "q"); $PR = lc $key if ($key =~ /^(?:$valid_category\/)?$valid_pr$/i); $category = lc $val if ($key eq "cat"); $getpatch = lc $val if ($key eq "getpatch"); } } unless (!$iscgi) { print HTTP_HEADER_PATCH if ($getpatch > 0 or $f eq "raw"); } ($category, $PR) = ($1, $2) if ($PR =~ /^($valid_category)\/($valid_pr)$/); $category = undef if ($category && $category !~ /^$valid_category$/); if ($PR !~ /^$valid_pr$/ || $PR < 0) { print html_header("Query PR Database"); - sprint('query_form'); + displayform(); print html_footer(); exit; } # Just in case $PR = int $PR; $PR = quotemeta $PR; if ($category) { $category = quotemeta $category; @query = split /\n/, qx(query-pr.web --full --category=${category} ${PR} 2>&1); } else { @query = split /\n/, qx(query-pr.web --full ${PR} 2>&1); } if (!@query or ($query[0] and $query[0] =~ /^query-pr(:?\.(:?real|web))?: /)) { print html_header("No PRs Matched Query"); - sprint('query_form', $PR || "", $category || ""); + displayform(); print html_footer(); exit; } elsif ($query[0] =~ /^lockf: /) { print html_header("PR Database Busy"); sprint('trylatermsg'); print html_footer(); exit; } if ($f eq "raw") { print "$_\n" foreach (@query); exit; } #----------------------------------------------------------------------- # Process Results from query-pr #----------------------------------------------------------------------- my $section = SECT_HEADER; my $mfield = $fields_multiple[0]; foreach my $line (@query) { my ($k, $v); if ($section == SECT_HEADER) { $section++ if ($line =~ /^\s*$/); next if ($line !~ /^([A-Z][A-Za-z0-9-_.]+): (.*)$/); ($k, $v) = ($1, $2); $k = lc $k; $header{$k} = $v; next; } if ($section == SECT_SFIELDS) { my $i = -1; my $f = 0; next if ($line !~ /^>([A-Z][A-Za-z-]+):\s*(.*)$/); ($k, $v) = ($1, $2); foreach (@fields_single) { if ($k eq $_) { $f = 1; last; } $i++; } if (!$f or $i == $#fields_single) { $section++; next; } $sfields{$k} = $v; next; } if ($section == SECT_MFIELDS) { my $f = 0; if ($line =~ /^>([A-Z][A-Za-z-]+):\s*(.*)$/) { foreach (@fields_multiple) { $f = 1 if $1 eq $_; next; } if ($f) { $mfield = $1; } else { push @{$mfields{$mfield}}, $2; } next; } push @{$mfields{$mfield}}, $line; next; } } $getpatch = 0 if ($getpatch < 0); if ($getpatch > 0) { extractpatch(); exit; } # Construct footer now we have enough information buildfooter(); print html_header(htmlclean("$sfields{'Category'}/$sfields{'Number'}: " . $sfields{'Synopsis'})); sprint('header_thead'); sprint('header_trow', 'From', htmlclean($header{'from'})); sprint('header_trow', 'Date', htmlclean($header{'date'})); sprint('header_trow', 'Subject', htmlclean($header{'subject'})); sprint('header_trow', 'Send-pr version', htmlclean($header{'x-send-pr-version'})); sprint('header_tfoot'); # Single-Line fields sprint('sfields_thead'); foreach (@fields_single) { my ($k, $v); $k = htmlclean($_); $v = htmlclean($sfields{$_}) || ""; $v =~ s/^(\S*).*$/$1\@FreeBSD.org<\/a>/ if ($_ eq "Responsible"); $v = "never" if ($_ eq "Last-Modified" and $v =~ /^\s*$/); next if ($_ =~ /$fields_skip/i); sprint('sfields_trow', $k, $v); } sprint('sfields_tfoot'); # Multiple-Line fields foreach my $field (@fields_multiple) { my $cfound = 0; sprint('mfields_header', $field); if ($field eq "Audit-Trail") { my %block; my $cliphack; my $blockwhy; my ($inblock, $inresponse, $mbreak) = (0, 0, 0); my $url = "${self_url_base}${PR}"; my $outp = ""; my %mime_headers; my $mime_boundary; my $mime_endheader; my $encoding = 0; # Hack for older PRs with no usable delimiter push @{$mfields{'Audit-Trail'}}, $url; $url = quotemeta $url; foreach (@{$mfields{$field}}) { # If we're sure we have a genuine Reply via E-mail block, # allow for a border case, where there is a space rather # than an empty line between the header and body. $_ = "" if ($cliphack && /^ {1,2}$/); $cliphack = 0; if ($inblock == 1 && (/^${url}\s*$/i || /^([A-Za-z_]+-Changed-From-To: .*)$/ || /^(From: )/)) { my $onnextline = ($1 ? 1 : 0); if ($blockwhy) { $blockwhy =~ s/
$//; $blockwhy = htmlparse($blockwhy); } sprint('auditblock_trow', "Why", $blockwhy || ""); undef %block; undef $blockwhy; $inblock = 0; $mbreak = 0; if ($inresponse) { if ($inpatch) { $inpatch = 0; sprint('patchblock_tfoot'); sprint('break'); } sprint('responseblock_textfoot') if ($inresponse > 1); sprint('responseblock_tfoot'); $inresponse = 0; } sprint('auditblock_tfoot'); next unless ($onnextline); } if (/^([A-Za-z_]+)-Changed-([A-Za-z_-]+?): (.*)$/) { my $w = $1; my $k = $2; if ($inresponse) { if ($inpatch) { $inpatch = 0; sprint('patchblock_tfoot'); sprint('break'); } sprint('responseblock_textfoot') if ($inresponse > 1); sprint('responseblock_tfoot'); $inresponse = 0; } if ($inblock == 0) { $block{'changed'} = $w; sprint('auditblock_thead', htmlclean($w)); $inblock = 1; } $block{$k} = $3; if ($k ne "Why") { sprint('auditblock_trow', htmlclean($k), htmlclean($block{$k})); next; } next; } elsif (/^(From|To|Cc|Subject|Date): (.*)$/) { my ($k, $v); $k = htmlclean($1); $v = htmlclean($2); if ($inresponse > 1) { if ($inpatch) { $inpatch = 0; sprint('patchblock_tfoot'); sprint('break'); } $mime_boundary = undef; $mime_endheader = 0; $encoding = 0; sprint('responseblock_textfoot'); sprint('responseblock_tfoot'); } if (!$inresponse || $inresponse > 1) { sprint('responseblock_thead'); } if ($k eq "From" or $k eq "Date") { sprint('responseblock_trow', $k, $v); } $inresponse = 1; $cliphack = 1; next; } elsif (/^\s/ and $inresponse == 1 and !$mbreak) { $cliphack = 1; next; } elsif (/^ (.*)$/) { next if ($inresponse and !$mbreak); if ($inresponse == 1) { sprint('responseblock_texthead'); $inresponse++; } # XXX - use trailing cfound if ($inresponse) { my $txt = $1; if ($txt !~ /^-+$/ && $txt !~ /(?:cut|snip)/i && $txt =~ /^--(\S+)$/) { $mime_boundary = $1 if (!defined $mime_boundary && !$inpatch); if ($1 =~ /^${mime_boundary}(--)?$/) { $mime_boundary = undef if (defined $1); if ($encoding == ENCODING_BASE64 and $outp ne "") { my $patchname; my $dp = $mime_headers{'disposition'}; if ($dp and $dp =~ /.*\bfilename=["']?([A-Za-z0-9\-\.:_]{6,36})["']?.*/) { $patchname = $1; } else { $patchname = "attachment.dat"; } if ($patchname =~ /$binary_filetypes/) { $outp = "(Binary attachment not viewable.)\n"; } else { $outp = decode_base64($outp); } $outp = "--- $patchname begins here ---\n" . $outp . "\n--- $patchname ends here ---\n"; parsepatches($_) foreach (split /\n/, $outp); $outp = ""; } sprint('mime_boundary'); $mime_endheader = 0; $encoding = 0; next; } } if (defined $mime_boundary && !$mime_endheader && !$inpatch) { if ($txt =~ /^Content-([A-Za-z-]{2,}):\s*(.*)\s*$/i) { $mime_headers{lc $1} = $2; next; } elsif ($txt =~ /^\s*(?:file)?name=["']?.*?["']?\s*$/i) { $mime_headers{'disposition'} ||= ""; if ($mime_headers{'disposition'} !~ /(?:file)?name=/) { $mime_headers{'disposition'} .= "; $txt"; } next; } else { $mime_endheader = 1; if ($mime_headers{'transfer-encoding'}) { my $enc = $mime_headers{'transfer-encoding'}; if ($enc =~ /^\s*["']?base64["']?\s*$/i) { $encoding = ENCODING_BASE64; } elsif ($enc =~ /^\s*["']?quoted-printable["']?\s*$/i) { $encoding = ENCODING_QP; } else { $encoding = 0; } } else { $encoding = 0; } } } if ($encoding == ENCODING_BASE64) { $outp .= $txt; next; } elsif ($encoding == ENCODING_QP) { # XXX: lines ending in = should be joined $txt =~ s/=$//; $txt = decode_qp($txt); } if ($txt =~ /^\s*((?:>\s*)+)/) { my $level = $1; $txt =~ s/^((?:>\s*)*={47})(=+\s*)$/$1 $2/; if ($level =~ s/.*?>.*?/./g) { my $i = 0; my @levels = split(/\s*>\s*/, $txt, length $level); my $last = pop @levels; foreach (@levels) { sprint('quote_level_'.(++$i % 2)); $_ = htmlclean($_); $_ = htmlparse($_); print; } print htmlclean($last); sprint('quote_end') while ($i--); sprint('break'); } } else { $patchendhint = 1 if ($txt eq '-- '); if ($inpatch or $txt) { parsepatches($txt) || ($inpatch || sprint('break')); } else { sprint('break'); } } } } elsif (/^$/ and $inresponse and !$mbreak) { # XXX: >line 1 ignored (but not needed) $mbreak = 1; next; } elsif (/^$/) { $mbreak = 0; next; } elsif (!$inblock and $_ !~ /^${url}\s*$/i) { if ($inresponse > 1) { if ($inpatch) { $inpatch = 0; sprint('patchblock_tfoot'); sprint('break'); } sprint('responseblock_textfoot'); sprint('responseblock_tfoot'); } sprint('unexpectedtext_thead'); print htmlclean($_); sprint('unexpectedtext_tfoot'); $inresponse = 0; next; } $cfound = ($_ ? 1 : 0) if (!$cfound); next if (!$cfound); if (!$_) { $cfound++; next; } else { print "\n" while (--$cfound); $cfound = 1; } $_ =~ s/^((?:>\s*)*={47})(=+\s*)$/$1 $2/; $_ = htmlclean($_); $blockwhy .= "$_
\n" if defined($block{'Why'}); } if ($inresponse) { if ($inpatch) { $inpatch = 0; sprint('patchblock_tfoot'); sprint('break'); } sprint('responseblock_textfoot') if ($inresponse > 1); sprint('responseblock_tfoot'); $inresponse = 0; } } elsif ($field eq "Fix") { foreach (@{$mfields{$field}}) { s/\s+$//; $cfound = ($_ ? 1 : 0) if (!$cfound); next if (!$cfound); if (!$_) { $cfound++; next; } else { sprint('break') while (--$cfound > 1); $cfound = 1; } parsepatches($_) || ($inpatch || sprint('break')); } if ($inpatch) { $inpatch = 0; sprint('patchblock_tfoot'); sprint('break'); } } else { foreach (@{$mfields{$field}}) { s/\s+$//; $cfound = ($_ ? 1 : 0) if (!$cfound); next if (!$cfound); if (!$_) { $cfound++; next; } else { sprint('break') while (--$cfound); $cfound = 1; } $_ = htmlclean($_); $_ = htmlparse($_); print; sprint('break'); } sprint('empty') if ($cfound <= 1); } sprint('mfields_footer'); } sprint('html_footerlinks'); print html_footer(); # DoS protection -- apparently. select undef, undef, undef, 0.35 unless (!$iscgi); exit; #----------------------------------------------------------------------- # Func: extractpatch() # Desc: Isolate the requested patch, and print unformatted to STDOUT. #----------------------------------------------------------------------- sub extractpatch { foreach (@{$mfields{'Fix'}}) { return if (parsepatches($_) == -1); } foreach (@{$mfields{'Audit-Trail'}}) { if (s/^ //) { return if (parsepatches($_) == -1); } else { $inpatch = 0; } } } #----------------------------------------------------------------------- # Func: sprint() # Desc: Merge provided list of strings into the desired message and # print the result to STDOUT. #----------------------------------------------------------------------- sub sprint { my $k = shift; my $msg = $fmt{$k}; if (!$msg) { warn "Message format \"$k\" not found"; return; } my $i = 1; foreach (@_) { $msg =~ s/%%()\(${i}\)/$_/g; $i++; } $msg =~ s/%%\([0-9]+\)//g; print $msg; } #----------------------------------------------------------------------- # Func: htmlclean() # Desc: Remove HTML entities from message and return the result. #----------------------------------------------------------------------- sub htmlclean { my $v = shift; return "" if (!$v); $v =~ s/&/&/g; $v =~ s//>/g; return $v; } #----------------------------------------------------------------------- # Func: htmlparse() # Desc: Perform any fancy formatting on the message (e.g. HTML-ify # URLs) and return the result. #----------------------------------------------------------------------- sub htmlparse { my $v = shift; return "" if (!$v); my $iv = 'A-Za-z0-9\-_\/#@\$\\\\'; $v =~ s/(?$1\/$2<\/a>/g; $v =~ s/((?:https?|ftps?):\/\/[^\s\/]+\/[][\w=.,\'\(\)\~\?\!\&\/\%\$\{\}:;@#+-]*)/$1<\/a>/g; $v =~ s/^RCS file: (\/home\/[A-Za-z0-9]+\/(.*?)),v$/RCS file: $1<\/a>,v/; return $v; } #----------------------------------------------------------------------- # Func: buildfooter() # Desc: Build the page footer links section. #----------------------------------------------------------------------- sub buildfooter { my ($newstr, $synopsis, $mail, $replyto, $pr, $cat); $pr = htmlclean($sfields{'Number'}); $cat = htmlclean($sfields{'Category'}); $synopsis = htmlclean($sfields{'Synopsis'}); $mail = $header{'from'}; if ($mail) { $mail =~ s/^\s*(.*)\s*$/$1/; $mail =~ s/.*<(.*)>.*/$1/; $mail =~ s/\s*\(.*\)\s*//; } $replyto = $header{'reply-to'}; if ($replyto) { $replyto =~ s/^\s*(.*)\s*$/$1/; $replyto =~ s/.*<(.*)>.*/$1/; $replyto =~ s/\s*\(.*\)\s*//; } $mail = $replyto if ($replyto); $mail .= '@FreeBSD.org' unless ($mail =~ /@/); $synopsis =~ s/[^a-zA-Z+.@-]/"%" . sprintf("%02X", unpack("C", $&))/eg; $mail =~ s/[^a-zA-Z+.@-]/"%" . sprintf("%02X", unpack("C", $&))/eg; $newstr = "mailto:bug-followup\@FreeBSD.org,${mail}?subject=Re:%20${cat}/${pr}:%20${synopsis}"; $fmt{'html_footerlinks'} =~ s/%%\(maillink\)/${newstr}/g; # Do some other replacements while here $fmt{$_} =~ s/%%\(pr\)/${pr}/g foreach (keys %fmt); } #----------------------------------------------------------------------- # Func: parsepatches() # Desc: Parse lines which might contain patches, adding HTML formatting # if requested. #----------------------------------------------------------------------- { # Local static variables my ($outp, $patchnum, $cfound, $lastcol, $lastrev, $context, $mime_boundary); sub parsepatches { $_ = shift; $outp ||= ""; $patchnum ||= 0; $cfound ||= 0; $context ||= 0; my $plus_s = ''; my $minus_s = ''; my $context_s = ''; my $revinfo_s = ''; my $at_s = ''; my $all_e = ''; my $maxcontext = 3; # XXX: This ought to be dynamic if (!$getpatch) { $cfound = ($_ ? 1 : 0) if (!$cfound); return 0 if (!$cfound); if (!$_) { $cfound++; return 0; } else { sprint('break') while (--$cfound > 1); $cfound = 1; } } if (/^--(\S+)$/ && $getpatch && !$inpatch) { if ($getpatch == $patchnum+1) { $mime_boundary = $1; return 0; } } if (/^Content-([A-Za-z-]{2,}):\s*(.*)\s*$/i && $getpatch) { if (!$inpatch) { my $k = lc $1; my $v = lc $2; if ($getpatch == $patchnum+1 and defined $mime_boundary) { if ($k eq "transfer-encoding" && $v =~ /\bbase64\b/) { $patchnum++; $inpatch |= PATCH_BASE64; } return 0; } } return 0; } if (defined $mime_boundary && /^--${mime_boundary}(?:--)?$/ && $getpatch && ($inpatch & PATCH_BASE64)) { $inpatch = 0; $mime_boundary = undef; if ($outp ne "") { print decode_base64($outp); $outp = ""; } return -1; } if (($inpatch & PATCH_BASE64) && $getpatch) { $outp .= $_; return 1; } if (/^---{1,8}\s?([A-Za-z0-9-_.,:%]+) (begins|starts) here/i && !$inpatch) { $patchnum++; $inpatch |= PATCH_ANY; return 1 if ($getpatch and $patchnum != $getpatch); $lastcol = undef; $lastrev = undef; sprint('patchblock_thead', $patchnum, htmlclean($1)) unless ($getpatch); return 1; } if (/^((?:(?:---|\*\*\*) (?:\S+)\s*(?:Mon|Tue|Wed|Thu|Fri|Sat|Sun) .*)|(diff -.*? .*? .*)|(Index: \S+)|(\*{3} \d+,\d+ \*{4}))$/ && !$inpatch) { $patchnum++; $inpatch |= PATCH_DIFF; return 1 if ($getpatch and $patchnum != $getpatch); $lastcol = undef; $lastrev = undef; sprint('patchblock_thead', $patchnum, "patch-$patchnum.diff") unless ($getpatch); } if (/^# This is a shell archive\. Save it in a file, remove anything before/ && !$inpatch) { $patchnum++; $inpatch |= PATCH_SHAR; return 1 if ($getpatch and $patchnum != $getpatch); $lastcol = undef; $lastrev = undef; sprint('patchblock_thead', $patchnum, "patch-$patchnum.shar") unless ($getpatch); } if (/^---{1,8}\s?[A-Za-z0-9-_.,:%]+ ends here/i && ($inpatch & PATCH_ANY)) { #$inpatch ^= PATCH_ANY; $inpatch = 0; $context = 0; sprint('patchblock_tfoot') unless ($getpatch); return (($patchnum == $getpatch) ? -1 : $inpatch) if ($getpatch); return $inpatch; } if (/^exit$/ && ($inpatch & PATCH_SHAR)) { $inpatch ^= PATCH_SHAR; print; sprint('patchblock_tfoot') unless ($getpatch); return 1; } if (/^begin \d\d\d (.*)/ && !($inpatch & PATCH_UUENC)) { if (!$inpatch) { $patchnum++; return 1 if ($getpatch and $patchnum != $getpatch); } sprint('patchblock_thead', $patchnum, "patch-$patchnum.uu") unless ($getpatch or $inpatch); $inpatch |= PATCH_UUENC; $inpatch |= PATCH_UUENC_BIN if ($1 =~ /$binary_filetypes/); } if ($inpatch) { if ($inpatch & PATCH_UUENC) { if (!$getpatch or $patchnum == $getpatch) { $outp .= "$_\n"; if (/^end$/) { $outp = uudecode($outp) unless (!$getpatch and $inpatch & PATCH_UUENC_BIN); $outp = htmlclean($outp) unless ($getpatch); print $outp; $inpatch ^= PATCH_UUENC; $outp = ""; $inpatch ^= PATCH_UUENC_BIN; # No outer container? sprint('patchblock_tfoot') if (!$inpatch and !$getpatch); return -1; } } } else { if (!$getpatch) { if (!($inpatch & PATCH_ANY)) { if (/^ / or $_ eq "") { $context++; } else { if ($context == $maxcontext and $patchendhint) { $context++; } else { $context = 0; } } if ($context > $maxcontext and $patchendhint) { $context = 0; # Disabled for now, since it doesn't # work quite right. # $inpatch = 0; # sprint('patchblock_tfoot'); # print; # return 0; } } $_=~ s/ $//; $_ = htmlclean($_); $_ = htmlparse($_); while (s/\t/" " x (8 - ((length($`)-1) % 8))/e) {}; # Obfustication coutesy of cdiff s/^(\+.*)$/${plus_s}$1${all_e}/o; s/^(-.*)$/${minus_s}$1${all_e}/o if !s/^(--- \d+,\d+ ----.*)$/${revinfo_s}$1${all_e}/o; s/^(\*\*\* \d+,\d+ *\*\*\*.*)$/${revinfo_s}$1${all_e}/o; s/^(\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*)$/${revinfo_s}$1${all_e}/o; s/^(!.*)$/${context_s}$1${all_e}/o; s/^(@@.*$)/${at_s}$1${all_e}/o; # if (/^1.(\d+)(\s+\(\w+\s+\d{2}-\w{3}-\d{2}\):\s)(.*)/) { # $lastcol = $lastcol || 0; # $lastcol++ if defined($lastrev) && $lastrev != $1; # $lastrev = $1; # $lastcol %= 6; # $_ = "\033[3" . ($lastcol + 1) . "m1.$1$2\033[0m$3\n"; # } } if (!$getpatch or $patchnum == $getpatch) { print; print "\n"; } } } else { if (!$getpatch) { $_ = htmlclean($_); $_ = htmlparse($_); print; } } return $inpatch; } } # ex: ts=4 sw=4