cgi/smarturl.cgi

   1 #!/usr/bin/perl -wT
   2
   3 package debbugs;
   4
   5 use strict;
   6
   7 #require '/usr/lib/debbugs/errorlib';
   8 require './common.pl';
   9
  10 require '/etc/debbugs/config';
  11 require '/etc/debbugs/text';
  12
  13 use vars qw($gPackagePages $gWebDomain);
  14
  15 if (defined $ENV{REQUEST_METHOD} and $ENV{REQUEST_METHOD} eq 'HEAD') {
  16     print "Content-Type: text/html; charset=utf-8\n\n";
  17     exit 0;
  18 }
  19
  20 my $path = $ENV{PATH_INFO};
  21
  22 if ($path =~ m,^/(\d+)(/(\d+)(/.*)?)?$,) {
  23     my $bug = $1;
  24     my $msg = $3;
  25     my $rest = $4;
  26
  27     my @args = ("bug=$bug");
  28     push @args, "msg=$msg" if (defined $msg);
  29     if ($rest eq "") {
  30         1;
  31     } elsif ($rest eq "/mbox") {
  32         push @args, "mbox=yes";
  33     } elsif ($rest =~ m,^/att/(\d+)(/[^/]+)?$,) {
  34         push @args, "att=$1";
  35         push @args, "filename=$2" if (defined $2);
  36     } else {
  37         bad_url();
  38     }
  39
  40     { $ENV{"PATH"}="/bin"; exec "./bugreport.cgi", "leeturls=yes", @args; }
  41
  42     print "Content-Type: text/html; charset=utf-8\n\n";
  43     print "<p>Couldn't execute bugreport.cgi!!";
  44     exit(0);
  45 } else {
  46     my $suite;
  47     my $arch;
  48     if ($path =~ m,^/suite/([^/]*)(/.*)$,) {
  49         $suite = $1; $path = $2;
  50     } elsif ($path =~ m,^/arch/([^/]*)(/.*)$,) {
  51         $arch = $1; $path = $2;
  52     } elsif ($path =~ m,^/suite-arch/([^/]*)/([^/]*)(/.*)$,) {
  53         $suite = $1; $arch = $2; $path = $3;
  54     }
  55
  56     my $type;
  57     my $what;
  58     my $selection;
  59     if ($path =~ m,^/(package|source|maint|submitter|severity|tag|user-tag)/([^/]+)(/(.*))?$,) {
  60         $type = $1; $what = $2; $selection = $4 || "";
  61         if ($selection ne "") {
  62             unless ($type =~ m,^(package|source|user-tag)$,) {
  63                 bad_url();
  64             }
  65         }
  66         my @what = split /,/, $what;
  67         my @selection = split /,/, $selection;
  68         my $typearg = $type;
  69         $typearg = "pkg" if ($type eq "package");
  70         $typearg = "src" if ($type eq "source");
  71
  72         my @args = ();
  73         push @args, $typearg . "=" . join(",", @what);
  74         push @args, "version=" . join(",", @selection)
  75                 if ($type eq "package" and $#selection >= 0);
  76         push @args, "utag=" . join(",", @selection)
  77                 if ($type eq "user-tag" and $#selection >= 0);
  78         push @args, "arch=" . $arch if (defined $arch);
  79         push @args, "suite=" . $suite if (defined $suite);
  80
  81         { $ENV{"PATH"}="/bin"; exec "./pkgreport.cgi", "leeturls=yes", @args }
  82
  83         print "Content-Type: text/html; charset=utf-8\n\n";
  84         print "<p>Couldn't execute pkgreport.cgi!!";
  85         exit(0);
  86     } else {
  87         bad_url();
  88     }
  89 }
  90
  91 sub bad_url {
  92     print "Content-Type: text/html; charset=utf-8\n\n";
  93     print "<p>Bad URL :(\n";
  94     exit(0);
  95 }