X-Git-Url: https://git.sesse.net/?p=pr0n;a=blobdiff_plain;f=perl%2FSesse%2Fpr0n%2FCommon.pm;h=d175979b1cf0b888fd3bf187659d255704af2dd8;hp=2f3c5e95173f4b9c1f5464a842c57a667bcf4de9;hb=51f6ff0e15c062f0b26d66f43e88c5937932d4c2;hpb=25da24661e8b79a9c5c6f32af3e3ca949e2943a0 diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm index 2f3c5e9..d175979 100644 --- a/perl/Sesse/pr0n/Common.pm +++ b/perl/Sesse/pr0n/Common.pm @@ -13,8 +13,6 @@ use DBD::Pg; use Image::Magick; use IO::String; use POSIX; -use Digest::SHA; -use Digest::HMAC_SHA1; use MIME::Base64; use MIME::Types; use LWP::Simple; @@ -34,7 +32,7 @@ BEGIN { require Sesse::pr0n::Config_local; }; - $VERSION = "v3.00-pre"; + $VERSION = "v3.02"; @ISA = qw(Exporter); @EXPORT = qw(&error &dberror); %EXPORT_TAGS = qw(); @@ -130,7 +128,8 @@ sub get_query_string { my $first = 1; my $str = ""; - while (my ($key, $value) = each %$param) { + for my $key (sort keys %$param) { + my $value = $param->{$key}; next unless defined($value); next if (defined($defparam->{$key}) && $value == $defparam->{$key}); @@ -342,35 +341,16 @@ sub check_basic_auth { my ($raw_user, $pass) = split /:/, MIME::Base64::decode_base64($auth); my ($user, $takenby) = extract_takenby($raw_user); - my $ref = $dbh->selectrow_hashref('SELECT sha1password,cryptpassword FROM users WHERE username=? AND vhost=?', + my $ref = $dbh->selectrow_hashref('SELECT cryptpassword FROM users WHERE username=? AND vhost=?', undef, $user, Sesse::pr0n::Common::get_server_name($r)); - my ($sha1_matches, $bcrypt_matches) = (0, 0); - if (defined($ref) && defined($ref->{'sha1password'})) { - $sha1_matches = (Digest::SHA::sha1_base64($pass) eq $ref->{'sha1password'}); - } - if (defined($ref) && defined($ref->{'cryptpassword'})) { - $bcrypt_matches = (Crypt::Eksblowfish::Bcrypt::bcrypt($pass, $ref->{'cryptpassword'}) eq $ref->{'cryptpassword'}); - } - - if (!defined($ref) || (!$sha1_matches && !$bcrypt_matches)) { + my $bcrypt_matches = 0; + if (!defined($ref) || Crypt::Eksblowfish::Bcrypt::bcrypt($pass, $ref->{'cryptpassword'}) ne $ref->{'cryptpassword'}) { $r->content_type('text/plain; charset=utf-8'); log_warn($r, "Authentication failed for $user/$takenby"); return undef; } log_info($r, "Authentication succeeded for $user/$takenby"); - # Make sure we can use bcrypt authentication in the future with this password. - # Also remove old-style SHA1 password when we migrate. - if (!$bcrypt_matches) { - my $salt = get_pseudorandom_bytes(16); # Doesn't need to be cryptographically secur. - my $hash = "\$2a\$07\$" . Crypt::Eksblowfish::Bcrypt::en_base64($salt); - my $cryptpassword = Crypt::Eksblowfish::Bcrypt::bcrypt($pass, $hash); - $dbh->do('UPDATE users SET sha1password=NULL,cryptpassword=? WHERE username=? AND vhost=?', - undef, $cryptpassword, $user, Sesse::pr0n::Common::get_server_name($r)) - or die "Couldn't update: " . $dbh->errstr; - log_info($r, "Updated bcrypt hash for $user"); - } - return ($user, $takenby); } @@ -589,15 +569,13 @@ sub read_original_image { } sub ensure_cached { - my ($r, $filename, $id, $dbwidth, $dbheight, $infobox, $dpr, $xres, $yres, @otherres) = @_; + my ($r, $filename, $id, $dbwidth, $dbheight, $dpr, $xres, $yres, @otherres) = @_; my ($new_dbwidth, $new_dbheight); my $fname = get_disk_location($r, $id); - if (!$infobox) { - unless (defined($xres) && (!defined($dbwidth) || !defined($dbheight) || $xres < $dbwidth || $yres < $dbheight || $xres == -1)) { - return ($fname, undef); - } + unless (defined($xres) && (!defined($dbwidth) || !defined($dbheight) || $xres < $dbwidth || $yres < $dbheight || $xres == -1)) { + return ($fname, undef); } my $cachename = get_cache_location($r, $id, $xres, $yres, $infobox, $dpr); @@ -610,57 +588,6 @@ sub ensure_cached { error($r, 'System is in overload mode, not doing any scaling'); } - # If we're being asked for the box, make a new image with it. - # We don't care about @otherres since each of these images are - # already pretty cheap to generate, but we need the exact width so we can make - # one in the right size. - if ($infobox) { - my ($img, $width, $height); - - # This is slow, but should fortunately almost never happen, so don't bother - # special-casing it. - if (!defined($dbwidth) || !defined($dbheight)) { - $img = read_original_image($r, $filename, $id, $dbwidth, $dbheight, 0); - $new_dbwidth = $width = $img->Get('columns'); - $new_dbheight = $height = $img->Get('rows'); - @$img = (); - } else { - $img = Image::Magick->new; - $width = $dbwidth; - $height = $dbheight; - } - - if (defined($xres) && defined($yres)) { - ($width, $height) = scale_aspect($width, $height, $xres, $yres); - } - $height = 24 * $dpr; - $img->Set(size=>($width . "x" . $height)); - $img->Read('xc:white'); - - my $info = Image::ExifTool::ImageInfo($fname); - if (make_infobox($img, $info, $r, $dpr)) { - $img->Quantize(colors=>16, dither=>'False'); - - # Since the image is grayscale, ImageMagick overrides us and writes this - # as grayscale anyway, but at least we get rid of the alpha channel this - # way. - $img->Set(type=>'Palette'); - } else { - # Not enough room for the text, make a tiny dummy transparent infobox - @$img = (); - $img->Set(size=>"1x1"); - $img->Read('null:'); - - $width = 1; - $height = 1; - } - - $err = $img->write(filename => $cachename, quality => 90, depth => 8); - log_info($r, "New infobox cache: $width x $height for $id.jpg"); - - return ($cachename, 'image/png'); - } - my $img; ($img, $new_dbwidth, $new_dbheight) = make_mipmap($r, $filename, $id, $dbwidth, $dbheight, $xres, $yres, @otherres); @@ -734,6 +661,70 @@ sub ensure_cached { return ($cachename, 'image/jpeg'); } +sub ensure_infobox_cached { + my ($r, $filename, $id, $dbwidth, $dbheight, $infobox, $dpr, $xres, $yres) = @_; + + my ($new_dbwidth, $new_dbheight); + + my $fname = get_disk_location($r, $id); + my $cachename = get_cache_location($r, $id, $xres, $yres, 1, $dpr); + my $err; + if (! -r $cachename or (-M $cachename > -M $fname)) { + # If we are in overload mode (aka Slashdot mode), refuse to generate + # new thumbnails. + if (Sesse::pr0n::Overload::is_in_overload($r)) { + log_warn($r, "In overload mode, not scaling $id to $xres x $yres"); + error($r, 'System is in overload mode, not doing any scaling'); + } + + # We need the exact width so we can make one in the right size. + my ($width, $height); + + # This is slow, but should fortunately almost never happen, so don't bother + # special-casing it. + if (!defined($dbwidth) || !defined($dbheight)) { + my $img = read_original_image($r, $filename, $id, $dbwidth, $dbheight, 0); + $new_dbwidth = $width = $img->Get('columns'); + $new_dbheight = $height = $img->Get('rows'); + } else { + $width = $dbwidth; + $height = $dbheight; + } + my $img = Image::Magick->new; + + if (defined($xres) && defined($yres)) { + ($width, $height) = scale_aspect($width, $height, $xres, $yres); + } + $height = 24 * $dpr; + $img->Set(size=>($width . "x" . $height)); + $img->Read('xc:white'); + + my $info = Image::ExifTool::ImageInfo($fname); + if (make_infobox($img, $info, $r, $dpr)) { + $img->Quantize(colors=>16, dither=>'False'); + + # Since the image is grayscale, ImageMagick overrides us and writes this + # as grayscale anyway, but at least we get rid of the alpha channel this + # way. + $img->Set(type=>'Palette'); + } else { + # Not enough room for the text, make a tiny dummy transparent infobox + @$img = (); + $img->Set(size=>"1x1"); + $img->Read('null:'); + + $width = 1; + $height = 1; + } + + $err = $img->write(filename => $cachename, quality => 90, depth => 8); + log_info($r, "New infobox cache: $width x $height for $id.jpg"); + + return ($cachename, 'image/png'); + } +} + + sub get_mimetype_from_filename { my $filename = shift; my MIME::Type $type = $mimetypes->mimeTypeOf($filename); @@ -1027,7 +1018,7 @@ sub set_last_modified { my ($res, $mtime) = @_; my $str = POSIX::strftime("%a, %d %b %Y %H:%M:%S GMT", gmtime($mtime)); - $res->headers({ 'Last-Modified' => $str }); + $res->header('Last-Modified' => $str); } sub get_server_name {