]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/Libravatar.pm
switch to compatibility level 12
[debbugs.git] / Debbugs / Libravatar.pm
index ed36b91d23f48033ca6524beedb226740b80a738..373a9f5374cef6ae9426dc16db33fa96aa2d68c7 100644 (file)
@@ -31,7 +31,7 @@ None known.
 use warnings;
 use strict;
 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
-use base qw(Exporter);
+use Exporter qw(import);
 
 use Debbugs::Config qw(:config);
 use Debbugs::Common qw(:lock);
@@ -39,8 +39,9 @@ use Libravatar::URL;
 use CGI::Simple;
 use Debbugs::CGI qw(cgi_parameters);
 use Digest::MD5 qw(md5_hex);
-use LWP::UserAgent;
 use File::Temp qw(tempfile);
+use File::LibMagic;
+use Cwd qw(abs_path);
 
 use Carp;
 
@@ -49,22 +50,15 @@ BEGIN{
      $DEBUG = 0 unless defined $DEBUG;
 
      @EXPORT = ();
-     %EXPORT_TAGS = (libravatar => [qw(cache_valid retrieve_libravatar cache_location)]
+     %EXPORT_TAGS = (libravatar => [qw(retrieve_libravatar cache_location)]
                    );
      @EXPORT_OK = ();
      Exporter::export_ok_tags(keys %EXPORT_TAGS);
      $EXPORT_TAGS{all} = [@EXPORT_OK];
 }
 
-sub cache_valid{
-    my ($cache_location) = @_;
-    if (-e $cache_location) {
-        if (time - (stat($cache_location))[9] < 60*60) {
-            return 1;
-        }
-    }
-    return 0;
-}
+
+our $magic;
 
 =over
 
@@ -92,7 +86,8 @@ sub retrieve_libravatar{
         );
     my %param = @_;
     my $cache_location = $param{location};
-    $cache_location =~ s/\.[^\.]+$//;
+    my $timestamp;
+    $cache_location =~ s/\.[^\.\/]+$//;
     # take out a lock on the cache location so that if another request
     # is made while we are serving this one, we don't do double work
     my ($fh,$lockfile,$errors) =
@@ -102,12 +97,15 @@ sub retrieve_libravatar{
     } else {
         # figure out if the cache is now valid; if it is, return the
         # cache location
-        my $temp_location = cache_location(email => $param{email});
-        if (cache_valid($temp_location)) {
-            return $temp_location;
+       my $temp_location;
+        ($temp_location, $timestamp) = cache_location(email => $param{email});
+        if ($timestamp) {
+            return ($temp_location,$timestamp);
         }
     }
-    my $dest_type;
+    require LWP::UserAgent;
+
+    my $dest_type = 'png';
     eval {
         my $uri = libravatar_url(email => $param{email},
                                  default => 404,
@@ -120,9 +118,21 @@ sub retrieve_libravatar{
         $ua->timeout(10);
         # if the avatar is bigger than 30K, we don't want it either
         $ua->max_size(30*1024);
+        $ua->default_header('Accept' => 'image/*');
         my $r = $ua->get($uri);
         if (not $r->is_success()) {
-            die "Not successful in request";
+            if ($r->code != 404) {
+                die "Not successful in request";
+            }
+            # No avatar - cache a negative result
+            if ($config{libravatar_default_image} =~ m/\.(png|jpg)$/) {
+                $dest_type = $1;
+
+                system('cp', '-laf', $config{libravatar_default_image},  $cache_location.'.'.$dest_type) == 0
+                  or die("Cannot copy $config{libravatar_default_image}");
+                # Returns from eval {}
+                return;
+            }
         }
         my $aborted = $r->header('Client-Aborted');
         # if we exceeded max size, I'm not sure if we'll be
@@ -132,10 +142,11 @@ sub retrieve_libravatar{
         my $type = $r->header('Content-Type');
         # if there's no content type, or it's not one we like, we won't
         # bother going further
-        die "No content type" if not defined $type;
-        die "Wrong content type" if not $type =~ m{^image/([^/]+)$};
-        $dest_type = $type_mapping{$1};
-        die "No dest type" if not defined $dest_type;
+        if (defined $type) {
+            die "Wrong content type" if not $type =~ m{^image/([^/]+)$};
+            $dest_type = $type_mapping{$1};
+            die "No dest type" if not defined $dest_type;
+        }
         # undo any content encoding
         $r->decode() or die "Unable to decode content encoding";
         # ok, now we need to convert it from whatever it is into a
@@ -145,7 +156,14 @@ sub retrieve_libravatar{
         eval {
             print {$temp_fh} $r->content() or
                 die "Unable to print to temp file";
-            close ($temp_fh);
+            close ($temp_fh) or
+                die "Unable to close temp file";
+            ### Figure out the actual type from the file
+            $magic = File::LibMagic->new() if not defined $magic;
+            $type = $magic->checktype_filename(abs_path($temp_fn));
+            die "Wrong content type ($type)" if not $type =~ m{^image/([^/;]+)(?:;|$)};
+            $dest_type = $type_mapping{$1};
+            die "No dest type for ($1)" if not defined $dest_type;
             ### resize all images to 80x80 and strip comments out of
             ### them. If convert has a bug, it would be possible for
             ### this to be an attack vector, but hopefully minimizing
@@ -157,7 +175,7 @@ sub retrieve_libravatar{
                    $temp_fn,
                    $cache_location.'.'.$dest_type) == 0 or
                        die "convert file failed";
-            unlink($temp_fh);
+            unlink($temp_fn);
         };
         if ($@) {
             unlink($cache_location.'.'.$dest_type) if -e $cache_location.'.'.$dest_type;
@@ -172,7 +190,8 @@ sub retrieve_libravatar{
         return undef;
     }
     simple_unlockfile($fh,$lockfile);
-    return $cache_location.'.'.$dest_type;
+    $timestamp = (stat($cache_location.'.'.$dest_type))[9];
+    return ($cache_location.'.'.$dest_type,$timestamp);
 }
 
 sub blocked_libravatar {
@@ -191,9 +210,13 @@ sub blocked_libravatar {
     return $blocked;
 }
 
+# Returns ($path, $timestamp)
+# - For blocked images, $path will be undef
+# - If $timestamp is 0 (and $path is not undef), the image should
+#   be re-fetched.
 sub cache_location {
     my %param = @_;
-    my $md5sum;
+    my ($md5sum, $stem);
     if (exists $param{md5sum}) {
         $md5sum = $param{md5sum};
     }elsif (exists $param{email}) {
@@ -201,13 +224,17 @@ sub cache_location {
     } else {
         croak("cache_location must be called with one of md5sum or email");
     }
-    return undef if blocked_libravatar($param{email},$md5sum);
-    for my $ext (qw(.png .jpg)) {
-        if (-e $config{libravatar_cache_dir}.'/'.$md5sum.$ext) {
-            return $config{libravatar_cache_dir}.'/'.$md5sum.$ext;
+    return (undef, 0) if blocked_libravatar($param{email},$md5sum);
+    my $cache_dir = $param{cache_dir} // $config{libravatar_cache_dir};
+    $stem = $cache_dir.'/'.$md5sum;
+    for my $ext ('.png', '.jpg', '') {
+        my $path = $stem.$ext;
+        if (-e $path) {
+            my $timestamp = (time - (stat(_))[9] < 60*60) ? (stat(_))[9] : 0;
+            return ($path, $timestamp);
         }
     }
-    return $config{libravatar_cache_dir}.'/'.$md5sum;
+    return ($stem, 0);
 }
 
 ## the following is mod_perl specific
@@ -257,32 +284,40 @@ sub handler {
         return Apache2::Const::DECLINED();
     }
     # figure out what the md5sum of the e-mail is.
-    my $cache_location = cache_location(email => $email);
+    my ($cache_location, $timestamp) = cache_location(email => $email);
     # if we've got it, and it's less than one hour old, return it.
-    if (cache_valid($cache_location)) {
+    if ($timestamp) {
         serve_cache_mod_perl($cache_location,$r);
         return Apache2::Const::DECLINED();
     }
-    $cache_location = retreive_libravatar(location => $cache_location,
-                                          email => $email,
-                                         );
+    ($cache_location,$timestamp) =
+       retrieve_libravatar(location => $cache_location,
+                           email => $email,
+                          );
     if (not defined $cache_location) {
         # failure, serve the default image
-        serve_cache_mod_perl('',$r);
+        serve_cache_mod_perl('',$r,$timestamp);
         return Apache2::Const::DECLINED();
     } else {
-        serve_cache_mod_perl($cache_location,$r);
+        serve_cache_mod_perl($cache_location,$r,$timestamp);
         return Apache2::Const::DECLINED();
     }
 }
 
 
+
 sub serve_cache_mod_perl {
-    my ($cache_location,$r) = @_;
+    my ($cache_location,$r,$timestamp) = @_;
     if (not defined $cache_location or not length $cache_location) {
         # serve the default image
         $cache_location = $config{libravatar_default_image};
     }
+    $magic = File::LibMagic->new() if not defined $magic;
+
+    return Apache2::Const::DECLINED() if not defined $magic;
+
+    $r->content_type($magic->checktype_filename(abs_path($cache_location)));
+
     $r->filename($cache_location);
     $r->path_info('');
     $r->finfo(APR::Finfo::stat($cache_location, APR::Const::FINFO_NORM(), $r->pool));