cgi/libravatar.cgi

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use Debbugs::Config qw(:config);
   7 use Debbugs::CGI qw(cgi_parameters);
   8 use Debbugs::Common;
   9 use File::LibMagic;
  10 use Debbugs::Libravatar qw(:libravatar);
  11
  12 use Libravatar::URL;
  13
  14 use CGI::Simple;
  15 use Cwd qw(abs_path);
  16 use Digest::MD5 qw(md5_hex);
  17
  18 my $q = CGI::Simple->new();
  19
  20 my %param =
  21     cgi_parameters(query => $q,
  22                    single => [qw(email avatar default)],
  23                    default => {avatar => 'yes',
  24                                default => $config{libravatar_uri_options},
  25                               },
  26                   );
  27 # if avatar is no, serve the empty png
  28 if ($param{avatar} ne 'yes' or not defined $param{email} or not length $param{email}) {
  29     serve_cache('',$q,0);
  30     exit 0;
  31 }
  32
  33 my ($cache_location, $timestamp) = cache_location(email => lc($param{email}));
  34 # if we've got it, and it's less than one hour old, return it.
  35 if ($timestamp) {
  36     serve_cache($cache_location,$q,$timestamp);
  37     exit 0;
  38 }
  39 # if we don't have it, get it, and store it in the cache
  40 ($cache_location,$timestamp) =
  41     retrieve_libravatar(location => $cache_location,
  42                         email => lc($param{email}),
  43                        );
  44 if (not defined $cache_location) {
  45     # failure, serve the default image
  46     serve_cache('',$q,0);
  47     exit 0;
  48 } else {
  49     serve_cache($cache_location,$q,$timestamp);
  50     exit 0;
  51 }
  52
  53
  54 sub serve_cache {
  55     my ($cache_location,$q,$timestamp) = @_;
  56     if (not defined $cache_location or not length $cache_location) {
  57         # serve the default image
  58         $cache_location = $config{libravatar_default_image};
  59         if (not defined $timestamp or not $timestamp) {
  60             $timestamp = (stat($cache_location))[9];
  61         }
  62     }
  63     if (not defined $timestamp) {
  64         # this probably means that the default image doesn't exist
  65         print $q->header(status => 404);
  66         print "404: Not found\n";
  67         return;
  68     }
  69     my $etag = md5_hex($cache_location.$timestamp);
  70     if (defined $q->http('if-none-match')
  71         and $etag eq $q->http('if-none-match')) {
  72         print $q->header(-status => 304);
  73         print "304: Not modified\n";
  74         return;
  75     }
  76     my $fh = IO::File->new($cache_location,'r') or
  77         error($q,404, "Failed to open cached image $cache_location");
  78     my $m = File::LibMagic->new() or
  79         error($q,500,'Unable to create File::LibMagic object');
  80     my $mime_string = $m->checktype_filename(abs_path($cache_location)) or
  81         error($q,500,'Bad file; no mime known');
  82     print $q->header(-type => $mime_string,
  83                      -expires => '+1d',
  84                      -status => 200,
  85                      -etag => $etag,
  86                     );
  87     print <$fh>;
  88     close($fh);
  89 }
  90
  91
  92 sub error {
  93     my ($q,$error,$text) = @_;
  94     $text //= '';
  95     print $q->header(-status => $error);
  96     print "<h2>$error: $text</h2>";
  97     exit 0;
  98 }