diff options
Diffstat (limited to 'lib/PublicInbox/POP3D.pm')
| -rw-r--r-- | lib/PublicInbox/POP3D.pm | 277 |
1 files changed, 277 insertions, 0 deletions
diff --git a/lib/PublicInbox/POP3D.pm b/lib/PublicInbox/POP3D.pm new file mode 100644 index 00000000..bd440434 --- /dev/null +++ b/lib/PublicInbox/POP3D.pm @@ -0,0 +1,277 @@ +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> + +# represents an POP3D +package PublicInbox::POP3D; +use v5.12; +use parent qw(PublicInbox::Lock); +use DBI qw(:sql_types); # SQL_BLOB +use Carp (); +use File::Temp 0.19 (); # 0.19 for ->newdir +use PublicInbox::Config; +use PublicInbox::POP3; +use PublicInbox::Syscall; +use File::Temp 0.19 (); # 0.19 for ->newdir +use Fcntl qw(F_SETLK F_UNLCK F_WRLCK SEEK_SET); +my ($FLOCK_TMPL, @FLOCK_ORDER); +# are all BSDs the same "struct flock"? tested Free+Net+Open... +if ($^O =~ /\A(?:linux|dragonfly)\z/ || $^O =~ /bsd/) { + require Config; + my $off_t; + my @LE_pad = ('', ''); + my $sz = $Config::Config{lseeksize}; + if ($sz == 8) { + if (eval('length(pack("q", 1)) == 8')) { + $off_t = 'q'; + } elsif ($Config::Config{byteorder} == 1234) { # OpenBSD i386 + $off_t = 'l'; + @LE_pad = ('@8', '@16'); + } else { # I have no 32-bit BE machine to test on... + warn <<EOM; +Perl built with 64-bit file support but not 64-bit int (pack("q")) support. +byteorder=$Config::Config{byteorder} +EOM + } + } elsif ($sz == 4) { + $off_t = 'l'; + } else { + warn "sizeof(off_t)=$sz requires File::FcntlLock\n" + } + if (defined($off_t)) { + if ($^O eq 'linux') { + $FLOCK_TMPL = 'ss@8'.$off_t.$LE_pad[0].$off_t.'@32'; + @FLOCK_ORDER = qw(l_type l_whence l_start l_len); + } else { # *bsd including dragonfly + $FLOCK_TMPL = $off_t.$LE_pad[0].$off_t.$LE_pad[1]. + 'lss@256'; + @FLOCK_ORDER = qw(l_start l_len l_pid l_type l_whence); + } + } +} +@FLOCK_ORDER or eval { require File::FcntlLock } or + die "File::FcntlLock required for POP3 on $^O: $@\n"; + +sub new { + my ($cls) = @_; + bless { + err => \*STDERR, + out => \*STDOUT, + # pi_cfg => PublicInbox::Config + # lock_path => ... + # interprocess lock is the $pop3state/txn.locks file + # txn_locks => {}, # intraworker locks + # ssl_ctx_opt => { SSL_cert_file => ..., SSL_key_file => ... } + }, $cls; +} + +sub refresh_groups { # PublicInbox::Daemon callback + my ($self, $sig) = @_; + # TODO share pi_cfg with nntpd/imapd inside -netd + my $new = PublicInbox::Config->new; + my $d = $new->{'publicinbox.pop3state'} // + die "publicinbox.pop3state undefined ($new->{-f})\n"; + -d $d or do { + require File::Path; + File::Path::make_path($d, { mode => 0700 }); + PublicInbox::Syscall::nodatacow_dir($d); + }; + $self->{lock_path} //= "$d/db.lock"; + if (my $old = $self->{pi_cfg}) { + my $s = 'publicinbox.pop3state'; + $new->{$s} //= $old->{$s}; + return warn <<EOM if $new->{$s} ne $old->{$s}; +$s changed: `$old->{$s}' => `$new->{$s}', config reload ignored +EOM + } + $self->{pi_cfg} = $new; +} + +# persistent tables +sub create_state_tables ($$) { + my ($self, $dbh) = @_; + + $dbh->do(<<''); # map publicinbox.<name>.newsgroup to integers +CREATE TABLE IF NOT EXISTS newsgroups ( + newsgroup_id INTEGER PRIMARY KEY NOT NULL, + newsgroup VARBINARY NOT NULL, + UNIQUE (newsgroup) ) + + # the $NEWSGROUP_NAME.$SLICE_INDEX is part of the POP3 username; + # POP3 has no concept of folders/mailboxes like IMAP/JMAP + $dbh->do(<<''); +CREATE TABLE IF NOT EXISTS mailboxes ( + mailbox_id INTEGER PRIMARY KEY NOT NULL, + newsgroup_id INTEGER NOT NULL REFERENCES newsgroups, + slice INTEGER NOT NULL, /* -1 for most recent slice */ + UNIQUE (newsgroup_id, slice) ) + + $dbh->do(<<''); # actual users are differentiated by their UUID +CREATE TABLE IF NOT EXISTS users ( + user_id INTEGER PRIMARY KEY NOT NULL, + uuid VARBINARY NOT NULL, + last_seen INTEGER NOT NULL, /* to expire idle accounts */ + UNIQUE (uuid) ) + + # we only track the highest-numbered deleted message per-UUID@mailbox + $dbh->do(<<''); +CREATE TABLE IF NOT EXISTS deletes ( + txn_id INTEGER PRIMARY KEY NOT NULL, /* -1 == txn lock offset */ + user_id INTEGER NOT NULL REFERENCES users, + mailbox_id INTEGER NOT NULL REFERENCES mailboxes, + uid_dele INTEGER NOT NULL DEFAULT -1, /* IMAP UID, NNTP article */ + UNIQUE(user_id, mailbox_id) ) + +} + +sub state_dbh_new { + my ($self) = @_; + my $f = "$self->{pi_cfg}->{'publicinbox.pop3state'}/db.sqlite3"; + my $creat = !-s $f; + if ($creat) { + open my $fh, '+>>', $f or Carp::croak "open($f): $!"; + PublicInbox::Syscall::nodatacow_fh($fh); + } + + my $dbh = DBI->connect("dbi:SQLite:dbname=$f",'','', { + AutoCommit => 1, + RaiseError => 1, + PrintError => 0, + sqlite_use_immediate_transaction => 1, + sqlite_see_if_its_a_number => 1, + }); + $dbh->do('PRAGMA journal_mode = WAL') if $creat; + $dbh->do('PRAGMA foreign_keys = ON'); # don't forget this + + # ensure the interprocess fcntl lock file exists + $f = "$self->{pi_cfg}->{'publicinbox.pop3state'}/txn.locks"; + open my $fh, '+>>', $f or Carp::croak("open($f): $!"); + $self->{txn_fh} = $fh; + + create_state_tables($self, $dbh); + $dbh; +} + +sub _setlk ($%) { + my ($self, %lk) = @_; + $lk{l_pid} = 0; # needed for *BSD + $lk{l_whence} = SEEK_SET; + if (@FLOCK_ORDER) { + fcntl($self->{txn_fh}, F_SETLK, + pack($FLOCK_TMPL, @lk{@FLOCK_ORDER})); + } else { + my $fs = File::FcntlLock->new(%lk); + $fs->lock($self->{txn_fh}, F_SETLK); + } +} + +sub lock_mailbox { + my ($self, $pop3) = @_; # pop3 - PublicInbox::POP3 client object + my $lk = $self->lock_for_scope; # lock the SQLite DB, only + my $dbh = $self->{-state_dbh} //= state_dbh_new($self); + my ($user_id, $ngid, $mbid, $txn_id); + my $uuid = delete $pop3->{uuid}; + $dbh->begin_work; + my $creat = 0; + + # 1. make sure the user exists, update `last_seen' + my $sth = $dbh->prepare_cached(<<''); +INSERT OR IGNORE INTO users (uuid, last_seen) VALUES (?,?) + + $sth->bind_param(1, $uuid, SQL_BLOB); + $sth->bind_param(2, time); + if ($sth->execute == 0) { # existing user + $sth = $dbh->prepare_cached(<<'', undef, 1); +SELECT user_id FROM users WHERE uuid = ? + + $sth->bind_param(1, $uuid, SQL_BLOB); + $sth->execute; + $user_id = $sth->fetchrow_array // + die 'BUG: user '.unpack('H*', $uuid).' not found'; + $sth = $dbh->prepare_cached(<<''); +UPDATE users SET last_seen = ? WHERE user_id = ? + + $sth->execute(time, $user_id); + } else { # new user + $user_id = $dbh->last_insert_id(undef, undef, + 'users', 'user_id') + } + + # 2. make sure the newsgroup has an integer ID + $sth = $dbh->prepare_cached(<<''); +INSERT OR IGNORE INTO newsgroups (newsgroup) VALUES (?) + + my $ng = $pop3->{ibx}->{newsgroup}; + $sth->bind_param(1, $ng, SQL_BLOB); + if ($sth->execute == 0) { + $sth = $dbh->prepare_cached(<<'', undef, 1); +SELECT newsgroup_id FROM newsgroups WHERE newsgroup = ? + + $sth->bind_param(1, $ng, SQL_BLOB); + $sth->execute; + $ngid = $sth->fetchrow_array // die "BUG: `$ng' not found"; + } else { + $ngid = $dbh->last_insert_id(undef, undef, + 'newsgroups', 'newsgroup_id'); + } + + # 3. ensure the mailbox exists + $sth = $dbh->prepare_cached(<<''); +INSERT OR IGNORE INTO mailboxes (newsgroup_id, slice) VALUES (?,?) + + if ($sth->execute($ngid, $pop3->{slice}) == 0) { + $sth = $dbh->prepare_cached(<<'', undef, 1); +SELECT mailbox_id FROM mailboxes WHERE newsgroup_id = ? AND slice = ? + + $sth->execute($ngid, $pop3->{slice}); + $mbid = $sth->fetchrow_array // + die "BUG: mailbox_id for $ng.$pop3->{slice} not found"; + } else { + $mbid = $dbh->last_insert_id(undef, undef, + 'mailboxes', 'mailbox_id'); + } + + # 4. ensure the (max) deletes row exists for locking + $sth = $dbh->prepare_cached(<<''); +INSERT OR IGNORE INTO deletes (user_id,mailbox_id) VALUES (?,?) + + if ($sth->execute($user_id, $mbid) == 0) { # fetching into existing + $sth = $dbh->prepare_cached(<<'', undef, 1); +SELECT txn_id,uid_dele FROM deletes WHERE user_id = ? AND mailbox_id = ? + + $sth->execute($user_id, $mbid); + ($txn_id, $pop3->{uid_dele}) = $sth->fetchrow_array; + } else { # new user/mailbox combo + $txn_id = $dbh->last_insert_id(undef, undef, + 'deletes', 'txn_id'); + } + $dbh->commit; + + # see if it's locked by the same worker: + return if $self->{txn_locks}->{$txn_id}; + + # see if it's locked by another worker: + _setlk($self, l_type => F_WRLCK, l_start => $txn_id - 1, l_len => 1) + or return; + + $pop3->{user_id} = $user_id; + $pop3->{txn_id} = $txn_id; + $self->{txn_locks}->{$txn_id} = 1; +} + +sub unlock_mailbox { + my ($self, $pop3) = @_; + my $txn_id = delete($pop3->{txn_id}) // return; + if (!$pop3->{did_quit}) { # deal with QUIT-less disconnects + my $lk = $self->lock_for_scope; + $self->{-state_dbh}->begin_work; + $pop3->__cleanup_state($txn_id); + $self->{-state_dbh}->commit; + } + delete $self->{txn_locks}->{$txn_id}; # same worker + + # other workers + _setlk($self, l_type => F_UNLCK, l_start => $txn_id - 1, l_len => 1) + or die "F_UNLCK: $!"; +} + +1; |