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 Digest::MD5 qw(md5_hex);
  10 use Gravatar::URL;
  11 use File::LibMagic;
  12 use File::Temp qw(tempfile);
  13
  14 use Libravatar::URL;
  15
  16 use LWP::UserAgent;
  17 use HTTP::Request;
  18
  19 use CGI::Simple;
  20
  21 my $q = CGI::Simple->new();
  22
  23 my %param =
  24     cgi_parameters(query => $q,
  25                    single => [qw(email avatar default)],
  26                    default => {avatar => 'yes',
  27                                default => $config{libravatar_uri_options},
  28                               },
  29                   );
  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}) {
  32     serve_cache('',$q);
  33     exit 0;
  34 }
  35
  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);
  42     exit 0;
  43 }
  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}),
  47                                      );
  48 if (not defined $cache_location) {
  49     # failure, serve the default image
  50     serve_cache('',$q);
  51     exit 0;
  52 } else {
  53     serve_cache($cache_location,$q);
  54     exit 0;
  55 }
  56
  57 sub cache_valid{
  58     my ($cache_location) = @_;
  59     if (-e $cache_location) {
  60         if (time - (stat($cache_location))[9] < 60*60) {
  61             return 1;
  62         }
  63     }
  64     return 0;
  65 }
  66
  67 sub retreive_libravatar{
  68     my %type_mapping =
  69         (jpeg => 'jpg',
  70          png => 'png',
  71          gif => 'png',
  72          tiff => 'png',
  73          tif => 'png',
  74          pjpeg => 'jpg',
  75          jpg => 'jpg'
  76         );
  77     my %param = @_;
  78     my $cache_location = $param{location};
  79     $cache_location =~ s/\.[^\.]+$//;
  80     my $uri = libravatar_url(email => $param{email},
  81                              default => 404,
  82                              size => 80);
  83     my $ua = LWP::UserAgent->new(agent => 'Debbugs libravatar service (not Mozilla)',
  84                                 );
  85     $ua->from($config{maintainer});
  86     # if we don't get an avatar within 10 seconds, return so we don't
  87     # block forever
  88     $ua->timeout(10);
  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()) {
  93         return undef;
  94     }
  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
 112         return undef;
 113     eval {
 114         print {$temp_fh} $r->content() or
 115             die "Unable to print to temp file";
 116         close ($temp_fh);
 117         system('convert','-geometry','80x80',
 118                $temp_fn,
 119                $cache_location.'.'.$dest_type) == 0 or
 120                    die "convert file failed";
 121         unlink($temp_fh);
 122     };
 123     if ($@) {
 124         unlink($cache_location.'.'.$dest_type) if -e $cache_location.'.'.$dest_type;
 125         unlink($temp_fn) if -e $temp_fn;
 126         return undef;
 127     }
 128     return $cache_location.'.'.$dest_type;
 129 }
 130
 131 sub cache_location {
 132     my ($md5sum) = @_;
 133     for my $ext (qw(.png .jpg)) {
 134         if (-e $config{libravatar_cache_dir}.'/'.$md5sum.$ext) {
 135             return $config{libravatar_cache_dir}.'/'.$md5sum.$ext;
 136         }
 137     }
 138     return $config{libravatar_cache_dir}.'/'.$md5sum;
 139 }
 140
 141 sub serve_cache {
 142     my ($cache_location,$q) = @_;
 143     if (not defined $cache_location or not length $cache_location) {
 144         # serve the default image
 145         $cache_location = $config{libravatar_default_image};
 146     }
 147     my $fh = IO::File->new($cache_location,'r') or
 148         error(404, "Failed to open cached image $cache_location");
 149     my $m = File::LibMagic->new() or
 150         error(500,'Unable to create File::LibMagic object');
 151     my $mime_string = $m->checktype_filename($cache_location) or
 152         error(500,'Bad file; no mime known');
 153     print $q->header(-type => $mime_string,
 154                      -expires => '+1d',
 155                     );
 156     print STDOUT <$fh>;
 157     close($fh);
 158 }
 159
 160
 161 sub error {
 162     my ($error,$text) = @_;
 163     $text //= '';
 164     print $q->header(-status => $error);
 165     print "<h2>$error: $text</h2>";
 166     exit 0;
 167 }