[project @ 2005-08-11 08:57:00 by ajt]

Improvements to the CGIs, in particular for moving towards some sane URLs
that people needn't be ashamed to tell other people. Detailed changes from
the darcs history:

  * allow running cgis from command line (./bugreport.cgi bug=12345)
  * support for getting params from cookies
  * add cookie setter (cookie.cgi, it's pretty lame)
  * initial smart url parser (smarturl.cgi)
  * make smarturl actually display bug info
  * move per-msg mbox handling into bugurl()
  * deprecate mboxurl in favour of bugurl(..., "mbox")
  * deprecate dlurl in favour of bugurl too
  * replace & in urls with ; so it doesn't get munged by urlsanit :-/
  * merge all the pkgreport *url() functions
  * initial support for internal links in leet urls
  * make bug urls leet too
  * cope with attachment filenames, single messages as mbox

"Leet" URLs look like "/x/123456" and "/x/package/dpkg" etc.

diff --git a/cgi/bugreport.cgi b/cgi/bugreport.cgi
index 9c8e8135b0ed8f6d2363e295cd87892db484d35b..a05aa25a58b121411b452b8f8c60e15450d18ee5 100755 (executable)
--- a/cgi/bugreport.cgi
+++ b/cgi/bugreport.cgi
@@ -50,7 +50,7 @@ set_option('repeatmerged', $repeatmerged);
 
 my $buglog = buglog($ref);
 
-if ($ENV{REQUEST_METHOD} eq 'HEAD' and not defined($att) and not $mbox) {
+if (defined $ENV{REQUEST_METHOD} and $ENV{REQUEST_METHOD} eq 'HEAD' and not defined($att) and not $mbox) {
     print "Content-Type: text/html; charset=utf-8\n";
     my @stat = stat $buglog;
     if (@stat) {
@@ -103,7 +103,7 @@ sub display_entity ($$$$\$\@) {
        push @dlargs, "filename=$filename" if $filename ne '';
        my $printname = $filename;
        $printname = 'Message part ' . ($#$attachments + 1) if $filename eq '';
-       $$this .= '[<a href="' . dlurl(@dlargs) . qq{">$printname</a> } .
+       $$this .= '[<a href="' . bugurl(@dlargs) . qq{">$printname</a> } .
                  "($type, $disposition)]\n\n";
 
        if ($msg and defined($att) and $att eq $#$attachments) {
@@ -375,7 +375,7 @@ sub handle_record{
          # Add links to the cloned bugs
          $output =~ s{(Bug )(\d+)( cloned as bugs? )(\d+)(?:\-(\d+)|)}{$1.bug_links($2).$3.bug_links($4,$5)}eo;
          $output .= '<a href="' . bugurl($ref, 'msg='.($msg_number+1)) . '">Full text</a> and <a href="' .
-              bugurl($ref, 'msg='.($msg_number+1)) . '&mbox=yes">rfc822 format</a> available.</em>';
+              bugurl($ref, 'msg='.($msg_number+1), 'mbox') . '">rfc822 format</a> available.</em>';
      }
      elsif (/recips/) {
          my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im;
@@ -385,7 +385,7 @@ sub handle_record{
          elsif (defined $msg_id) {
               $$seen_msg_ids{$msg_id} = 1;
          }
-         $output .= 'View this message in <a href="' . bugurl($ref, "msg=$msg_number") . '&mbox=yes">rfc822 format</a></em>';
+         $output .= 'View this message in <a href="' . bugurl($ref, "msg=$msg_number", "mbox") . '">rfc822 format</a></em>';
          $output .= '<pre class="message">' .
               handle_email_message($record->{text},
                                    ref        => $bug_number,
@@ -489,7 +489,7 @@ print "<H1>" . "$debbugs::gProject $debbugs::gBug report logs - <A HREF=\"mailto
       "<BR>" . $title . "</H1>\n";
 
 print "$descriptivehead\n";
-printf "<p>View this report as an <a href=\"%s\">mbox folder</a>.</p>\n", mboxurl($ref);
+printf "<p>View this report as an <a href=\"%s\">mbox folder</a>.</p>\n", bugurl($ref, "mbox");
 print "<HR>";
 print "$log";
 print "<HR>";

diff --git a/cgi/common.pl b/cgi/common.pl
index 6270f89cbdda4b882dfeec9c521390e49b80bfef..06357687d06799bd07973eaabfd6da443d98bea9 100644 (file)
--- a/cgi/common.pl
+++ b/cgi/common.pl
@@ -25,6 +25,8 @@ 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,
@@ -178,7 +180,9 @@ sub set_option {
 
 sub readparse {
     my ($in, $key, $val, %ret);
-    if (defined $ENV{"QUERY_STRING"} && $ENV{"QUERY_STRING"} ne "") {
+    if ($#ARGV >= 0) {
+        $in = join("&", map { s/&/%26/g; s/;/%3b/g; $_ } @ARGV);
+    } elsif (defined $ENV{"QUERY_STRING"} && $ENV{"QUERY_STRING"} ne "") {
         $in=$ENV{QUERY_STRING};
     } elsif(defined $ENV{"REQUEST_METHOD"}
         && $ENV{"REQUEST_METHOD"} eq "POST")
@@ -187,6 +191,11 @@ sub readparse {
     } else {
         return;
     }
+    if (defined $ENV{"HTTP_COOKIE"}) {
+        my $x = $ENV{"HTTP_COOKIE"};
+       $x =~ s/;\s+/;/g;
+        $in = "$x;$in";
+    }
     foreach (split(/[&;]/,$in)) {
         s/\+/ /g;
         ($key, $val) = split(/=/,$_,2);
@@ -200,7 +209,12 @@ sub readparse {
        }
         $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;
 }
 
@@ -391,47 +405,32 @@ sub htmlindexentrystatus {
 
 sub urlargs {
     my $args = '';
-    $args .= "&archive=yes" if $common_archive;
-    $args .= "&repeatmerged=no" unless $common_repeatmerged;
-    $args .= "&version=$common_version" if defined $common_version;
-    $args .= "&dist=$common_dist" if defined $common_dist;
-    $args .= "&arch=$common_arch" if defined $common_arch;
+    $args .= ";archive=yes" if $common_archive;
+    $args .= ";repeatmerged=no" unless $common_repeatmerged;
+    $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 submitterurl {
-    my $ref = shift || "";
-    my $params = "submitter=" . emailfromrfc822($ref);
-    $params .= urlargs();
-    return urlsanit("pkgreport.cgi" . "?" . $params);
-}
-
-sub mainturl {
-    my $ref = shift || "";
-    my $params = "maint=" . emailfromrfc822($ref);
-    $params .= urlargs();
-    return urlsanit("pkgreport.cgi" . "?" . $params);
-}
+sub submitterurl { pkg_etc_url(emailfromrfc822($_[0] || ""), "submitter"); }
+sub mainturl { pkg_etc_url(emailfromrfc822($_[0] || ""), "maint"); }
+sub pkgurl { pkg_etc_url($_[0] || "", "pkg"); }
+sub srcurl { pkg_etc_url($_[0] || "", "src"); }
+sub tagurl { pkg_etc_url($_[0] || "", "tag"); }
 
-sub pkgurl {
+sub pkg_etc_url {
     my $ref = shift;
-    my $params = "pkg=$ref";
-    $params .= urlargs();
-    return urlsanit("pkgreport.cgi" . "?" . "$params");
-}
-
-sub srcurl {
-    my $ref = shift;
-    my $params = "src=$ref";
-    $params .= urlargs();
-    return urlsanit("pkgreport.cgi" . "?" . "$params");
-}
-
-sub tagurl {
-    my $ref = shift;
-    my $params = "tag=$ref";
-    $params .= urlargs();
-    return urlsanit("pkgreport.cgi" . "?" . "$params");
+    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 $params = "$code=$ref";
+        $params .= urlargs();
+        return urlsanit("pkgreport.cgi" . "?" . $params);
+    }
 }
 
 sub urlsanit {
@@ -463,35 +462,45 @@ sub maybelink {
 sub bugurl {
     my $ref = shift;
     my $params = "bug=$ref";
-    foreach my $val (@_) {
-       $params .= "\&msg=$1" if ($val =~ /^msg=([0-9]+)/);
-       $params .= "\&archive=yes" if (!$common_archive && $val =~ /^archive.*$/);
-    }
-    $params .= "&archive=yes" if ($common_archive);
-    $params .= "&repeatmerged=no" unless ($common_repeatmerged);
+    my $filename = '';
 
-    return urlsanit("bugreport.cgi" . "?" . "$params");
-}
+    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);
 
-sub dlurl {
-    my $ref = shift;
-    my $params = "bug=$ref";
-    my $filename = '';
-    foreach my $val (@_) {
-       $params .= "\&$1=$2" if ($val =~ /^(msg|att)=([0-9]+)/);
-       $filename = $1 if ($val =~ /^filename=(.*)$/);
-    }
-    $params .= "&archive=yes" if ($common_archive);
-    my $pathinfo = '';
-    $pathinfo = '/'.uri_escape($filename) if $filename ne '';
+        my $pathinfo = '';
+        $pathinfo = '/'.uri_escape($filename) if $filename ne '';
 
-    return urlsanit("bugreport.cgi$pathinfo?$params");
+        return urlsanit("bugreport.cgi" . $pathinfo . "?" . $params);
+    }
 }
 
-sub mboxurl {
-    my $ref = shift;
-    return urlsanit("bugreport.cgi" . "?" . "bug=$ref&mbox=yes");
-}
+sub dlurl { bugurl(@_); }
+sub mboxurl { return bugurl($ref, "mbox"); }
 
 sub allbugs {
     return @{getbugs(sub { 1 })};

diff --git a/cgi/cookies.cgi b/cgi/cookies.cgi
new file mode 100644 (file)
index 0000000..370b0bc
--- /dev/null
+++ b/cgi/cookies.cgi
@@ -0,0 +1,40 @@
+#!/usr/bin/perl -w
+
+use strict;
+use POSIX qw(strftime);
+require './common.pl';
+
+$ENV{"HTTP_COOKIES"} = "";
+my %param = readparse();
+
+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);
+
+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 "<p>Cookies set!\n";
+for my $c (@cookie_options) {
+    if (defined $param{$c}) {
+        printf "<br>Set %s=%s\n", $c, $param{$c};
+    } elsif ($clear) {
+        printf "<br>Cleared %s\n", $c;
+    } else {
+        printf "<br>Didn't touch %s (use clear=yes to clear)\n", $c;
+    }
+}

diff --git a/cgi/smarturl.cgi b/cgi/smarturl.cgi
new file mode 100644 (file)
index 0000000..f911d10
--- /dev/null
+++ b/cgi/smarturl.cgi
@@ -0,0 +1,96 @@
+#!/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};
+my %param = readparse();
+
+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 "<p>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 "<p>Couldn't execute pkgreport.cgi!!";
+        exit(0);
+    } else {
+        bad_url();
+    }
+}
+
+sub bad_url {
+    print "Content-Type: text/html; charset=utf-8\n\n";
+    print "<p>Bad URL :(\n";
+    exit(0);
+}