1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
# &setCookie("fuckface", "j1zzm0p");
our $cookie_reset = "Friday, 31-Dec-1999 11:59:59 GMT";
our $cookie_forever = "Friday, 21-Dec-2069 12:28:49 GMT";
# our $cookies = getCookies() if ($ENV{'HTTP_COOKIE'});
# store cookies in %$cookies
sub setCookie
{
# end a set-cookie header with the word secure and the cookie will
# only be sent through secure connections
my ($args) = @_;
my $name = $args->{name} || undef;
my $value = $args->{value} || undef;
my $path = $args->{path} || undef;
my $domain = $args->{domain} || undef;
# my ($name, $value, $path, $domain) = @_;
my $date;
if (!$value)
{ $date = $cookie_reset; }
elsif (exists($args->{nologout}) && $args->{nologout} == 1)
{ $date = $cookie_forever; }
else
{ $date = 0; }
print "Set-Cookie: ";
print $name, "=", $value, "; ";
if ($date) { print "expires=$date; "; }
# use first line to force HTTPS
print "path=", $path, "; domain=", $domain, "; secure\n";
# print "path=", $path, "; domain=", $domain, "\n";
}
# cookies are seperated by a semicolon and a space, this will split
# them and return a hash of cookies
sub getCookies
{
my (@rawCookies) = split (/; /,$ENV{'HTTP_COOKIE'});
my %cookies;
foreach(@rawCookies)
{
my ($key, $val) = split (/=/,$_);
$cookies{$key} = $val;
}
return \%cookies;
}
1;
|
