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