cgi/bugs-fetch2.pl

   1 #!/usr/bin/perl
   2
   3 require './common.pl';
   4
   5 require '/etc/debbugs/config';
   6
   7 %map= ($gMirrors);
   8
   9 my %in = readparse();
  10
  11 if ($in{'type'} eq 'ref') {
  12     $_= $in{'ref'};
  13     s/^\s+//; s/^\#//; s/^\s+//; s/^0*//; s/\s+$//;
  14
  15     if (m/\D/ || !m/\d/) {
  16         print <<END;
  17 Content-Type: text/html
  18
  19 <html><head><title>Bug number not numeric</title>
  20 </head><body>
  21 <h1>Invalid input to specific bug fetch form</h1>
  22
  23 You must type a number, being the bug reference number.
  24 There should be no nondigits in your entry.
  25 </html>
  26 END
  27         exit(0);
  28     }
  29     $suburl= "bugreport.cgi?bug=$_";
  30 } elsif ($in{'type'} eq 'package') {
  31     $_= $in{'package'};
  32     s/^\s+//; s/\s+$//; y/A-Z/a-z/;
  33     if (m/^[^0-9a-z]/ || m/[^-+.0-9a-z]/) {
  34         print <<END;
  35 Content-Type: text/html
  36
  37 <html><head><title>Package name contains invalid characters</title>
  38 </head><body>
  39 <h1>Invalid input to package buglist fetch form</h1>
  40
  41 You must type a package name.  Package names start with a letter
  42 or digit and contain only letters, digits and the characters
  43 - + . (hyphen, plus, full stop).
  44 </html>
  45 END
  46         exit(0);
  47     }
  48     $suburl= "pkgreport.cgi?pkg=$_";
  49 } else {
  50     print <<END;
  51 Content-Type: text/plain
  52
  53 Please use the real DBC_WHO form. (invalid type value)
  54 END
  55     exit(0);
  56 }
  57
  58 $base= $gCGIDomain;
  59
  60 $newurl= "http://$base/$suburl";
  61 print <<END;
  62 Status: 301 Redirect
  63 Location: $newurl
  64
  65 The bug report data you are looking for ($suburl)
  66 is available <A href="$newurl">here</A>.
  67
  68 (If this link does not work then the bug or package does not exist in
  69 the tracking system any more, or does not yet, or never did.)
  70 END
  71
  72 exit(0);