X-Git-Url: https://git.sesse.net/?p=pr0n;a=blobdiff_plain;f=perl%2FSesse%2Fpr0n%2FCommon.pm;h=14ae88b40664c29f8f39a2f0595580f950325962;hp=9f9a72f3c86d0823b0f2623fd8aa90587025e33c;hb=238c9466b74b540cedc7569ca3d81a9de911c225;hpb=64baab64928af350dbcd44476607a32bfdff3454

diff --git a/perl/Sesse/pr0n/Common.pm b/perl/Sesse/pr0n/Common.pm
index 9f9a72f..14ae88b 100644
--- a/perl/Sesse/pr0n/Common.pm
+++ b/perl/Sesse/pr0n/Common.pm
@@ -26,6 +26,7 @@ use LWP::Simple;
 use Image::ExifTool;
 use HTML::Entities;
 use URI::Escape;
+use File::Basename;
 
 BEGIN {
 	use Exporter ();
@@ -311,19 +312,34 @@ sub update_image_info {
 
 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;
@@ -343,11 +359,8 @@ sub check_access {
 		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;
 	}
 
@@ -497,7 +510,7 @@ sub read_original_image {
 	# 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";
 		
@@ -879,7 +892,7 @@ sub gcd {
 }
 
 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-]+)$/) {
@@ -896,12 +909,14 @@ sub add_new_event {
 		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 ();
 }
@@ -920,6 +935,69 @@ sub guess_charset {
 	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;