public-inbox.git  about / heads / tags
an "archives first" approach to mailing lists
blob bd44043452b7f6ca8696fb5661d4d49777866292 8429 bytes (raw)
$ git show HEAD:lib/PublicInbox/POP3D.pm	# shows this blob on the CLI

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
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;

git clone https://public-inbox.org/public-inbox.git
git clone http://7fh6tueqddpjyxjmgtdiueylzoqt6pt7hec3pukyptlmohoowvhde4yd.onion/public-inbox.git