use Image::ExifTool;
use HTML::Entities;
use URI::Escape;
+use File::Basename;
BEGIN {
use Exporter ();
sub check_access {
my $r = shift;
+
+ #return qw(sesse Sesse);
my $auth = $r->headers_in->{'authorization'};
- if (!defined($auth) || $auth !~ m#^Basic ([a-zA-Z0-9+/]+=*)$#) {
- $r->content_type('text/plain; charset=utf-8');
- $r->status(401);
- $r->headers_out->{'www-authenticate'} = 'Basic realm="pr0n.sesse.net"';
- $r->print("Need authorization\n");
+ if (!defined($auth)) {
+ output_401($r);
return undef;
}
-
- #return qw(sesse Sesse);
+ if ($auth =~ /^Basic ([a-zA-Z0-9+\/]+=*)$/) {
+ return check_basic_auth($r, $1);
+ }
+ output_401($r);
+ return undef;
+}
+
+sub output_401 {
+ my $r = shift;
+ $r->content_type('text/plain; charset=utf-8');
+ $r->status(401);
+ $r->headers_out->{'www-authenticate'} = 'Basic realm="pr0n.sesse.net"';
+ $r->print("Need authorization\n");
+}
+
+sub check_basic_auth {
+ my ($r, $auth) = @_;
+
+ my ($user, $pass) = split /:/, MIME::Base64::decode_base64($auth);
- my ($user, $pass) = split /:/, MIME::Base64::decode_base64($1);
# WinXP is stupid :-)
if ($user =~ /^.*\\(.*)$/) {
$user = $1;
undef, $user, $pass, $r->get_server_name);
if ($ref->{'auth'} != 1) {
$r->content_type('text/plain; charset=utf-8');
- warn "No user exists, only $auth";
- $r->status(401);
- $r->headers_out->{'www-authenticate'} = 'Basic realm="pr0n.sesse.net"';
- $r->print("Authorization failed");
$r->log->warn("Authentication failed for $user/$takenby");
+ output_401($r);
return undef;
}
# ImageMagick can handle NEF files, but it does it by calling dcraw as a delegate.
# The delegate support is rather broken and causes very odd stuff to happen when
# more than one thread does this at the same time. Thus, we simply do it ourselves.
- if ($filename =~ /\.nef$/i) {
+ if ($filename =~ /\.(nef|cr2)$/i) {
# this would suffice if ImageMagick gets to fix their handling
# $physical_fname = "NEF:$physical_fname";
my ($a, $b) = ($1, $2);
my $gcd = gcd($a, $b);
push @classic_fields, [ $a/$gcd . "/" . $b/$gcd . "s", $shutter_priority ];
- } elsif (defined($info->{'ExposureTime'}) && $info->{'ExposureTime'} =~ /^(\d+)$/) {
+ } elsif (defined($info->{'ExposureTime'}) && $info->{'ExposureTime'} =~ /^(\d+(?:\.\d+))$/) {
push @classic_fields, [ $1 . "s", $shutter_priority ];
}
}
sub add_new_event {
- my ($dbh, $id, $date, $desc, $vhost) = @_;
+ my ($r, $dbh, $id, $date, $desc) = @_;
my @errors = ();
if (!defined($id) || $id =~ /^\s*$/ || $id !~ /^([a-zA-Z0-9-]+)$/) {
return @errors;
}
+ my $vhost = $r->get_server_name;
$dbh->do("INSERT INTO events (event,date,name,vhost) VALUES (?,?,?,?)",
undef, $id, $date, $desc, $vhost)
or return ("Kunne ikke sette inn ny hendelse" . $dbh->errstr);
$dbh->do("INSERT INTO last_picture_cache (vhost,event,last_picture) VALUES (?,?,NULL)",
undef, $vhost, $id)
or return ("Kunne ikke sette inn ny cache-rad" . $dbh->errstr);
+ purge_cache($r, "/");
return ();
}
return $decoded;
}
+# Depending on your front-end cache, you might want to get creative somehow here.
+# This example assumes you have a front-end cache and it can translate an X-Pr0n-Purge
+# regex tacked onto a request into something useful. The elements given in
+# should not be regexes, though, as e.g. Squid will not be able to handle that.
+sub purge_cache {
+ my ($r, @elements) = @_;
+ return if (scalar @elements == 0);
+
+ my @pe = ();
+ for my $elem (@elements) {
+ $r->log->info("Purging $elem");
+ (my $e = $elem) =~ s/[.+*|()]/\\$&/g;
+ push @pe, $e;
+ }
+
+ my $regex = "^";
+ if (scalar @pe == 1) {
+ $regex .= $pe[0];
+ } else {
+ $regex .= "(" . join('|', @pe) . ")";
+ }
+ $regex .= "(\\?.*)?\$";
+ $r->headers_out->{'X-Pr0n-Purge'} = $regex;
+
+ $r->log->info($r->headers_out->{'X-Pr0n-Purge'});
+}
+
+# Find a list of all cache URLs for a given image, given what we have on disk.
+sub get_all_cache_urls {
+ my ($r, $dbh, $id) = @_;
+ my $dir = POSIX::floor($id / 256);
+ my @ret = ();
+
+ my $q = $dbh->prepare('SELECT event, filename FROM images WHERE id=?')
+ or die "Couldn't prepare: " . $dbh->errstr;
+ $q->execute($id)
+ or die "Couldn't find event and filename: " . $dbh->errstr;
+ my $ref = $q->fetchrow_hashref;
+ my $event = $ref->{'event'};
+ my $filename = $ref->{'filename'};
+ $q->finish;
+
+ my $base = get_base($r) . "cache/$dir";
+ for my $file (<$base/$id-*>) {
+ my $fname = File::Basename::basename($file);
+ if ($fname =~ /^$id-mipmap-.*\.jpg$/) {
+ # Mipmaps don't have an URL, ignore
+ } elsif ($fname =~ /^$id--1--1\.jpg$/) {
+ push @ret, "/$event/$filename";
+ } elsif ($fname =~ /^$id-(\d+)-(\d+)\.jpg$/) {
+ push @ret, "/$event/$1x$2/$filename";
+ } elsif ($fname =~ /^$id-(\d+)-(\d+)-nobox\.jpg$/) {
+ push @ret, "/$event/$1x$2/nobox/$filename";
+ } elsif ($fname =~ /^$id-(\d+)-(\d+)-box\.png$/) {
+ push @ret, "/$event/$1x$2/box/$filename";
+ } else {
+ $r->log->warning("Couldn't find a purging URL for $fname");
+ }
+ }
+
+ return @ret;
+}
+
1;
projects / pr0n / blobdiff