]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/Over.pm
solver: support sha256 coderepos
[public-inbox.git] / lib / PublicInbox / Over.pm
1 # Copyright (C) 2018-2021 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3
4 # for XOVER, OVER in NNTP, and feeds/homepage/threads in PSGI
5 # Unlike Msgmap, this is an _UNSTABLE_ database which can be
6 # tweaked/updated over time and rebuilt.
7 package PublicInbox::Over;
8 use strict;
9 use v5.10.1;
10 use DBI qw(:sql_types); # SQL_BLOB
11 use DBD::SQLite;
12 use PublicInbox::Smsg;
13 use Compress::Zlib qw(uncompress);
14 use constant DEFAULT_LIMIT => 1000;
15
16 sub dbh_new {
17         my ($self, $rw) = @_;
18         my $f = delete $self->{filename};
19         if (!-s $f) { # SQLite defaults mode to 0644, we want 0666
20                 if ($rw) {
21                         require PublicInbox::Spawn;
22                         my ($dir) = ($f =~ m!(.+)/[^/]+\z!);
23                         PublicInbox::Spawn::nodatacow_dir($dir);
24                         open my $fh, '+>>', $f or die "failed to open $f: $!";
25                         PublicInbox::Spawn::nodatacow_fd(fileno($fh));
26                 } else {
27                         $self->{filename} = $f; # die on stat() below:
28                 }
29         }
30         my (@st, $st, $dbh);
31         my $tries = 0;
32         do {
33                 @st = stat($f) or die "failed to stat $f: $!";
34                 $st = pack('dd', $st[0], $st[1]); # 0: dev, 1: inode
35                 $dbh = DBI->connect("dbi:SQLite:dbname=$f",'','', {
36                         AutoCommit => 1,
37                         RaiseError => 1,
38                         PrintError => 0,
39                         ReadOnly => !$rw,
40                         sqlite_use_immediate_transaction => 1,
41                 });
42                 $self->{st} = $st;
43                 @st = stat($f) or die "failed to stat $f: $!";
44                 $st = pack('dd', $st[0], $st[1]);
45         } while ($st ne $self->{st} && $tries++ < 3);
46         warn "W: $f: .st_dev, .st_ino unstable\n" if $st ne $self->{st};
47
48         if ($rw) {
49                 # TRUNCATE reduces I/O compared to the default (DELETE).
50                 #
51                 # Do not use WAL by default since we expect the case
52                 # where any users may read via read-only daemons
53                 # (-httpd/-imapd/-nntpd); but only a single user has
54                 # write permissions for -watch/-mda.
55                 #
56                 # Read-only WAL support in SQLite 3.22.0 (2018-01-22)
57                 # doesn't do what we need: it is only intended for
58                 # immutable read-only media (e.g. CD-ROM) and not
59                 # usable for our use case described above.
60                 #
61                 # If an admin is willing to give read-only daemons R/W
62                 # permissions; they can enable WAL manually and we will
63                 # respect that by not clobbering it.
64                 my $jm = $dbh->selectrow_array('PRAGMA journal_mode');
65                 $dbh->do('PRAGMA journal_mode = TRUNCATE') if $jm ne 'wal';
66
67                 $dbh->do('PRAGMA synchronous = OFF') if $rw > 1;
68         }
69         $dbh;
70 }
71
72 sub new {
73         my ($class, $f) = @_;
74         bless { filename => $f }, $class;
75 }
76
77 sub dbh_close {
78         my ($self) = @_;
79         if (my $dbh = delete $self->{dbh}) {
80                 delete $self->{-get_art};
81                 $self->{filename} = $dbh->sqlite_db_filename;
82         }
83 }
84
85 sub dbh ($) { $_[0]->{dbh} //= $_[0]->dbh_new } # dbh_new may be subclassed
86
87 sub load_from_row ($;$) {
88         my ($smsg, $cull) = @_;
89         bless $smsg, 'PublicInbox::Smsg';
90         if (defined(my $data = delete $smsg->{ddd})) {
91                 $data = uncompress($data);
92                 PublicInbox::Smsg::load_from_data($smsg, $data);
93
94                 # saves over 600K for 1000+ message threads
95                 PublicInbox::Smsg::psgi_cull($smsg) if $cull;
96         }
97         $smsg
98 }
99
100 sub do_get {
101         my ($self, $sql, $opts, @args) = @_;
102         my $lim = (($opts->{limit} || 0) + 0) || DEFAULT_LIMIT;
103         $sql .= "LIMIT $lim";
104         my $msgs = dbh($self)->selectall_arrayref($sql, { Slice => {} }, @args);
105         my $cull = $opts->{cull};
106         load_from_row($_, $cull) for @$msgs;
107         $msgs
108 }
109
110 sub query_xover {
111         my ($self, $beg, $end, $opt) = @_;
112         do_get($self, <<'', $opt, $beg, $end);
113 SELECT num,ts,ds,ddd FROM over WHERE num >= ? AND num <= ?
114 ORDER BY num ASC
115
116 }
117
118 sub query_ts {
119         my ($self, $ts, $prev) = @_;
120         do_get($self, <<'', {}, $ts, $prev);
121 SELECT num,ddd FROM over WHERE ts >= ? AND num > ?
122 ORDER BY num ASC
123
124 }
125
126 sub get_all {
127         my $self = shift;
128         my $nr = scalar(@_) or return [];
129         my $in = '?' . (',?' x ($nr - 1));
130         do_get($self, <<"", { cull => 1, limit => $nr }, @_);
131 SELECT num,ts,ds,ddd FROM over WHERE num IN ($in)
132
133 }
134
135 sub nothing () { wantarray ? (0, []) : [] };
136
137 sub get_thread {
138         my ($self, $mid, $prev) = @_;
139         my $dbh = dbh($self);
140         my $opts = { cull => 1 };
141
142         my $id = $dbh->selectrow_array(<<'', undef, $mid);
143 SELECT id FROM msgid WHERE mid = ? LIMIT 1
144
145         defined $id or return nothing;
146
147         my $num = $dbh->selectrow_array(<<'', undef, $id);
148 SELECT num FROM id2num WHERE id = ? AND num > 0
149 ORDER BY num ASC LIMIT 1
150
151         defined $num or return nothing;
152
153         my ($tid, $sid) = $dbh->selectrow_array(<<'', undef, $num);
154 SELECT tid,sid FROM over WHERE num = ? LIMIT 1
155
156         defined $tid or return nothing; # $sid may be undef
157
158         my $cond_all = '(tid = ? OR sid = ?) AND num > ?';
159         my $sort_col = 'ds';
160         $num = 0;
161         if ($prev) { # mboxrd stream, only
162                 $num = $prev->{num} || 0;
163                 $sort_col = 'num';
164         }
165
166         my $cols = 'num,ts,ds,ddd';
167         unless (wantarray) {
168                 return do_get($self, <<"", $opts, $tid, $sid, $num);
169 SELECT $cols FROM over WHERE $cond_all
170 ORDER BY $sort_col ASC
171
172         }
173
174         # HTML view always wants an array and never uses $prev,
175         # but the mbox stream never wants an array and always has $prev
176         die '$prev not supported with wantarray' if $prev;
177         my $nr = $dbh->selectrow_array(<<"", undef, $tid, $sid, $num);
178 SELECT COUNT(num) FROM over WHERE $cond_all
179
180         # giant thread, prioritize strict (tid) matches and throw
181         # in the loose (sid) matches at the end
182         my $msgs = do_get($self, <<"", $opts, $tid, $num);
183 SELECT $cols FROM over WHERE tid = ? AND num > ?
184 ORDER BY $sort_col ASC
185
186         # do we have room for loose matches? get the most recent ones, first:
187         my $lim = DEFAULT_LIMIT - scalar(@$msgs);
188         if ($lim > 0) {
189                 $opts->{limit} = $lim;
190                 my $loose = do_get($self, <<"", $opts, $tid, $sid, $num);
191 SELECT $cols FROM over WHERE tid != ? AND sid = ? AND num > ?
192 ORDER BY $sort_col DESC
193
194                 # TODO separate strict and loose matches here once --reindex
195                 # is fixed to preserve `tid' properly
196                 push @$msgs, @$loose;
197         }
198         ($nr, $msgs);
199 }
200
201 # strict `tid' matches, only, for thread-expanded mbox.gz search results
202 # and future CLI interface
203 # returns true if we have IDs, undef if not
204 sub expand_thread {
205         my ($self, $ctx) = @_;
206         my $dbh = dbh($self);
207         do {
208                 defined(my $num = $ctx->{ids}->[0]) or return;
209                 my ($tid) = $dbh->selectrow_array(<<'', undef, $num);
210 SELECT tid FROM over WHERE num = ?
211
212                 if (defined($tid)) {
213                         my $sql = <<'';
214 SELECT num FROM over WHERE tid = ? AND num > ?
215 ORDER BY num ASC LIMIT 1000
216
217                         my $xids = $dbh->selectcol_arrayref($sql, undef, $tid,
218                                                         $ctx->{prev} // 0);
219                         if (scalar(@$xids)) {
220                                 $ctx->{prev} = $xids->[-1];
221                                 $ctx->{xids} = $xids;
222                                 return 1; # success
223                         }
224                 }
225                 $ctx->{prev} = 0;
226                 shift @{$ctx->{ids}};
227         } while (1);
228 }
229
230 sub recent {
231         my ($self, $opts, $after, $before) = @_;
232         my ($s, @v);
233         if (defined($before)) {
234                 if (defined($after)) {
235                         $s = '+num > 0 AND ts >= ? AND ts <= ? ORDER BY ts DESC';
236                         @v = ($after, $before);
237                 } else {
238                         $s = '+num > 0 AND ts <= ? ORDER BY ts DESC';
239                         @v = ($before);
240                 }
241         } else {
242                 if (defined($after)) {
243                         $s = '+num > 0 AND ts >= ? ORDER BY ts ASC';
244                         @v = ($after);
245                 } else {
246                         $s = '+num > 0 ORDER BY ts DESC';
247                 }
248         }
249         do_get($self, <<"", $opts, @v);
250 SELECT ts,ds,ddd FROM over WHERE $s
251
252 }
253
254 sub get_art {
255         my ($self, $num) = @_;
256         # caching $sth ourselves is faster than prepare_cached
257         my $sth = $self->{-get_art} //= dbh($self)->prepare(<<'');
258 SELECT num,tid,ds,ts,ddd FROM over WHERE num = ? LIMIT 1
259
260         $sth->execute($num);
261         my $smsg = $sth->fetchrow_hashref;
262         $smsg ? load_from_row($smsg) : undef;
263 }
264
265 sub get_xref3 {
266         my ($self, $num, $raw) = @_;
267         my $dbh = dbh($self);
268         my $sth = $dbh->prepare_cached(<<'', undef, 1);
269 SELECT ibx_id,xnum,oidbin FROM xref3 WHERE docid = ? ORDER BY ibx_id,xnum ASC
270
271         $sth->execute($num);
272         my $rows = $sth->fetchall_arrayref;
273         return $rows if $raw;
274         my $eidx_key_sth = $dbh->prepare_cached(<<'', undef, 1);
275 SELECT eidx_key FROM inboxes WHERE ibx_id = ?
276
277         [ map {
278                 my $r = $_;
279                 $eidx_key_sth->execute($r->[0]);
280                 my $eidx_key = $eidx_key_sth->fetchrow_array;
281                 $eidx_key //= "missing://ibx_id=$r->[0]";
282                 "$eidx_key:$r->[1]:".unpack('H*', $r->[2]);
283         } @$rows ];
284 }
285
286 sub next_by_mid {
287         my ($self, $mid, $id, $prev) = @_;
288         my $dbh = dbh($self);
289
290         unless (defined $$id) {
291                 my $sth = $dbh->prepare_cached(<<'', undef, 1);
292         SELECT id FROM msgid WHERE mid = ? LIMIT 1
293
294                 $sth->execute($mid);
295                 $$id = $sth->fetchrow_array;
296                 defined $$id or return;
297         }
298         my $sth = $dbh->prepare_cached(<<"", undef, 1);
299 SELECT num FROM id2num WHERE id = ? AND num > ?
300 ORDER BY num ASC LIMIT 1
301
302         $$prev ||= 0;
303         $sth->execute($$id, $$prev);
304         my $num = $sth->fetchrow_array or return;
305         $$prev = $num;
306         get_art($self, $num);
307 }
308
309 # IMAP search, this is limited by callers to UID_SLICE size (50K)
310 sub uid_range {
311         my ($self, $beg, $end, $sql) = @_;
312         my $dbh = dbh($self);
313         my $q = 'SELECT num FROM over WHERE num >= ? AND num <= ?';
314
315         # This is read-only, anyways; but caller should verify it's
316         # only sending \A[0-9]+\z for ds and ts column ranges
317         $q .= $$sql if $sql;
318         $q .= ' ORDER BY num ASC';
319         $dbh->selectcol_arrayref($q, undef, $beg, $end);
320 }
321
322 sub max {
323         my ($self) = @_;
324         my $sth = dbh($self)->prepare_cached(<<'', undef, 1);
325 SELECT MAX(num) FROM over WHERE num > 0
326
327         $sth->execute;
328         $sth->fetchrow_array // 0;
329 }
330
331 sub imap_exists {
332         my ($self, $uid_base, $uid_end) = @_;
333         my $sth = dbh($self)->prepare_cached(<<'', undef, 1);
334 SELECT COUNT(num) FROM over WHERE num > ? AND num <= ?
335
336         $sth->execute($uid_base, $uid_end);
337         $sth->fetchrow_array;
338 }
339
340 sub check_inodes {
341         my ($self) = @_;
342         my $dbh = $self->{dbh} or return;
343         my $f = $dbh->sqlite_db_filename;
344         if (my @st = stat($f)) { # did st_dev, st_ino change?
345                 my $st = pack('dd', $st[0], $st[1]);
346
347                 # don't actually reopen, just let {dbh} be recreated later
348                 dbh_close($self) if $st ne ($self->{st} // $st);
349         } else {
350                 warn "W: stat $f: $!\n";
351         }
352 }
353
354 sub oidbin_exists {
355         my ($self, $oidbin) = @_;
356         if (wantarray) {
357                 my $sth = $self->dbh->prepare_cached(<<'', undef, 1);
358 SELECT docid FROM xref3 WHERE oidbin = ? ORDER BY docid ASC
359
360                 $sth->bind_param(1, $oidbin, SQL_BLOB);
361                 $sth->execute;
362                 my $tmp = $sth->fetchall_arrayref;
363                 map { $_->[0] } @$tmp;
364         } else {
365                 my $sth = $self->dbh->prepare_cached(<<'', undef, 1);
366 SELECT COUNT(*) FROM xref3 WHERE oidbin = ?
367
368                 $sth->bind_param(1, $oidbin, SQL_BLOB);
369                 $sth->execute;
370                 $sth->fetchrow_array;
371         }
372 }
373
374 sub blob_exists { oidbin_exists($_[0], pack('H*', $_[1])) }
375
376 # used by NNTP.pm
377 sub ids_after {
378         my ($self, $num) = @_;
379         my $ids = dbh($self)->selectcol_arrayref(<<'', undef, $$num);
380 SELECT num FROM over WHERE num > ?
381 ORDER BY num ASC LIMIT 1000
382
383         $$num = $ids->[-1] if @$ids;
384         $ids;
385 }
386
387 1;