]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/SearchIdxSkeleton.pm
Lock: new base class for writable lockers
[public-inbox.git] / lib / PublicInbox / SearchIdxSkeleton.pm
1 # Copyright (C) 2018 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3 package PublicInbox::SearchIdxSkeleton;
4 use strict;
5 use warnings;
6 use base qw(PublicInbox::SearchIdx);
7 use Storable qw(freeze thaw);
8
9 sub new {
10         my ($class, $v2writable) = @_;
11         my $self = $class->SUPER::new($v2writable->{-inbox}, 1, 'skel');
12         # create the DB:
13         $self->_xdb_acquire;
14         $self->_xdb_release;
15
16         my ($r, $w);
17         pipe($r, $w) or die "pipe failed: $!\n";
18         my ($barrier_wait, $barrier_note);
19         pipe($barrier_wait, $barrier_note) or die "pipe failed: $!\n";
20         binmode $_, ':raw' foreach ($r, $w, $barrier_wait, $barrier_note);
21         my $pid = fork;
22         defined $pid or die "fork failed: $!\n";
23         if ($pid == 0) {
24                 $v2writable->atfork_child;
25                 $v2writable = undef;
26                 close $w;
27                 close $barrier_wait;
28                 eval { skeleton_worker_loop($self, $r, $barrier_note) };
29                 die "skeleton worker died: $@\n" if $@;
30                 exit;
31         }
32         $self->{w} = $w;
33         $self->{pid} = $pid;
34         close $r;
35         close $barrier_note;
36         $self->{barrier_wait} = $barrier_wait;
37
38         $w->autoflush(1);
39
40         # lock on only exists in parent, not in worker
41         $self->{lock_path} = $self->xdir . '/pi-v2-skeleton.lock';
42         $self;
43 }
44
45 sub skeleton_worker_loop {
46         my ($self, $r, $barrier_note) = @_;
47         $barrier_note->autoflush(1);
48         $0 = 'pi-v2-skeleton';
49         my $xdb = $self->_xdb_acquire;
50         $xdb->begin_transaction;
51         my $txn = 1;
52         my $barrier = undef;
53         while (my $line = $r->getline) {
54                 if ($line eq "commit\n") {
55                         $xdb->commit_transaction if $txn;
56                         $txn = undef;
57                 } elsif ($line eq "close\n") {
58                         $self->_xdb_release;
59                         $xdb = $txn = undef;
60                 } elsif ($line =~ /\Abarrier_init (\d+)\n\z/) {
61                         my $n = $1 - 1;
62                         die "barrier in-progress\n" if defined $barrier;
63                         $barrier = { map { $_ => 1 } (0..$n) };
64                 } elsif ($line =~ /\Abarrier (\d+)\n\z/) {
65                         my $part = $1;
66                         die "no barrier in-progress\n" unless defined $barrier;
67                         delete $barrier->{$1} or die "unknown barrier: $part\n";
68                         if ((scalar keys %$barrier) == 0) {
69                                 $barrier = undef;
70                                 $xdb->commit_transaction if $txn;
71                                 $txn = undef;
72                                 print $barrier_note "barrier_done\n" or die
73                                         "print failed to barrier note: $!";
74                         }
75                 } elsif ($line =~ /\AD ([a-f0-9]{40,}) (.*)\n\z/s) {
76                         my ($oid, $mid) = ($1, $2);
77                         $xdb ||= $self->_xdb_acquire;
78                         if (!$txn) {
79                                 $xdb->begin_transaction;
80                                 $txn = 1;
81                         }
82                         $self->remove_by_oid($oid, $mid);
83                 } else {
84                         my $len = int($line);
85                         my $n = read($r, my $msg, $len) or die "read: $!\n";
86                         $n == $len or die "short read: $n != $len\n";
87                         $msg = thaw($msg); # should raise on error
88                         defined $msg or die "failed to thaw buffer\n";
89                         $xdb ||= $self->_xdb_acquire;
90                         if (!$txn) {
91                                 $xdb->begin_transaction;
92                                 $txn = 1;
93                         }
94                         eval { index_skeleton_real($self, $msg) };
95                         warn "failed to index message <$msg->[-1]>: $@\n" if $@;
96                 }
97         }
98         die "xdb not released\n" if $xdb;
99         die "in transaction\n" if $txn;
100 }
101
102 # called by a partition worker
103 sub index_skeleton {
104         my ($self, $values) = @_;
105         my $w = $self->{w};
106         my $err;
107         my $str = freeze($values);
108         $str = length($str) . "\n" . $str;
109
110         # multiple processes write to the same pipe, so use flock
111         # We can't avoid this lock for <=PIPE_BUF writes, either,
112         # because those atomic writes can break up >PIPE_BUF ones
113         $self->lock_acquire;
114         print $w $str or $err = $!;
115         $self->lock_release;
116
117         die "print failed: $err\n" if $err;
118 }
119
120 sub remote_remove {
121         my ($self, $oid, $mid) = @_;
122         my $err;
123         $self->lock_acquire;
124         eval { $self->SUPER::remote_remove($oid, $mid) };
125         $err = $@;
126         $self->lock_release;
127         die $err if $err;
128 }
129
130 # values: [ TS, NUM, BYTES, LINES, MID, XPATH, doc_data ]
131 sub index_skeleton_real ($$) {
132         my ($self, $values) = @_;
133         my $doc_data = pop @$values;
134         my $xpath = pop @$values;
135         my $mids = pop @$values;
136         my $ts = $values->[PublicInbox::Search::TS];
137         my $smsg = PublicInbox::SearchMsg->new(undef);
138         my $doc = $smsg->{doc};
139         PublicInbox::SearchIdx::add_values($doc, $values);
140         $doc->set_data($doc_data);
141         $smsg->{ts} = $ts;
142         $smsg->load_from_data($doc_data);
143         my $num = $values->[PublicInbox::Search::NUM];
144         my @refs = ($smsg->references =~ /<([^>]+)>/g);
145         $self->link_and_save($doc, $mids, \@refs, $num, $xpath);
146 }
147
148 # write to the subprocess
149 sub barrier_init {
150         my ($self, $nparts) = @_;
151         my $w = $self->{w};
152         my $err;
153         $self->lock_acquire;
154         print $w "barrier_init $nparts\n" or $err = "failed to write: $!\n";
155         $self->lock_release;
156         die $err if $err;
157 }
158
159 sub barrier_wait {
160         my ($self) = @_;
161         my $l = $self->{barrier_wait}->getline;
162         $l eq "barrier_done\n" or die "bad response from barrier_wait: $l\n";
163 }
164
165 1;