X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FImport.pm;h=73290eed5a04d37a8328eb39bd217cf2258fd6a7;hb=b4d127cb83230fe5cee0dcecb573107ad96a7c4c;hp=6a640e2360674fce2491f76b21c0ea6ec39c735d;hpb=bafd4084d8e78ef48205e6ce573f1bbe52a669a8;p=public-inbox.git

diff --git a/lib/PublicInbox/Import.pm b/lib/PublicInbox/Import.pm
index 6a640e23..73290eed 100644
--- a/lib/PublicInbox/Import.pm
+++ b/lib/PublicInbox/Import.pm
@@ -7,11 +7,13 @@
 package PublicInbox::Import;
 use strict;
 use warnings;
-use Fcntl qw(:flock :DEFAULT);
+use base qw(PublicInbox::Lock);
 use PublicInbox::Spawn qw(spawn);
-use PublicInbox::MID qw(mid_mime mid2path);
+use PublicInbox::MID qw(mids mid_mime mid2path);
 use PublicInbox::Address;
-use PublicInbox::MsgTime qw(msg_timestamp);
+use PublicInbox::MsgTime qw(msg_timestamp msg_datestamp);
+use PublicInbox::ContentId qw(content_digest);
+use PublicInbox::MDA;
 
 sub new {
 	my ($class, $git, $name, $email, $ibx) = @_;
@@ -28,7 +30,7 @@ sub new {
 		ref => $ref,
 		inbox => $ibx,
 		path_type => '2/38', # or 'v2'
-		ssoma_lock => 1, # disable for v2
+		lock_path => "$git->{git_dir}/ssoma.lock", # v2 changes this
 		bytes_added => 0,
 	}, $class
 }
@@ -43,20 +45,20 @@ sub gfi_start {
 	pipe($in_r, $in_w) or die "pipe failed: $!";
 	pipe($out_r, $out_w) or die "pipe failed: $!";
 	my $git = $self->{git};
-	my $git_dir = $git->{git_dir};
 
-	my $lockfh;
-	if ($self->{ssoma_lock}) {
-		my $lockpath = "$git_dir/ssoma.lock";
-		sysopen($lockfh, $lockpath, O_WRONLY|O_CREAT) or
-			die "failed to open lock $lockpath: $!";
-		# wait for other processes to be done
-		flock($lockfh, LOCK_EX) or die "lock failed: $!\n";
-	}
+	$self->lock_acquire;
 
 	local $/ = "\n";
-	chomp($self->{tip} = $git->qx(qw(rev-parse --revs-only), $self->{ref}));
+	my $ref = $self->{ref};
+	chomp($self->{tip} = $git->qx(qw(rev-parse --revs-only), $ref));
+	if ($self->{path_type} ne '2/38' && $self->{tip}) {
+		local $/ = "\0";
+		my @tree = $git->qx(qw(ls-tree -r -z --name-only), $ref);
+		chomp @tree;
+		$self->{-tree} = { map { $_ => 1 } @tree };
+	}
 
+	my $git_dir = $git->{git_dir};
 	my @cmd = ('git', "--git-dir=$git_dir", qw(fast-import
 			--quiet --done --date-format=raw));
 	my $rdr = { 0 => fileno($out_r), 1 => fileno($in_w) };
@@ -65,7 +67,6 @@ sub gfi_start {
 	$out_w->autoflush(1);
 	$self->{in} = $in_r;
 	$self->{out} = $out_w;
-	$self->{lockfh} = $lockfh;
 	$self->{pid} = $pid;
 	$self->{nchg} = 0;
 	binmode $out_w, ':raw' or die "binmode :raw failed: $!";
@@ -148,6 +149,42 @@ sub progress {
 	undef;
 }
 
+sub _update_git_info ($$) {
+	my ($self, $do_gc) = @_;
+	# for compatibility with existing ssoma installations
+	# we can probably remove this entirely by 2020
+	my $git_dir = $self->{git}->{git_dir};
+	my @cmd = ('git', "--git-dir=$git_dir");
+	my $index = "$git_dir/ssoma.index";
+	if (-e $index && !$ENV{FAST}) {
+		my $env = { GIT_INDEX_FILE => $index };
+		run_die([@cmd, qw(read-tree -m -v -i), $self->{ref}], $env);
+	}
+	run_die([@cmd, 'update-server-info'], undef);
+	($self->{path_type} eq '2/38') and eval {
+		require PublicInbox::SearchIdx;
+		my $inbox = $self->{inbox} || $git_dir;
+		my $s = PublicInbox::SearchIdx->new($inbox);
+		$s->index_sync({ ref => $self->{ref} });
+	};
+	eval { run_die([@cmd, qw(gc --auto)], undef) } if $do_gc;
+}
+
+sub barrier {
+	my ($self) = @_;
+
+	# For safety, we ensure git checkpoint is complete before because
+	# the data in git is still more important than what is in Xapian
+	# in v2.  Performance may be gained by delaying the ->progress
+	# call but we lose safety
+	if ($self->{nchg}) {
+		$self->checkpoint;
+		$self->progress('checkpoint');
+		_update_git_info($self, 0);
+		$self->{nchg} = 0;
+	}
+}
+
 # used for v2
 sub get_mark {
 	my ($self, $mark) = @_;
@@ -173,7 +210,7 @@ sub remove {
 	my ($r, $w) = $self->gfi_start;
 	my $tip = $self->{tip};
 	if ($path_type eq '2/38') {
-		$path = mid2path(mid_mime($mime));
+		$path = mid2path(v1_mid0($mime));
 		($err, $cur) = check_remove_v1($r, $w, $tip, $path, $mime);
 		return ($err, $cur) if $err;
 	} else {
@@ -208,15 +245,15 @@ sub remove {
 	if (defined $path) {
 		print $w "D $path\n\n" or wfail;
 	} else {
-		print $w "M 100644 :$blob _/D\n\n" or wfail;
+		clean_tree_v2($self, $w, 'd');
+		print $w "M 100644 :$blob d\n\n" or wfail;
 	}
 	$self->{nchg}++;
 	(($self->{tip} = ":$commit"), $cur);
 }
 
-sub parse_date ($) {
-	my ($mime) = @_;
-	my ($ts, $zone) = msg_timestamp($mime->header_obj);
+sub git_timestamp {
+	my ($ts, $zone) = @_;
 	$ts = 0 if $ts < 0; # git uses unsigned times
 	"$ts $zone";
 }
@@ -259,20 +296,63 @@ sub extract_author_info ($) {
 	($name, $email);
 }
 
+# kill potentially confusing/misleading headers
+sub drop_unwanted_headers ($) {
+	my ($mime) = @_;
+
+	$mime->header_set($_) for qw(bytes lines content-length status);
+	$mime->header_set($_) for @PublicInbox::MDA::BAD_HEADERS;
+}
+
+# used by V2Writable, too
+sub append_mid ($$) {
+	my ($hdr, $mid0) = @_;
+	# @cur is likely empty if we need to call this sub, but it could
+	# have random unparseable crap which we'll preserve, too.
+	my @cur = $hdr->header_raw('Message-ID');
+	$hdr->header_set('Message-ID', @cur, "<$mid0>");
+}
+
+sub v1_mid0 ($) {
+	my ($mime) = @_;
+	my $hdr = $mime->header_obj;
+	my $mids = mids($hdr);
+
+	if (!scalar(@$mids)) { # spam often has no Message-Id
+		my $mid0 = digest2mid(content_digest($mime));
+		append_mid($hdr, $mid0);
+		return $mid0;
+	}
+	$mids->[0];
+}
+sub clean_tree_v2 ($$$) {
+	my ($self, $w, $keep) = @_;
+	my $tree = $self->{-tree} or return; #v2 only
+	delete $tree->{$keep};
+	foreach (keys %$tree) {
+		print $w "D $_\n" or wfail;
+	}
+	%$tree = ($keep => 1);
+}
+
 # returns undef on duplicate
 # returns the :MARK of the most recent commit
 sub add {
 	my ($self, $mime, $check_cb) = @_; # mime = Email::MIME
 
 	my ($name, $email) = extract_author_info($mime);
-	my $date_raw = parse_date($mime);
+	my $hdr = $mime->header_obj;
+	my @at = msg_datestamp($hdr);
+	my @ct = msg_timestamp($hdr);
+	my $author_time_raw = git_timestamp(@at);
+	my $commit_time_raw = git_timestamp(@ct);
 	my $subject = $mime->header('Subject');
 	$subject = '(no subject)' unless defined $subject;
 	my $path_type = $self->{path_type};
 
 	my $path;
 	if ($path_type eq '2/38') {
-		$path = mid2path(mid_mime($mime));
+		$path = mid2path(v1_mid0($mime));
 	} else { # v2 layout, one file:
 		$path = 'm';
 	}
@@ -283,8 +363,7 @@ sub add {
 		_check_path($r, $w, $tip, $path) and return;
 	}
 
-	# kill potentially confusing/misleading headers
-	$mime->header_set($_) for qw(bytes lines content-length status);
+	drop_unwanted_headers($mime);
 
 	# spam check:
 	if ($check_cb) {
@@ -313,21 +392,22 @@ sub add {
 
 	utf8::encode($subject);
 	print $w "commit $ref\nmark :$commit\n",
-		"author $name <$email> $date_raw\n",
-		"committer $self->{ident} ", now_raw(), "\n" or wfail;
+		"author $name <$email> $author_time_raw\n",
+		"committer $self->{ident} $commit_time_raw\n" or wfail;
 	print $w "data ", (length($subject) + 1), "\n",
 		$subject, "\n\n" or wfail;
 	if ($tip ne '') {
 		print $w 'from ', ($parent ? $parent : $tip), "\n" or wfail;
 	}
+	clean_tree_v2($self, $w, $path);
 	print $w "M 100644 :$blob $path\n\n" or wfail;
 	$self->{nchg}++;
 	$self->{tip} = ":$commit";
 }
 
-sub run_die ($;$) {
-	my ($cmd, $env) = @_;
-	my $pid = spawn($cmd, $env, undef);
+sub run_die ($;$$) {
+	my ($cmd, $env, $rdr) = @_;
+	my $pid = spawn($cmd, $env, $rdr);
 	defined $pid or die "spawning ".join(' ', @$cmd)." failed: $!";
 	waitpid($pid, 0) == $pid or die join(' ', @$cmd) .' did not finish';
 	$? == 0 or die join(' ', @$cmd) . " failed: $?\n";
@@ -341,33 +421,10 @@ sub done {
 	my $pid = delete $self->{pid} or die 'BUG: missing {pid} when done';
 	waitpid($pid, 0) == $pid or die 'fast-import did not finish';
 	$? == 0 or die "fast-import failed: $?";
-	my $nchg = delete $self->{nchg};
 
-	# for compatibility with existing ssoma installations
-	# we can probably remove this entirely by 2020
-	my $git_dir = $self->{git}->{git_dir};
-	my @cmd = ('git', "--git-dir=$git_dir");
-	my $index = "$git_dir/ssoma.index";
-	if ($nchg && -e $index && !$ENV{FAST}) {
-		my $env = { GIT_INDEX_FILE => $index };
-		run_die([@cmd, qw(read-tree -m -v -i), $self->{ref}], $env);
-	}
-	if ($nchg) {
-		run_die([@cmd, 'update-server-info'], undef);
-		($self->{path_type} eq '2/38') and eval {
-			require PublicInbox::SearchIdx;
-			my $inbox = $self->{inbox} || $git_dir;
-			my $s = PublicInbox::SearchIdx->new($inbox);
-			$s->index_sync({ ref => $self->{ref} });
-		};
-
-		eval { run_die([@cmd, qw(gc --auto)], undef) };
-	}
+	_update_git_info($self, 1) if delete $self->{nchg};
 
-	$self->{ssoma_lock} or return;
-	my $lockfh = delete $self->{lockfh} or die "BUG: not locked: $!";
-	flock($lockfh, LOCK_UN) or die "unlock failed: $!";
-	close $lockfh or die "close lock failed: $!";
+	$self->lock_release;
 }
 
 sub atfork_child {
@@ -377,6 +434,126 @@ sub atfork_child {
 	}
 }
 
+sub digest2mid ($) {
+	my ($dig) = @_;
+	my $b64 = $dig->clone->b64digest;
+	# Make our own URLs nicer:
+	# See "Base 64 Encoding with URL and Filename Safe Alphabet" in RFC4648
+	$b64 =~ tr!+/=!-_!d;
+
+	# We can make this more meaningful with a date prefix or other things,
+	# but this is only needed for crap that fails to generate a Message-ID
+	# or reuses one.  In other words, it's usually spammers who hit this
+	# so they don't deserve nice Message-IDs :P
+	$b64 . '@localhost';
+}
+
+sub clean_purge_buffer {
+	my ($oids, $buf) = @_;
+	my $cmt_msg = 'purged '.join(' ',@$oids)."\n";
+	@$oids = ();
+
+	foreach my $i (0..$#$buf) {
+		my $l = $buf->[$i];
+		if ($l =~ /^author .* (\d+ [\+-]?\d+)$/) {
+			$buf->[$i] = "author <> $1\n";
+		} elsif ($l =~ /^data (\d+)/) {
+			$buf->[$i++] = "data " . length($cmt_msg) . "\n";
+			$buf->[$i] = $cmt_msg;
+			last;
+		}
+	}
+}
+
+sub purge_oids {
+	my ($self, $purge) = @_;
+	my $tmp = "refs/heads/purge-".((keys %$purge)[0]);
+	my $old = $self->{'ref'};
+	my $git = $self->{git};
+	my @export = (qw(fast-export --no-data --use-done-feature), $old);
+	my ($rd, $pid) = $git->popen(@export);
+	my ($r, $w) = $self->gfi_start;
+	my @buf;
+	my $npurge = 0;
+	my @oids;
+	my ($done, $mark);
+	my $tree = $self->{-tree};
+	while (<$rd>) {
+		if (/^reset (?:.+)/) {
+			push @buf, "reset $tmp\n";
+		} elsif (/^commit (?:.+)/) {
+			if (@buf) {
+				$w->print(@buf) or wfail;
+				@buf = ();
+			}
+			push @buf, "commit $tmp\n";
+		} elsif (/^data (\d+)/) {
+			# only commit message, so $len is small:
+			my $len = $1; # + 1 for trailing "\n"
+			push @buf, $_;
+			my $n = read($rd, my $buf, $len) or die "read: $!";
+			$len == $n or die "short read ($n < $len)";
+			push @buf, $buf;
+		} elsif (/^M 100644 ([a-f0-9]+) (\w+)/) {
+			my ($oid, $path) = ($1, $2);
+			if ($purge->{$oid}) {
+				push @oids, $oid;
+				delete $tree->{$path};
+			} else {
+				$tree->{$path} = 1;
+				push @buf, $_;
+			}
+		} elsif (/^D (\w+)/) {
+			my $path = $1;
+			push @buf, $_ if $tree->{$path};
+		} elsif ($_ eq "\n") {
+			if (@oids) {
+				my $out = join('', @buf);
+				$out =~ s/^/# /sgm;
+				warn "purge rewriting\n", $out, "\n";
+				clean_purge_buffer(\@oids, \@buf);
+				$npurge++;
+			}
+			$w->print(@buf, "\n") or wfail;
+			@buf = ();
+		} elsif ($_ eq "done\n") {
+			$done = 1;
+		} elsif (/^mark :(\d+)$/) {
+			push @buf, $_;
+			$mark = $1;
+		} else {
+			push @buf, $_;
+		}
+	}
+	if (@buf) {
+		$w->print(@buf) or wfail;
+	}
+	die 'done\n not seen from fast-export' unless $done;
+	chomp(my $cmt = $self->get_mark(":$mark")) if $npurge;
+	$self->{nchg} = 0; # prevent _update_git_info until update-ref:
+	$self->done;
+	my @git = ('git', "--git-dir=$git->{git_dir}");
+
+	run_die([@git, qw(update-ref), $old, $tmp]) if $npurge;
+
+	run_die([@git, qw(update-ref -d), $tmp]);
+
+	return if $npurge == 0;
+
+	run_die([@git, qw(-c gc.reflogExpire=now gc --prune=all)]);
+	my $err = 0;
+	foreach my $oid (keys %$purge) {
+		my @info = $git->check($oid);
+		if (@info) {
+			warn "$oid not purged\n";
+			$err++;
+		}
+	}
+	_update_git_info($self, 0);
+	die "Failed to purge $err object(s)\n" if $err;
+	$cmt;
+}
+
 1;
 __END__
 =pod