From: Don Armstrong Date: Tue, 1 Oct 2013 21:53:59 +0000 (-0700) Subject: Merge branch 'master' into don/libravatar X-Git-Tag: release/2.6.0~279 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=8623fd34da118a1bdcf96932058935e0c15bcd72;hp=e30a48719169aa2ded02d432f2bca8b91ba011e3;p=debbugs.git Merge branch 'master' into don/libravatar --- diff --git a/Debbugs/CGI/Bugreport.pm b/Debbugs/CGI/Bugreport.pm index d9a8744..2e53892 100644 --- a/Debbugs/CGI/Bugreport.pm +++ b/Debbugs/CGI/Bugreport.pm @@ -148,7 +148,7 @@ sub display_entity { if ($_ eq 'From' and $param{avatars}) { my $libravatar_url = __libravatar_url(decode_rfc1522($head_field)); if (defined $libravatar_url and length $libravatar_url) { - push @headers,q(\n); + push @headers,q(\n); } } push @headers, qq(
$_: ) . html_escape(decode_rfc1522($head_field))."
\n"; @@ -452,7 +452,7 @@ sub __libravatar_url { return undef; } ($email) = get_addresses($email); - return $config{libravatar_uri}.md5_hex(lc($email)).($config{libravatar_uri_options}//''); + return $config{libravatar_uri}.$email.($config{libravatar_uri_options}//''); } diff --git a/Debbugs/Common.pm b/Debbugs/Common.pm index cf53b07..732ac2e 100644 --- a/Debbugs/Common.pm +++ b/Debbugs/Common.pm @@ -52,7 +52,7 @@ BEGIN{ ], date => [qw(secs_to_english)], quit => [qw(quit)], - lock => [qw(filelock unfilelock lockpid)], + lock => [qw(filelock unfilelock lockpid simple_filelock simple_unlockfile)], ); @EXPORT_OK = (); Exporter::export_ok_tags(keys %EXPORT_TAGS); @@ -71,6 +71,7 @@ use Debbugs::MIME qw(decode_rfc1522); use Mail::Address; use Cwd qw(cwd); use Storable qw(dclone); +use Time::HiRes qw(usleep); use Params::Validate qw(validate_with :types); @@ -573,35 +574,77 @@ sub filelock { confess "Locking already locked file: $lockfile\n".Data::Dumper->Dump([$lockfile,$locks],[qw(lockfile locks)]); } } - my ($count,$errors); - $count= 10; $errors= ''; - for (;;) { - my $fh = eval { + my ($fh,$t_lockfile,$errors) = + simple_filelock($lockfile,10,1); + if ($fh) { + push @filelocks, {fh => $fh, file => $lockfile}; + if (defined $locks) { + $locks->{locks}{$lockfile}++; + push @{$locks->{lockorder}},$lockfile; + } + } else { + use Data::Dumper; + croak "failed to get lock on $lockfile -- $errors". + (defined $locks?Data::Dumper->Dump([$locks],[qw(locks)]):''); + } +} + +=head2 simple_filelock + + my ($fh,$t_lockfile,$errors) = + simple_filelock($lockfile,$count,$wait); + +Does a flock of lockfile. If C<$count> is zero, does a blocking lock. +Otherwise, does a non-blocking lock C<$count> times, waiting C<$wait> +seconds in between. + +In list context, returns the lockfile filehandle, lockfile name, and +any errors which occured. + +When the lockfile filehandle is undef, locking failed. + +These lockfiles must be unlocked manually at process end. + + +=cut + +sub simple_filelock { + my ($lockfile,$count,$wait) = @_; + if (not defined $count) { + $count = 10; + } + if ($count < 0) { + $count = 0; + } + if (not defined $wait) { + $wait = 1; + } + my $errors= ''; + my $fh; + while (1) { + $fh = eval { my $fh2 = IO::File->new($lockfile,'w') or die "Unable to open $lockfile for writing: $!"; - flock($fh2,LOCK_EX|LOCK_NB) + # Do a blocking lock if count is zero + flock($fh2,LOCK_EX|($count == 0?0:LOCK_NB)) or die "Unable to lock $lockfile $!"; return $fh2; }; if ($@) { $errors .= $@; } - if ($fh) { - push @filelocks, {fh => $fh, file => $lockfile}; - if (defined $locks) { - $locks->{locks}{$lockfile}++; - push @{$locks->{lockorder}},$lockfile; - } - last; - } - if (--$count <=0) { - $errors =~ s/\n+$//; - use Data::Dumper; - croak "failed to get lock on $lockfile -- $errors". - (defined $locks?Data::Dumper->Dump([$locks],[qw(locks)]):''); + if ($fh) { + last; } -# sleep 10; + # use usleep for fractional wait seconds + usleep($wait * 1_000_000); + } continue { + last unless (--$count > 0); + } + if ($fh) { + return wantarray?($fh,$lockfile,$errors):$fh } + return wantarray?(undef,$lockfile,$errors):undef; } # clean up all outstanding locks at end time @@ -611,6 +654,23 @@ END { } } +=head2 simple_unlockfile + + simple_unlockfile($fh,$lockfile); + + +=cut + +sub simple_unlockfile { + my ($fh,$lockfile) = @_; + flock($fh,LOCK_UN) + or warn "Unable to unlock lockfile $lockfile: $!"; + close($fh) + or warn "Unable to close lockfile $lockfile: $!"; + unlink($lockfile) + or warn "Unable to unlink lockfile $lockfile: $!"; +} + =head2 unfilelock @@ -644,12 +704,7 @@ sub unfilelock { delete $locks->{locks}{$lockfile}; } my %fl = %{pop(@filelocks)}; - flock($fl{fh},LOCK_UN) - or warn "Unable to unlock lockfile $fl{file}: $!"; - close($fl{fh}) - or warn "Unable to close lockfile $fl{file}: $!"; - unlink($fl{file}) - or warn "Unable to unlink lockfile $fl{file}: $!"; + simple_unlockfile($fl{fh},$fl{file}); } diff --git a/Debbugs/Config.pm b/Debbugs/Config.pm index cb30eda..f13e3a2 100644 --- a/Debbugs/Config.pm +++ b/Debbugs/Config.pm @@ -78,7 +78,7 @@ BEGIN { ], text => [qw($gBadEmailPrefix $gHTMLTail $gHTMLExpireNote), ], - cgi => [qw($gLibravatarUri $gLibravatarUriOptions)], + cgi => [qw($gLibravatarUri $gLibravatarUriOptions @gLibravatarBlacklist)], config => [qw(%config)], ); @EXPORT_OK = (); @@ -365,37 +365,6 @@ Default: list_domain set_default(\%config,'bug_subscription_domain',$config{list_domain}); -=head2 CGI Options - -=over - -=item libravatar_uri $gLibravatarUri - -URI to a libravatar configuration. If empty or undefined, libravatar -support will be disabled. Defaults to -http://cdn.libravatar.org/avatar/ which uses a federated Avatar system -and falls back to gravatar if necessary. - -=cut - -set_default(\%config,'libravatar_uri',"http://cdn.libravatar.org/avatar/"); - -=item libravatar_uri_options $gLibravatarUriOptions - -Options to append to the md5_hex of the e-mail. This sets the default -avatar used when an avatar isn't available. Currently defaults to -'?d=retro', which causes a bitmap-looking avatar to be displayed for -unknown e-mails. - -Other options which make sense include ?d=404, ?d=wavatar, etc. See -the API of libravatar for details. - -=cut - -set_default(\%config,'libravatar_uri_options','?d=retro'); - - -=back =head2 Misc Options @@ -788,6 +757,16 @@ Default: $config{spool_dir}/user set_default(\%config,'usertag_dir',$config{spool_dir}.'/user'); set_default(\%config,'incoming_dir','incoming'); + +=item web_dir $gWebDir + +Directory where base html files are kept. Should normally be the same +as the web server's document root. + +Default: /var/lib/debbugs/www + +=cut + set_default(\%config,'web_dir','/var/lib/debbugs/www'); set_default(\%config,'doc_dir','/var/lib/debbugs/www/txt'); set_default(\%config,'lib_path','/usr/lib/debbugs'); @@ -988,6 +967,68 @@ set_default(\%config,'spam_rules_dir','/usr/share/spamassassin'); =back +=head2 CGI Options + +=over + +=item libravatar_uri $gLibravatarUri + +URI to a libravatar configuration. If empty or undefined, libravatar +support will be disabled. Defaults to +libravatar.cgi, our internal federated libravatar system. + +=cut + +set_default(\%config,'libravatar_uri',$config{cgi_domain}.'/libravatar.cgi?email='); + +=item libravatar_uri_options $gLibravatarUriOptions + +Options to append to the md5_hex of the e-mail. This sets the default +avatar used when an avatar isn't available. Currently defaults to +'?d=retro', which causes a bitmap-looking avatar to be displayed for +unknown e-mails. + +Other options which make sense include ?d=404, ?d=wavatar, etc. See +the API of libravatar for details. + +=cut + +set_default(\%config,'libravatar_uri_options',''); + +=item libravatar_default_image + +Default image to serve for libravatar if there is no avatar for an +e-mail address. By default, this is a 1x1 png. [This will also be the +image served if someone specifies avatar=no.] + +Default: $config{web_dir}/1x1.png + +=cut + +set_default(\%config,'libravatar_default_image',$config{web_dir}.'/1x1.png'); + +=item libravatar_cache_dir + +Directory where cached libravatar images are stored + +Default: $config{web_dir}/libravatar/ + +=cut + +set_default(\%config,'libravatar_cache_dir',$config{web_dir}.'/libravatar/'); + +=item libravatar_blacklist + +Array of regular expressions to match against emails, domains, or +images to only show the default image + +Default: empty array + +=cut + +set_default(\%config,'libravatar_blacklist',[]); + +=back =head2 Text Fields diff --git a/Debbugs/Libravatar.pm b/Debbugs/Libravatar.pm new file mode 100644 index 0000000..81668a7 --- /dev/null +++ b/Debbugs/Libravatar.pm @@ -0,0 +1,298 @@ +# This module is part of debbugs, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2013 by Don Armstrong . + +package Debbugs::Libravatar; + +=head1 NAME + +Debbugs::Libravatar -- Libravatar service handler (mod_perl) + +=head1 SYNOPSIS + + + SetHandler perl-script + PerlResponseHandler Debbugs::Libravatar + + +=head1 DESCRIPTION + +Debbugs::Libravatar is a libravatar service handler which will serve +libravatar requests. It also contains utility routines which are used +by the libravatar.cgi script for those who do not have mod_perl. + +=head1 BUGS + +None known. + +=cut + +use warnings; +use strict; +use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); +use base qw(Exporter); + +use Debbugs::Config qw(:config); +use Debbugs::Common qw(:lock); +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 Carp; + +BEGIN{ + ($VERSION) = q$Revision$ =~ /^Revision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = (); + %EXPORT_TAGS = (libravatar => [qw(cache_valid serve_cache 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; +} + +=over + +=item retrieve_libravatar + + $cache_location = retrieve_libravatar(location => $cache_location, + email => lc($param{email}), + ); + +Returns the cache location where a specific avatar can be loaded. If +there isn't a matching avatar, or there is an error, returns undef. + + +=cut + +sub retrieve_libravatar{ + my %type_mapping = + (jpeg => 'jpg', + png => 'png', + gif => 'png', + tiff => 'png', + tif => 'png', + pjpeg => 'jpg', + jpg => 'jpg' + ); + my %param = @_; + my $cache_location = $param{location}; + $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) = + simple_filelock($cache_location.'.lock',20,0.5); + if (not $fh) { + return undef; + } 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 $dest_type; + eval { + my $uri = libravatar_url(email => $param{email}, + default => 404, + size => 80); + my $ua = LWP::UserAgent->new(agent => 'Debbugs libravatar service (not Mozilla)', + ); + $ua->from($config{maintainer}); + # if we don't get an avatar within 10 seconds, return so we + # don't block forever + $ua->timeout(10); + # if the avatar is bigger than 30K, we don't want it either + $ua->max_size(30*1024); + my $r = $ua->get($uri); + if (not $r->is_success()) { + die "Not successful in request"; + } + my $aborted = $r->header('Client-Aborted'); + # if we exceeded max size, I'm not sure if we'll be + # successfull or not, but regardless, there will be a + # Client-Aborted header. Stop here if that header is defined. + die "Client aborted header" if defined $aborted; + 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; + # 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 + # format that we actually like + my ($temp_fh,$temp_fn) = tempfile() or + die "Unable to create temporary file"; + eval { + print {$temp_fh} $r->content() or + die "Unable to print to temp file"; + close ($temp_fh); + ### 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 + ### the size above, and requiring proper mime types will + ### minimize that slightly. Doing this will at least make + ### it harder for malicious web images to harm our users + system('convert','-resize','80x80', + '-strip', + $temp_fn, + $cache_location.'.'.$dest_type) == 0 or + die "convert file failed"; + unlink($temp_fh); + }; + if ($@) { + unlink($cache_location.'.'.$dest_type) if -e $cache_location.'.'.$dest_type; + unlink($temp_fn) if -e $temp_fn; + die "Unable to convert image"; + } + }; + if ($@) { + # there was some kind of error; return undef and unlock the + # lock + simple_unlockfile($fh,$lockfile); + return undef; + } + simple_unlockfile($fh,$lockfile); + return $cache_location.'.'.$dest_type; +} + +sub blocked_libravatar { + my ($email,$md5sum) = @_; + my $blocked = 0; + for my $blocker (@{$config{libravatar_blacklist}||[]}) { + for my $element ($email,$md5sum) { + next unless defined $element; + eval { + if ($element =~ /$blocker/) { + $blocked=1; + } + }; + } + } + return $blocked; +} + +sub cache_location { + my %param = @_; + my $md5sum; + if (exists $param{md5sum}) { + $md5sum = $param{md5sum}; + }elsif (exists $param{email}) { + $md5sum = md5_hex(lc($param{email})); + } 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 $config{libravatar_cache_dir}.'/'.$md5sum; +} + +## the following is mod_perl specific + +BEGIN{ + if (exists $ENV{MOD_PERL_API_VERSION}) { + if ($ENV{MOD_PERL_API_VERSION} == 2) { + require Apache2::RequestIO; + require Apache2::RequestRec; + require Apache2::RequestUtil; + require Apache2::Const; + require APR::Finfo; + require APR::Const; + APR::Const->import(-compile => qw(FINFO_NORM)); + Apache2::Const->import(-compile => qw(OK DECLINED FORBIDDEN NOT_FOUND HTTP_NOT_MODIFIED)); + } else { + die "Unsupported mod perl api; mod_perl 2.0.0 or later is required"; + } + } +} + +sub handler { + die "Calling handler only makes sense if this is running under mod_perl" unless exists $ENV{MOD_PERL_API_VERSION}; + my $r = shift or Apache2::RequestUtil->request; + + # we only want GET or HEAD requests + unless ($r->method eq 'HEAD' or $r->method eq 'GET') { + return Apache2::Const::DECLINED(); + } + $r->headers_out->{"X-Powered-By"} = "Debbugs libravatar"; + + my $uri = $r->uri(); + # subtract out location + my $location = $r->location(); + my ($email) = $uri =~ m/\Q$location\E\/?(.*)$/; + if (not length $email) { + return Apache2::Const::NOT_FOUND(); + } + my $q = CGI::Simple->new(); + my %param = cgi_parameters(query => $q, + single => [qw(avatar)], + default => {avatar => 'yes', + }, + ); + if ($param{avatar} ne 'yes' or not defined $email or not length $email) { + serve_cache_mod_perl('',$r); + return Apache2::Const::DECLINED(); + } + # figure out what the md5sum of the e-mail is. + my $cache_location = cache_location(email => $email); + # if we've got it, and it's less than one hour old, return it. + if (cache_valid($cache_location)) { + serve_cache_mod_perl($cache_location,$r); + return Apache2::Const::DECLINED(); + } + $cache_location = retreive_libravatar(location => $cache_location, + email => $email, + ); + if (not defined $cache_location) { + # failure, serve the default image + serve_cache_mod_perl('',$r); + return Apache2::Const::DECLINED(); + } else { + serve_cache_mod_perl($cache_location,$r); + return Apache2::Const::DECLINED(); + } +} + + +sub serve_cache_mod_perl { + my ($cache_location,$r) = @_; + if (not defined $cache_location or not length $cache_location) { + # serve the default image + $cache_location = $config{libravatar_default_image}; + } + $r->filename($cache_location); + $r->path_info(''); + $r->finfo(APR::Finfo::stat($cache_location, APR::Const::FINFO_NORM(), $r->pool)); +} + +=back + +=cut + +1; + + +__END__ diff --git a/cgi/libravatar.cgi b/cgi/libravatar.cgi new file mode 100755 index 0000000..c0ff013 --- /dev/null +++ b/cgi/libravatar.cgi @@ -0,0 +1,85 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use Debbugs::Config qw(:config); +use Debbugs::CGI qw(cgi_parameters); +use Debbugs::Common; +use Digest::MD5 qw(md5_hex); +use File::LibMagic; +use File::Temp qw(tempfile); +use Debbugs::Libravatar qw(:libravatar); + +use Libravatar::URL; + +use LWP::UserAgent; +use HTTP::Request; + +use CGI::Simple; +use Cwd qw(abs_path); + +my $q = CGI::Simple->new(); + +my %param = + cgi_parameters(query => $q, + single => [qw(email avatar default)], + default => {avatar => 'yes', + default => $config{libravatar_uri_options}, + }, + ); +# if avatar is no, serve the empty png +if ($param{avatar} ne 'yes' or not defined $param{email} or not length $param{email}) { + serve_cache('',$q); + exit 0; +} + +# figure out what the md5sum of the e-mail is. +my $email_md5sum = md5_hex(lc($param{email})); +my $cache_location = cache_location(email => lc($param{email})); +# if we've got it, and it's less than one hour old, return it. +if (cache_valid($cache_location)) { + serve_cache($cache_location,$q); + exit 0; +} +# if we don't have it, get it, and store it in the cache +$cache_location = retrieve_libravatar(location => $cache_location, + email => lc($param{email}), + ); +if (not defined $cache_location) { + # failure, serve the default image + serve_cache('',$q); + exit 0; +} else { + serve_cache($cache_location,$q); + exit 0; +} + + +sub serve_cache { + my ($cache_location,$q) = @_; + if (not defined $cache_location or not length $cache_location) { + # serve the default image + $cache_location = $config{libravatar_default_image}; + } + my $fh = IO::File->new($cache_location,'r') or + error($q,404, "Failed to open cached image $cache_location"); + my $m = File::LibMagic->new() or + error($q,500,'Unable to create File::LibMagic object'); + my $mime_string = $m->checktype_filename(abs_path($cache_location)) or + error($q,500,'Bad file; no mime known'); + print $q->header(-type => $mime_string, + -expires => '+1d', + ); + print <$fh>; + close($fh); +} + + +sub error { + my ($q,$error,$text) = @_; + $text //= ''; + print $q->header(-status => $error); + print "

$error: $text

"; + exit 0; +} diff --git a/debian/control b/debian/control index d8f19b5..3b0a767 100644 --- a/debian/control +++ b/debian/control @@ -44,6 +44,9 @@ Depends: libio-stringy-perl, libmldbm-perl, liburi-perl, libsoap-lite-perl, libcgi-simple-perl, libparams-validate-perl, libtext-template-perl, libsafe-hole-perl, libmail-rfc822-address-perl, liblist-moreutils-perl, + libtext-template-perl, +# used by Debbugs::Libravatar and libravatar.cgi + libfile-libmagic-perl, libgravatar-url-perl, libwww-perl Section: perl Description: modules used by the active Debian BTS Debian has a bug tracking system which files details of bugs reported by @@ -60,7 +63,7 @@ Architecture: all Depends: ${misc:Depends}, libdebbugs-perl, apache | httpd -Suggests: libcgi-alert-perl +Suggests: libcgi-alert-perl, libapache2-mod-perl2 Description: web scripts for the active Debian BTS Debian has a bug tracking system which files details of bugs reported by users and developers. Each bug is given a number, and is kept on file until diff --git a/html/1x1.png b/html/1x1.png new file mode 100644 index 0000000..1914264 Binary files /dev/null and b/html/1x1.png differ