6 # if we're running out of git, we want to use the git base directory as the
7 # first INC directory. If you're not running out of git, don't do that.
8 use File::Basename qw(dirname);
13 abs_path(dirname(abs_path(__FILE__)) . '/../');
14 # clear the taint; we'll assume that the absolute path to __FILE__ is the
15 # right path if there's a .git directory there
16 ($debbugs_dir) = $debbugs_dir =~ /([[:print:]]+)/;
17 if (defined $debbugs_dir and
18 -d $debbugs_dir . '/.git/') {
22 # if the first directory in @INC is not an absolute directory, assume that
23 # someone has overridden us via -I.
24 if ($INC[0] !~ /^\//) {
27 use if defined $debbugs_dir, lib => $debbugs_dir.'/lib/';
29 use Debbugs::Config qw(:config);
30 use Debbugs::CGI qw(cgi_parameters);
33 use Debbugs::Libravatar qw(:libravatar);
39 use Digest::MD5 qw(md5_hex);
41 my $q = CGI::Simple->new();
44 cgi_parameters(query => $q,
45 single => [qw(email avatar default)],
46 default => {avatar => 'yes',
47 default => $config{libravatar_uri_options},
50 # if avatar is no, serve the empty png
51 if ($param{avatar} ne 'yes' or not defined $param{email} or not length $param{email}) {
56 my ($cache_location, $timestamp) = cache_location(email => lc($param{email}));
57 # if we've got it, and it's less than one hour old, return it.
59 serve_cache($cache_location,$q,$timestamp);
62 # if we don't have it, get it, and store it in the cache
63 ($cache_location,$timestamp) =
64 retrieve_libravatar(location => $cache_location,
65 email => lc($param{email}),
67 if (not defined $cache_location) {
68 # failure, serve the default image
72 serve_cache($cache_location,$q,$timestamp);
78 my ($cache_location,$q,$timestamp) = @_;
79 if (not defined $cache_location or not length $cache_location) {
80 # serve the default image
81 $cache_location = $config{libravatar_default_image};
82 if (not defined $timestamp or not $timestamp) {
83 $timestamp = (stat($cache_location))[9];
86 if (not defined $timestamp) {
87 # this probably means that the default image doesn't exist
88 print $q->header(status => 404);
89 print "404: Not found\n";
92 my $etag = md5_hex($cache_location.$timestamp);
93 if (defined $q->http('if-none-match')
94 and $etag eq $q->http('if-none-match')) {
95 print $q->header(-status => 304);
96 print "304: Not modified\n";
99 my $fh = IO::File->new($cache_location,'r') or
100 error($q,404, "Failed to open cached image $cache_location");
101 my $m = File::LibMagic->new() or
102 error($q,500,'Unable to create File::LibMagic object');
103 my $mime_string = $m->checktype_filename(abs_path($cache_location)) or
104 error($q,500,'Bad file; no mime known');
105 print $q->header(-type => $mime_string,
116 my ($q,$error,$text) = @_;
118 print $q->header(-status => $error);
119 print "<h2>$error: $text</h2>";