]> git.donarmstrong.com Git - debbugs.git/blob - cgi/smarturl.cgi
merge changes from dla source tree
[debbugs.git] / 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 }