cgi/cookies.cgi

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use POSIX qw(strftime);
   5 require './common.pl';
   6
   7 my $oldcookies = $ENV{"HTTP_COOKIE"};
   8 $ENV{"HTTP_COOKIE"} = "";
   9 my %param = readparse();
  10
  11 my %oldcookies = map { ($1, $2) if (m/(.*)=(.*)/) } split /[;&]/, $oldcookies;
  12
  13 my $clear = (defined $param{"clear"} && $param{"clear"} eq "yes");
  14 my @time_now = gmtime(time());
  15 my $time_future = strftime("%a, %d-%b-%Y %T GMT",
  16                         59, 59, 23, 31, 11, $time_now[5]+10);
  17 my $time_past = strftime("%a, %d-%b-%Y %T GMT",
  18                         59, 59, 23, 31, 11, $time_now[5]-10);
  19
  20 my @cookie_options = qw(repeatmerged terse reverse trim oldview);
  21
  22 print "Content-Type: text/html; charset=utf-8\n";
  23
  24 for my $c (@cookie_options) {
  25     if (defined $param{$c}) {
  26         printf "Set-Cookie: %s=%s; expires=%s; domain=%s; path=/\n",
  27              $c, $param{$c}, $time_future, "bugs.debian.org";
  28     } elsif ($clear) {
  29         printf "Set-Cookie: %s=%s; expires=%s; domain=%s; path=/\n",
  30              $c, "", $time_past, "bugs.debian.org";
  31     }
  32 }
  33 print "\n";
  34 print "<p>Oldcookies  $oldcookies  .\n";
  35 print "<p>Cookies set!\n";
  36 for my $c (@cookie_options) {
  37     my $old = $oldcookies{$c} || "unset";
  38     if (defined $param{$c}) {
  39         printf "<br>Set %s=%s (was %s)\n", $c, $param{$c}, $old;
  40     } elsif ($clear) {
  41         printf "<br>Cleared %s (was %s)\n", $c, $old;
  42     } else {
  43         printf "<br>Didn't touch %s (was %s; use clear=yes to clear)\n", $c, $old;
  44     }
  45 }