6 use Debbugs::Config qw(:config);
7 use Debbugs::CGI qw(cgi_parameters);
9 use Digest::MD5 qw(md5_hex);
12 use File::Temp qw(tempfile);
21 my $q = CGI::Simple->new();
24 cgi_parameters(query => $q,
25 single => [qw(email avatar default)],
26 default => {avatar => 'yes',
27 default => $config{libravatar_uri_options},
30 # if avatar is no, serve the empty png
31 if ($param{avatar} ne 'yes' or not defined $param{email} or not length $param{email}) {
36 # figure out what the md5sum of the e-mail is.
37 my $email_md5sum = md5_hex(lc($param{email}));
38 my $cache_location = cache_location($email_md5sum);
39 # if we've got it, and it's less than one hour old, return it.
40 if (cache_valid($cache_location)) {
41 serve_cache($cache_location,$q);
44 # if we don't have it, get it, and store it in the cache
45 $cache_location = retreive_libravatar(location => $cache_location,
46 email => lc($param{email}),
48 if (not defined $cache_location) {
49 # failure, serve the default image
53 serve_cache($cache_location,$q);
58 my ($cache_location) = @_;
59 if (-e $cache_location) {
60 if (time - (stat($cache_location))[9] < 60*60) {
67 sub retreive_libravatar{
78 my $cache_location = $param{location};
79 $cache_location =~ s/\.[^\.]+$//;
80 my $uri = libravatar_url(email => $param{email},
83 my $ua = LWP::UserAgent->new(agent => 'Debbugs libravatar service (not Mozilla)',
85 $ua->from($config{maintainer});
86 # if we don't get an avatar within 10 seconds, return so we don't
89 # if the avatar is bigger than 30K, we don't want it either
90 $ua->max_size(30*1024);
91 my $r = $ua->get($uri);
92 if (not $r->is_success()) {
95 my $aborted = $r->header('Client-Aborted');
96 # if we exceeded max size, I'm not sure if we'll be successfull or
97 # not, but regardless, there will be a Client-Aborted header. Stop
98 # here if that header is defined.
99 return undef if defined $aborted;
100 my $type = $r->header('Content-Type');
101 # if there's no content type, or it's not one we like, we won't
102 # bother going further
103 return undef if not defined $type;
104 return undef if not $type =~ m{^image/([^/]+)$};
105 my $dest_type = $type_mapping{$1};
106 return undef if not defined $dest_type;
107 # undo any content encoding
108 $r->decode() or return undef;
109 # ok, now we need to convert it from whatever it is into a format
110 # that we actually like
111 my ($temp_fh,$temp_fn) = tempfile() or
114 print {$temp_fh} $r->content() or
115 die "Unable to print to temp file";
117 system('convert','-resize','80x80',
120 $cache_location.'.'.$dest_type) == 0 or
121 die "convert file failed";
125 unlink($cache_location.'.'.$dest_type) if -e $cache_location.'.'.$dest_type;
126 unlink($temp_fn) if -e $temp_fn;
129 return $cache_location.'.'.$dest_type;
134 for my $ext (qw(.png .jpg)) {
135 if (-e $config{libravatar_cache_dir}.'/'.$md5sum.$ext) {
136 return $config{libravatar_cache_dir}.'/'.$md5sum.$ext;
139 return $config{libravatar_cache_dir}.'/'.$md5sum;
143 my ($cache_location,$q) = @_;
144 if (not defined $cache_location or not length $cache_location) {
145 # serve the default image
146 $cache_location = $config{libravatar_default_image};
148 my $fh = IO::File->new($cache_location,'r') or
149 error(404, "Failed to open cached image $cache_location");
150 my $m = File::LibMagic->new() or
151 error(500,'Unable to create File::LibMagic object');
152 my $mime_string = $m->checktype_filename($cache_location) or
153 error(500,'Bad file; no mime known');
154 print $q->header(-type => $mime_string,
163 my ($error,$text) = @_;
165 print $q->header(-status => $error);
166 print "<h2>$error: $text</h2>";