From f4e2c2b7f8d9e7107b109c857251e085290a70cc Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Fri, 9 Jun 2017 12:34:02 -0700 Subject: [PATCH] remove common.pl and old cgi code which is unused --- cgi/.cvsignore | 2 - cgi/bugs-fetch2.pl | 72 ----- cgi/common.pl | 702 --------------------------------------------- cgi/cookies.cgi | 45 --- cgi/smarturl.cgi | 95 ------ 5 files changed, 916 deletions(-) delete mode 100644 cgi/.cvsignore delete mode 100644 cgi/bugs-fetch2.pl delete mode 100644 cgi/common.pl delete mode 100644 cgi/cookies.cgi delete mode 100644 cgi/smarturl.cgi diff --git a/cgi/.cvsignore b/cgi/.cvsignore deleted file mode 100644 index 8c29d42..0000000 --- a/cgi/.cvsignore +++ /dev/null @@ -1,2 +0,0 @@ -*.out -*.trace diff --git a/cgi/bugs-fetch2.pl b/cgi/bugs-fetch2.pl deleted file mode 100644 index 496c092..0000000 --- a/cgi/bugs-fetch2.pl +++ /dev/null @@ -1,72 +0,0 @@ -#!/usr/bin/perl - -require './common.pl'; - -require '/etc/debbugs/config'; - -%map= ($gMirrors); - -my %in = readparse(); - -if ($in{'type'} eq 'ref') { - $_= $in{'ref'}; - s/^\s+//; s/^\#//; s/^\s+//; s/^0*//; s/\s+$//; - - if (m/\D/ || !m/\d/) { - print <Bug number not numeric - -

Invalid input to specific bug fetch form

- -You must type a number, being the bug reference number. -There should be no nondigits in your entry. - -END - exit(0); - } - $suburl= "bugreport.cgi?bug=$_"; -} elsif ($in{'type'} eq 'package') { - $_= $in{'package'}; - s/^\s+//; s/\s+$//; y/A-Z/a-z/; - if (m/^[^0-9a-z]/ || m/[^-+.0-9a-z]/) { - print <Package name contains invalid characters - -

Invalid input to package buglist fetch form

- -You must type a package name. Package names start with a letter -or digit and contain only letters, digits and the characters -- + . (hyphen, plus, full stop). - -END - exit(0); - } - $suburl= "pkgreport.cgi?pkg=$_"; -} else { - print <here. - -(If this link does not work then the bug or package does not exist in -the tracking system any more, or does not yet, or never did.) -END - -exit(0); diff --git a/cgi/common.pl b/cgi/common.pl deleted file mode 100644 index 05b8941..0000000 --- a/cgi/common.pl +++ /dev/null @@ -1,702 +0,0 @@ -#!/usr/bin/perl -w - -use DB_File; -use Fcntl qw/O_RDONLY/; -use Mail::Address; -use MLDBM qw(DB_File Storable); -use POSIX qw/ceil/; - -use URI::Escape; - -use Debbugs::Config qw(:globals :text); -$config_path = '/etc/debbugs'; -$lib_path = '/usr/lib/debbugs'; -#require "$lib_path/errorlib"; - -use Debbugs::Packages qw(:versions :mapping); -use Debbugs::Versions; -use Debbugs::MIME qw(decode_rfc1522); -use Debbugs::Common qw(:util); -use Debbugs::Status qw(:status :read :versions); -use Debbugs::CGI qw(:all); -use Debbugs::Bugs qw(count_bugs); - -$MLDBM::RemoveTaint = 1; - -my %common_bugusertags; -my $common_mindays = 0; -my $common_maxdays = -1; -my $common_archive = 0; -my $common_repeatmerged = 1; -my %common_include = (); -my %common_exclude = (); -my $common_raw_sort = 0; -my $common_bug_reverse = 0; - -my $common_leet_urls = 0; - -my %common_reverse = ( - 'pending' => 0, - 'severity' => 0, -); -my %common = ( - 'show_list_header' => 1, - 'show_list_footer' => 1, -); - -sub exact_field_match { - my ($field, $values, $status) = @_; - my @values = @$values; - my @ret = grep {$_ eq $status->{$field} } @values; - $#ret != -1; -} -sub contains_field_match { - my ($field, $values, $status) = @_; - foreach my $data (@$values) { - return 1 if (index($status->{$field}, $data) > -1); - } - return 0; -} - -sub detect_user_agent { - my $userAgent = $ENV{HTTP_USER_AGENT}; - return { 'name' => 'unknown' } unless defined $userAgent; - return { 'name' => 'links' } if ( $userAgent =~ m,^ELinks,); - return { 'name' => 'lynx' } if ( $userAgent =~ m,^Lynx,); - return { 'name' => 'wget' } if ( $userAgent =~ m,^Wget,); - return { 'name' => 'gecko' } if ( $userAgent =~ m,^Mozilla.* Gecko/,); - return { 'name' => 'ie' } if ( $userAgent =~ m,^.*MSIE.*,); - return { 'name' => 'unknown' }; -} - -my %field_match = ( - 'subject' => \&contains_field_match, - 'tags' => sub { - my ($field, $values, $status) = @_; - my %values = map {$_=>1} @$values; - foreach my $t (split /\s+/, $status->{$field}) { - return 1 if (defined $values{$t}); - } - return 0; - }, - 'severity' => \&exact_field_match, - 'pending' => \&exact_field_match, - 'originator' => \%contains_field_match, - 'forwarded' => \%contains_field_match, - 'owner' => \%contains_field_match, -); -my @common_grouping = ( 'severity', 'pending' ); -my %common_grouping_order = ( - 'pending' => [ qw( pending forwarded pending-fixed fixed done absent ) ], - 'severity' => \@gSeverityList, -); -my %common_grouping_display = ( - 'pending' => 'Status', - 'severity' => 'Severity', -); -my %common_headers = ( - 'pending' => { - "pending" => "outstanding", - "pending-fixed" => "pending upload", - "fixed" => "fixed in NMU", - "done" => "resolved", - "forwarded" => "forwarded to upstream software authors", - "absent" => "not applicable to this version", - }, - 'severity' => \%gSeverityDisplay, -); - -my $common_version; -my $common_dist; -my $common_arch; - -my $debug = 0; -my $use_bug_idx = 0; -my %bugidx; - -sub array_option($) { - my ($val) = @_; - my @vals; - @vals = ( $val ) if (ref($val) eq "" && $val ); - @vals = ( $$val ) if (ref($val) eq "SCALAR" && $$val ); - @vals = @{$val} if (ref($val) eq "ARRAY" ); - return @vals; -} - -sub filter_include_exclude($\%) { - my ($val, $filter_map) = @_; - my @vals = array_option($val); - my @data = map { - if (/^([^:]*):(.*)$/) { if ($1 eq 'subj') { ['subject', $2]; } else { [$1, $2] } } else { ['tags', $_] } - } split /[\s,]+/, join ',', @vals; - foreach my $data (@data) { - &quitcgi("Invalid filter key: '$data->[0]'") if (!exists($field_match{$data->[0]})); - push @{$filter_map->{$data->[0]}}, $data->[1]; - } -} - -sub filter_option($$\%) { - my ($key, $val, $filter_map) = @_; - my @vals = array_option($val); - foreach $val (@vals) { - push @{$filter_map->{$key}}, $val; - } -} - -sub set_option { - my ($opt, $val) = @_; - if ($opt eq "use-bug-idx") { - $use_bug_idx = $val; - if ( $val ) { - $common_headers{pending}{open} = $common_headers{pending}{pending}; - my $bugidx = tie %bugidx, MLDBM => "$gSpoolDir/realtime/bug.idx", O_RDONLY - or quitcgi( "$0: can't open $gSpoolDir/realtime/bug.idx ($!)\n" ); - $bugidx->RemoveTaint(1); - } else { - untie %bugidx; - } - } - if ($opt =~ m/^show_list_(foot|head)er$/) { $common{$opt} = $val; } - if ($opt eq "archive") { $common_archive = $val; } - if ($opt eq "repeatmerged") { $common_repeatmerged = $val; } - if ($opt eq "exclude") { - filter_include_exclude($val, %common_exclude); - } - if ($opt eq "include") { - filter_include_exclude($val, %common_include); - } - if ($opt eq "raw") { $common_raw_sort = $val; } - if ($opt eq "bug-rev") { $common_bug_reverse = $val; } - if ($opt eq "pend-rev") { $common_reverse{pending} = $val; } - if ($opt eq "sev-rev") { $common_reverse{severity} = $val; } - if ($opt eq "pend-exc") { - filter_option('pending', $val, %common_exclude); - } - if ($opt eq "pend-inc") { - filter_option('pending', $val, %common_include); - } - if ($opt eq "sev-exc") { - filter_option('severity', $val, %common_exclude); - } - if ($opt eq "sev-inc") { - filter_option('severity', $val, %common_include); - } - if ($opt eq "version") { $common_version = $val; } - if ($opt eq "dist") { $common_dist = $val; } - if ($opt eq "arch") { $common_arch = $val; } - if ($opt eq "maxdays") { $common_maxdays = $val; } - if ($opt eq "mindays") { $common_mindays = $val; } - if ($opt eq "bugusertags") { %common_bugusertags = %{$val}; } -} - -sub readparse { - my ($key, $val, %ret); - my $in = ""; - if ($#ARGV >= 0) { - $in .= ";" . join("&", map { s/&/%26/g; s/;/%3b/g; $_ } @ARGV); - } - if (defined $ENV{"QUERY_STRING"} && $ENV{"QUERY_STRING"} ne "") { - $in .= ";" . $ENV{QUERY_STRING}; - } - if (defined $ENV{"REQUEST_METHOD"} && $ENV{"REQUEST_METHOD"} eq "POST" - && defined $ENV{"CONTENT_TYPE"} - && $ENV{"CONTENT_TYPE"} eq "application/x-www-form-urlencoded") - { - my $inx; - read(STDIN,$inx,$ENV{CONTENT_LENGTH}); - $in .= ";" . $inx; - } - return unless ($in ne ""); - - if (defined $ENV{"HTTP_COOKIE"}) { - my $x = $ENV{"HTTP_COOKIE"}; - $x =~ s/;\s+/;/g; - $in = "$x;$in"; - } - $in =~ s/&/;/g; - $in =~ s/;;+/;/g; $in =~ s/^;//; $in =~ s/;$//; - foreach (split(/[&;]/,$in)) { - s/\+/ /g; - ($key, $val) = split(/=/,$_,2); - $key=~s/%(..)/pack("c",hex($1))/ge; - $val=~s/%(..)/pack("c",hex($1))/ge; - if ( exists $ret{$key} ) { - if ( !exists $ret{"&$key"} ) { - $ret{"&$key"} = [ $ret{$key} ]; - } - push @{$ret{"&$key"}},$val; - } - $ret{$key}=$val; - } - -$debug = 1 if (defined $ret{"debug"} && $ret{"debug"} eq "aj"); - - $common_leet_urls = 1 - if (defined $ret{"leeturls"} && $ret{"leeturls"} eq "yes"); - - return %ret; -} - -# Generate a comma-separated list of HTML links to each package given in -# $pkgs. $pkgs may be empty, in which case an empty string is returned, or -# it may be a comma-separated list of package names. -sub htmlpackagelinks { - return htmlize_packagelinks(@_); -} - -# Generate a comma-separated list of HTML links to each address given in -# $addresses, which should be a comma-separated list of RFC822 addresses. -# $urlfunc should be a reference to a function like mainturl or submitterurl -# which returns the URL for each individual address. -sub htmladdresslinks { - htmlize_addresslinks(@_); -} - -# Generate a comma-separated list of HTML links to each maintainer given in -# $maints, which should be a comma-separated list of RFC822 addresses. -sub htmlmaintlinks { - my ($prefixfunc, $maints) = @_; - return htmladdresslinks($prefixfunc, \&mainturl, $maints); -} - -sub htmlindexentry { - my $ref = shift; - my %status = %{getbugstatus($ref)}; - return htmlindexentrystatus(%status) if (%status); - return ""; -} - -sub htmlindexentrystatus { - my $s = shift; - my %status = %{$s}; - - my $result = ""; - - if ($status{severity} eq 'normal') { - $showseverity = ''; - } elsif (isstrongseverity($status{severity})) { - $showseverity = "Severity: $status{severity};\n"; - } else { - $showseverity = "Severity: $status{severity};\n"; - } - - $result .= htmlpackagelinks($status{"package"}, 1); - - my $showversions = ''; - if (@{$status{found_versions}}) { - my @found = @{$status{found_versions}}; - local $_; - s{/}{ } foreach @found; - $showversions .= join ', ', map htmlsanit($_), @found; - } - if (@{$status{fixed_versions}}) { - $showversions .= '; ' if length $showversions; - $showversions .= 'fixed: '; - my @fixed = @{$status{fixed_versions}}; - local $_; - s{/}{ } foreach @fixed; - $showversions .= join ', ', map htmlsanit($_), @fixed; - } - $result .= " ($showversions)" if length $showversions; - $result .= ";\n"; - - $result .= $showseverity; - $result .= htmladdresslinks("Reported by: ", \&submitterurl, - $status{originator}); - $result .= ";\nOwned by: " . htmlsanit($status{owner}) - if length $status{owner}; - $result .= ";\nTags: " - . htmlsanit(join(", ", sort(split(/\s+/, $status{tags})))) - . "" - if (length($status{tags})); - my @merged= split(/ /,$status{mergedwith}); - my $mseparator= ";\nmerged with "; - for my $m (@merged) { - $result .= $mseparator."#$m"; - $mseparator= ", "; - } - - if (length($status{done})) { - $result .= ";\nDone: " . htmlsanit($status{done}); - $days = ceil($gRemoveAge - -M buglog($status{id})); - if ($days >= 0) { - $result .= ";\nWill be archived:" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ); - } else { - $result .= ";\nArchived"; - } - } - - unless (length($status{done})) { - if (length($status{forwarded})) { - $result .= ";\nForwarded to " - . maybelink($status{forwarded}); - } - my $daysold = int((time - $status{date}) / 86400); # seconds to days - if ($daysold >= 7) { - my $font = ""; - my $efont = ""; - $font = "em" if ($daysold > 30); - $font = "strong" if ($daysold > 60); - $efont = "" if ($font); - $font = "<$font>" if ($font); - - my $yearsold = int($daysold / 365); - $daysold -= $yearsold * 365; - - $result .= ";\n $font"; - my @age; - push @age, "1 year" if ($yearsold == 1); - push @age, "$yearsold years" if ($yearsold > 1); - push @age, "1 day" if ($daysold == 1); - push @age, "$daysold days" if ($daysold > 1); - $result .= join(" and ", @age); - $result .= " old$efont"; - } - } - - $result .= "."; - - return $result; -} - -sub urlargs { - my $args = ''; - $args .= ";archive=yes" if $common_archive; - $args .= ";repeatmerged=no" unless $common_repeatmerged; - $args .= ";mindays=${common_mindays}" unless $common_mindays == 0; - $args .= ";maxdays=${common_maxdays}" unless $common_maxdays == -1; - $args .= ";version=$common_version" if defined $common_version; - $args .= ";dist=$common_dist" if defined $common_dist; - $args .= ";arch=$common_arch" if defined $common_arch; - return $args; -} - -sub pkgurl { pkg_url(pkg => $_[0] || ""); } -sub srcurl { pkg_url(src => $_[0] || ""); } -sub tagurl { pkg_url(tag => $_[0] || ""); } - -sub pkg_etc_url { - my $ref = shift; - my $code = shift; - if ($common_leet_urls) { - $code = "package" if ($code eq "pkg"); - $code = "source" if ($code eq "src"); - return urlsanit("/x/$code/$ref"); - } else { - my $addurlargs = shift || 1; - my $params = "$code=$ref"; - $params .= urlargs() if $addurlargs; - return urlsanit("pkgreport.cgi" . "?" . $params); - } -} - -sub urlsanit { - my $url = shift; - $url =~ s/%/%25/g; - $url =~ s/#/%23/g; - $url =~ s/\+/%2b/g; - my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot'); - $url =~ s/([<>&"])/\&$saniarray{$1};/g; - return $url; -} - -sub htmlsanit { - my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot'); - my $in = shift || ""; - $in =~ s/([<>&"])/\&$saniarray{$1};/g; - return $in; -} - -sub bugurl { - my $ref = shift; - my $params = "bug=$ref"; - my $filename = ''; - - if ($common_leet_urls) { - my $msg = ""; - my $mbox = ""; - my $att = ""; - foreach my $val (@_) { - $mbox = "/mbox" if ($val eq "mbox"); - $msg = "/$1" if ($val =~ /^msg=([0-9]+)/); - $att = "/$1" if ($val =~ /^att=([0-9]+)/); - $filename = "/$1" if ($val =~ /^filename=(.*)$/); - } - my $ext = ""; - if ($mbox ne "") { - $ext = $mbox; - } elsif ($att ne "") { - $ext = "$att$filename"; - } - return urlsanit("/x/$ref$msg$ext"); - } else { - foreach my $val (@_) { - $params .= ";mbox=yes" if ($val eq "mbox"); - $params .= ";msg=$1" if ($val =~ /^msg=([0-9]+)/); - $params .= ";att=$1" if ($val =~ /^att=([0-9]+)/); - $filename = $1 if ($val =~ /^filename=(.*)$/); - $params .= ";archive=yes" if (!$common_archive && $val =~ /^archive.*$/); - } - $params .= ";archive=yes" if ($common_archive); - $params .= ";repeatmerged=no" unless ($common_repeatmerged); - - my $pathinfo = ''; - $pathinfo = '/'.uri_escape($filename) if $filename ne ''; - - return urlsanit("bugreport.cgi" . $pathinfo . "?" . $params); - } -} - -sub dlurl { bugurl(@_); } -sub mboxurl { return bugurl($ref, "mbox"); } - -sub allbugs { - return @{getbugs(sub { 1 })}; -} - -sub bugmatches { - my ($hash, $status) = @_; - foreach my $key( keys( %$hash ) ) { - my $value = $hash->{$key}; - my $sub = $field_match{$key}; - return 1 if ($sub->($key, $value, $status)); - } - return 0; -} -sub bugfilter { - my ($bug, $status,$seen_merged,$common_include,$common_exclude,$repeat_merged,) = @_; - #our (%seenmerged); - if ($common_include) { - return 1 if (!bugmatches($common_include, $status)); - } - if ($common_exclude) { - return 1 if (bugmatches($common_exclude, $status)); - } - my @merged = sort {$a<=>$b} $bug, split(/ /, $status{mergedwith}); - my $daysold = int((time - $status{date}) / 86400); # seconds to days - return 1 unless ($common_mindays <= $daysold); - return 1 unless ($common_maxdays == -1 || $daysold <= $common_maxdays); - return 1 unless ($common_repeatmerged || !$seenmerged{$merged[0]}); - $seenmerged{$merged[0]} = 1; - return 0; -} - -sub htmlizebugs { - $b = $_[0]; - my @bugs = @$b; - my $anydone = 0; - - my @status = (); - my %count; - my $header = ''; - my $footer = ''; - - if (@bugs == 0) { - return "

No reports found!

\n"; - } - - if ( $common_bug_reverse ) { - @bugs = sort {$b<=>$a} @bugs; - } else { - @bugs = sort {$a<=>$b} @bugs; - } - my %seenmerged; - foreach my $bug (@bugs) { - my %status = %{getbugstatus($bug)}; - next unless %status; - next if bugfilter($bug, %status); - - my $html = sprintf "
  • #%d: %s\n
    ", - bugurl($bug), $bug, htmlsanit($status{subject}); - $html .= htmlindexentrystatus(\%status) . "\n"; - my $key = join( '_', map( {$status{$_}} @common_grouping ) ); - $section{$key} .= $html; - $count{"_$key"}++; - foreach my $grouping ( @common_grouping ) { - $count{"${grouping}_$status{$grouping}"}++; - } - $anydone = 1 if $status{pending} eq 'done'; - push @status, [ $bug, \%status, $html ]; - } - - my $result = ""; - if ($common_raw_sort) { - $result .= "
      \n" . join("", map( { $_->[ 2 ] } @status ) ) . "
    \n"; - } else { - my (@order, @headers); - for( my $i = 0; $i < @common_grouping; $i++ ) { - my $grouping_name = $common_grouping[ $i ]; - my @items = @{ $common_grouping_order{ $grouping_name } }; - @items = reverse( @items ) if ( $common_reverse{ $grouping_name } ); - my @neworder = (); - my @newheaders = (); - if ( @order ) { - foreach my $grouping ( @items ) { - push @neworder, map( { "${_}_$grouping" } @order ); - push @newheaders, map( { "$_ - $common_headers{$grouping_name}{$grouping}" } @headers ); - } - @order = @neworder; - @headers = @newheaders; - } else { - push @order, @items; - push @headers, map( { $common_headers{$common_grouping[$i]}{$_} } @items ); - } - } - $header .= "
      \n"; - for ( my $i = 0; $i < @order; $i++ ) { - my $order = $order[ $i ]; - next unless defined $section{$order}; - my $count = $count{"_$order"}; - my $bugs = $count == 1 ? "bug" : "bugs"; - $header .= "
    • $headers[$i] ($count $bugs)
      • \n"; - } - $header .= "
    \n"; - for ( my $i = 0; $i < @order; $i++ ) { - my $order = $order[ $i ]; - next unless defined $section{$order}; - if ($common{show_list_header}) { - my $count = $count{"_$order"}; - my $bugs = $count == 1 ? "bug" : "bugs"; - $result .= "

    $headers[$i] ($count $bugs)

    \n"; - } else { - $result .= "

    $headers[$i]

    \n"; - } - $result .= "
      \n"; - $result .= $section{$order}; - $result .= "
    \n"; - } - $footer .= "
      \n"; - foreach my $grouping ( @common_grouping ) { - my $local_result = ''; - foreach my $key ( @{$common_grouping_order{ $grouping }} ) { - my $count = $count{"${grouping}_$key"}; - next if !$count; - $local_result .= "
    • $count $common_headers{$grouping}{$key}
      • \n"; - } - if ( $local_result ) { - $footer .= "
    • $common_grouping_display{$grouping}
        \n$local_result
      • \n"; - } - } - $footer .= "
    \n"; - } - - $result = $header . $result if ( $common{show_list_header} ); - $result .= $gHTMLExpireNote if $gRemoveAge and $anydone; - $result .= "
    " . $footer if ( $common{show_list_footer} ); - return $result; -} - -sub countbugs { - return count_bugs(function=>shift, - archive => $commonarchive, - ); -} - -sub getbugs { - my $bugfunc = shift; - my $opt = shift; - - my @result = (); - - my $fastidx; - if (!defined $opt) { - # leave $fastidx undefined; - } elsif (!$common_archive) { - $fastidx = "$gSpoolDir/by-$opt.idx"; - } else { - $fastidx = "$gSpoolDir/by-$opt-arc.idx"; - } - - if (defined $fastidx && -e $fastidx) { - my %lookup; -print STDERR "optimized\n" if ($debug); - tie %lookup, MLDBM => $fastidx, O_RDONLY - or die "$0: can't open $fastidx ($!)\n"; - while ($key = shift) { - my $bugs = $lookup{$key}; - if (defined $bugs) { - push @result, keys %{$bugs}; - } - } - untie %lookup; -print STDERR "done optimized\n" if ($debug); - } else { - if ( $common_archive ) { - open I, "<$gSpoolDir/index.archive" - or &quitcgi("$gSpoolDir/index.archive: $!"); - } else { - open I, "<$gSpoolDir/index.db" - or &quitcgi("$gSpoolDir/index.db: $!"); - } - while() { - if (m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/) { - if ($bugfunc->(pkg => $1, bug => $2, status => $4, - submitter => $5, severity => $6, tags => $7)) - { - push (@result, $2); - } - } - } - close I; - } - @result = sort {$a <=> $b} @result; - return \@result; -} - -sub emailfromrfc822 { - my $email = shift; - $email =~ s/\s*\(.*\)\s*//; - $email = $1 if ($email =~ m/<(.*)>/); - return $email; -} - -sub maintencoded { - my $input = shift; - my $encoded = ''; - - while ($input =~ m/\W/) { - $encoded.=$`.sprintf("-%02x_",unpack("C",$&)); - $input= $'; - } - - $encoded.= $input; - $encoded =~ s/-2e_/\./g; - $encoded =~ s/^([^,]+)-20_-3c_(.*)-40_(.*)-3e_/$1,$2,$3,/; - $encoded =~ s/^(.*)-40_(.*)-20_-28_([^,]+)-29_$/,$1,$2,$3/; - $encoded =~ s/-20_/_/g; - $encoded =~ s/-([^_]+)_-/-$1/g; - return $encoded; -} - - -sub getbugstatus { - my ($bug) = @_; - return get_bug_status(bug => $bug, - $use_bug_idx?(bug_index => \%bugidx):(), - usertags => \%common_bugusertags, - (defined $common_dist)?(dist => $common_dist):(), - (defined $common_version)?(version => $common_version):(), - (defined $common_arch)?(arch => $common_arch):(), - ); -} - -sub getversiondesc { - my $pkg = shift; - - if (defined $common_version) { - return "version $common_version"; - } elsif (defined $common_dist) { - my @distvers = getversions($pkg, $common_dist, $common_arch); - @distvers = sort @distvers; - local $" = ', '; - if (@distvers > 1) { - return "versions @distvers"; - } elsif (@distvers == 1) { - return "version @distvers"; - } - } - - return undef; -} - -1; diff --git a/cgi/cookies.cgi b/cgi/cookies.cgi deleted file mode 100644 index 20a9810..0000000 --- a/cgi/cookies.cgi +++ /dev/null @@ -1,45 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use POSIX qw(strftime); -require './common.pl'; - -my $oldcookies = $ENV{"HTTP_COOKIE"}; -$ENV{"HTTP_COOKIE"} = ""; -my %param = readparse(); - -my %oldcookies = map { ($1, $2) if (m/(.*)=(.*)/) } split /[;&]/, $oldcookies; - -my $clear = (defined $param{"clear"} && $param{"clear"} eq "yes"); -my @time_now = gmtime(time()); -my $time_future = strftime("%a, %d-%b-%Y %T GMT", - 59, 59, 23, 31, 11, $time_now[5]+10); -my $time_past = strftime("%a, %d-%b-%Y %T GMT", - 59, 59, 23, 31, 11, $time_now[5]-10); - -my @cookie_options = qw(repeatmerged terse reverse trim oldview); - -print "Content-Type: text/html; charset=utf-8\n"; - -for my $c (@cookie_options) { - if (defined $param{$c}) { - printf "Set-Cookie: %s=%s; expires=%s; domain=%s; path=/\n", - $c, $param{$c}, $time_future, "bugs.debian.org"; - } elsif ($clear) { - printf "Set-Cookie: %s=%s; expires=%s; domain=%s; path=/\n", - $c, "", $time_past, "bugs.debian.org"; - } -} -print "\n"; -print "

    Oldcookies $oldcookies .\n"; -print "

    Cookies set!\n"; -for my $c (@cookie_options) { - my $old = $oldcookies{$c} || "unset"; - if (defined $param{$c}) { - printf "
    Set %s=%s (was %s)\n", $c, $param{$c}, $old; - } elsif ($clear) { - printf "
    Cleared %s (was %s)\n", $c, $old; - } else { - printf "
    Didn't touch %s (was %s; use clear=yes to clear)\n", $c, $old; - } -} diff --git a/cgi/smarturl.cgi b/cgi/smarturl.cgi deleted file mode 100644 index 4e6056a..0000000 --- a/cgi/smarturl.cgi +++ /dev/null @@ -1,95 +0,0 @@ -#!/usr/bin/perl -wT - -package debbugs; - -use strict; - -#require '/usr/lib/debbugs/errorlib'; -require './common.pl'; - -require '/etc/debbugs/config'; -require '/etc/debbugs/text'; - -use vars qw($gPackagePages $gWebDomain); - -if (defined $ENV{REQUEST_METHOD} and $ENV{REQUEST_METHOD} eq 'HEAD') { - print "Content-Type: text/html; charset=utf-8\n\n"; - exit 0; -} - -my $path = $ENV{PATH_INFO}; - -if ($path =~ m,^/(\d+)(/(\d+)(/.*)?)?$,) { - my $bug = $1; - my $msg = $3; - my $rest = $4; - - my @args = ("bug=$bug"); - push @args, "msg=$msg" if (defined $msg); - if ($rest eq "") { - 1; - } elsif ($rest eq "/mbox") { - push @args, "mbox=yes"; - } elsif ($rest =~ m,^/att/(\d+)(/[^/]+)?$,) { - push @args, "att=$1"; - push @args, "filename=$2" if (defined $2); - } else { - bad_url(); - } - - { $ENV{"PATH"}="/bin"; exec "./bugreport.cgi", "leeturls=yes", @args; } - - print "Content-Type: text/html; charset=utf-8\n\n"; - print "

    Couldn't execute bugreport.cgi!!"; - exit(0); -} else { - my $suite; - my $arch; - if ($path =~ m,^/suite/([^/]*)(/.*)$,) { - $suite = $1; $path = $2; - } elsif ($path =~ m,^/arch/([^/]*)(/.*)$,) { - $arch = $1; $path = $2; - } elsif ($path =~ m,^/suite-arch/([^/]*)/([^/]*)(/.*)$,) { - $suite = $1; $arch = $2; $path = $3; - } - - my $type; - my $what; - my $selection; - if ($path =~ m,^/(package|source|maint|submitter|severity|tag|user-tag)/([^/]+)(/(.*))?$,) { - $type = $1; $what = $2; $selection = $4 || ""; - if ($selection ne "") { - unless ($type =~ m,^(package|source|user-tag)$,) { - bad_url(); - } - } - my @what = split /,/, $what; - my @selection = split /,/, $selection; - my $typearg = $type; - $typearg = "pkg" if ($type eq "package"); - $typearg = "src" if ($type eq "source"); - - my @args = (); - push @args, $typearg . "=" . join(",", @what); - push @args, "version=" . join(",", @selection) - if ($type eq "package" and $#selection >= 0); - push @args, "utag=" . join(",", @selection) - if ($type eq "user-tag" and $#selection >= 0); - push @args, "arch=" . $arch if (defined $arch); - push @args, "suite=" . $suite if (defined $suite); - - { $ENV{"PATH"}="/bin"; exec "./pkgreport.cgi", "leeturls=yes", @args } - - print "Content-Type: text/html; charset=utf-8\n\n"; - print "

    Couldn't execute pkgreport.cgi!!"; - exit(0); - } else { - bad_url(); - } -} - -sub bad_url { - print "Content-Type: text/html; charset=utf-8\n\n"; - print "

    Bad URL :(\n"; - exit(0); -} -- 2.39.2