[tpop3d-discuss] [contrib] tpop3d_passwd, Tpop3d::Passwd, Tpop3d::Mailbox

Paul Makepeace Paul.Makepeace at realprogrammers.com
Wed, 16 Jul 2003 02:40:24 +0100

Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

Here's a script that's evolved into something relatively useful, generic
& stable for me. Thought I'd share it. It's intended to perform the
grunt work of creating mailboxes, chown'ing them, and setting a password
in passwd format for auth-flatfile.

I've broken some of the functions into modules because I'm reusing them
in an application. If you wanted a straight one-off utility just cat the
files together, and then remove the __END__s and spurious use
statements. There are a couple of additional functions, again for my own
ends but might be useful.

Feedback, patches, etc welcome!


Paul Makepeace ....................................... http://paulm.com/

"What is ? Schrodinger's cat."
   -- http://paulm.com/toys/surrealism/

Content-Type: application/x-perl
Content-Disposition: attachment; filename="Passwd.pm"
Content-Transfer-Encoding: quoted-printable

package Tpop3d::Passwd;=0A=0Arequire Exporter;=0A@ISA =3D qw(Exporter);=0A@=
EXPORT_OK =3D qw(=0A	set_password=0A);=0A=0Ause strict;=0Ause warnings;=0Au=
se File::Spec::Functions qw(catfile);=0A=0Asub randletter() {=0A	chr int(ra=
nd 26) + (int(.5 + rand 1) % 2 ? 65 : 97);=0A}=0A=0Amy $passwd_root =3D q[/=
etc/mail/passwd];=0A=0Asub set_password($$$) {=0A	my ($local_part, $domain,=
 $plaintext_password) =3D @_;=0A=0A	my $passwd_file =3D catfile($passwd_roo=
t, $domain);=0A	my $new_passwd_file =3D catfile($passwd_root, "$domain.$$")=
;=0A=0A	open OP, '<', $passwd_file or die "Can't open '$passwd_file': $!\n"=
;=0A	# XXX Should really check for existence here.=0A	open NP, '>', $new_pa=
sswd_file or die "Can't create temporary '$new_passwd_file': $!\n";=0A=0A	m=
y $salt =3D randletter() . randletter();=0A	my $crypted_password =3D crypt =
($plaintext_password, $salt);=0A=0A	my $seen =3D 0;=0A	my $new_line =3D qq{=
$local_part:$crypted_password:0:0:::\n};=0A	while (<OP>) {=0A		if (/^$local=
_part\b/) {=0A			$seen =3D 1;=0A			print NP $new_line;=0A		} else {=0A			pr=
int NP;=0A		}=0A	}=0A	print NP $new_line unless $seen;=0A	close NP;=0A	clos=
e OP;=0A=0A	unlink($passwd_file) =3D=3D 1=0A		or die "Couldn't unlink $pass=
wd_file: $! (please clean it up)\n";=0A	link $new_passwd_file =3D> $passwd_=
file=0A		or die "Couldn't link $new_passwd_file =3D> $passwd_file: $!\n";=
=0A	unlink($new_passwd_file) =3D=3D 1=0A		or die "Couldn't unlink $new_pass=
wd_file: $! (please clean it up)\n";=0A}=0A=0A1;=0A=0A__END__=0A=0A=3Dhead1=
 NAME=0A=0ATpop3d::Passwd=0A=0A=3Dhead1 SYNOPSIS=0A=0Aset_password($local_p=
art, $domain, $plaintext_password);=0A=0A=3Dhead1 DESCRIPTION=0A=0A=3Dover =
4=0A=0A=3Ditem * Ensure  C</etc/mail/passwd/$domain> exists=0A=0A=3Ditem * =
Add or update an entry in  C</etc/mail/passwd/$domain>=0A=0A=3Dback 4=0A=0A=
The passwd file root path can be adjusted by modifying C<Tpop3d::Passwd>.=
=0A=0A=3Dhead1 BUGS=0A=0ABug reports and patches very welcome.=0A=0A=3Dhead=
1 SEE ALSO=0A=0AL<Tpop3d::Mailbox>, L<tpop3d>, L<tpop3d.conf>=0A=0A=3Dhead1=
 AUTHOR=0A=0ACopyright (C) 2002-3 Paul Makepeace <http://paulm.com/>=0A=0AT=
his program is free software; you can redistribute it and/or=0Amodify it un=
der the same terms as Perl itself.=0A=0A=3Dcut=0A=0A
Content-Type: application/x-perl
Content-Disposition: attachment; filename="Mailbox.pm"
Content-Transfer-Encoding: quoted-printable

#!/usr/bin/perl -w=0A=0Apackage Tpop3d::Mailbox;=0A=0Arequire Exporter;=0A@=
ISA =3D qw(Exporter);=0A@EXPORT_OK =3D qw(=0A	create_mailbox=0A	delete_mail=
box=0A	mailbox_size=0A);=0A=0Ause warnings;=0Ause strict;=0Ause File::Spec:=
:Functions qw(catfile);=0A=0Amy $spool_root  =3D q[/var/mail];=0Amy $mail_u=
ser   =3D q[mail];=0Amy ($mail_uid,$mail_gid) =3D (getpwnam($mail_user))[2,=
3]=0A	or die "$0: [internal] $mail_user not in passwd file";=0A=0Asub mailb=
ox_spool_dir($$) {=0A	my ($local_part, $domain) =3D @_;=0A=0A	my $spool_dir=
 =3D catfile($spool_root, $domain);=0A	my $mailbox =3D catfile($spool_dir, =
$local_part);=0A=0A	($mailbox, $spool_dir);=0A}=0A=0Asub create_mailbox($$)=
 {=0A	my ($mailbox, $spool_dir) =3D mailbox_spool_dir($_[0], $_[1]);=0A=0A	=
unless (-d $spool_dir) {=0A		mkdir $spool_dir, 0775=0A			or die "Can't crea=
te spool directory '$spool_dir': $!\n";=0A		print "Created $spool_dir\n";=
=0A	}=0A	chown($mail_uid, $mail_gid, $spool_dir) =3D=3D 1=0A		or die "Can't=
 chown $mail_user spool directory '$spool_dir': $!\n";=0A=0A	unless (-f $ma=
ilbox) {=0A		open M, '>', $mailbox or die "Can't create '$mailbox': $!\n";=
=0A		close M;=0A	}=0A	chown($mail_uid, $mail_gid =3D> $mailbox) =3D=3D 1=0A=
		or die "Can't chown $mail_user mailbox '$mailbox': $!\n";=0A	chmod 0660 =
=3D> $mailbox=0A		or die "Can't chmod 0660 =3D> mailbox '$mailbox': $!\n";=
=0A}=0A=0Asub mailbox_size($$) {=0A	warn "mailbox_size: ", join(", ", @_), =
"\n";=0A	my ($mailbox, $spool_dir) =3D mailbox_spool_dir($_[0], $_[1]);=0A	=
-f $mailbox && -s _;=0A}=0A=0A# Should delete_mailbox clear up the director=
y when no more mailboxen=0A# remain?=0A=0Asub delete_mailbox($$) {=0A	my ($=
mailbox, $spool_dir) =3D mailbox_spool_dir($_[0], $_[1]);=0A	warn "DELETING=
 $mailbox\n";=0A	unlink($mailbox) =3D=3D 1;=0A}=0A=0A1;=0A=0A__END__=0A=0A=
=3Dhead1 NAME=0A=0ATpop3d::Mailbox=0A=0A=3Dhead1 SYNOPSIS=0A=0Acreate_mailb=
ox($local_part, $domain);=0Adelete_mailbox($local_part, $domain);=0Amailbox=
_size($local_part, $domain);=0A=0A=3Dhead1 DESCRIPTION=0A=0A=3Dover 4=0A=0A=
=3Ditem * create_mailbox($local_part_domain)=0A=0A=3Dover 4=0A=0A=3Ditem * =
Ensure the directory C</var/mail/$domain> exists and is owned=0Aby C<mail>=
=0A=0A=3Ditem * Create, if necessary, a zero-length mailbox file=0AC</var/m=
ail/$domain/$local_part>, also owned by C<mail>.=0A=0A=3Dback 4=0A=0A=3Dite=
m * delete_mailbox($local_part, $domain)=0A=0ARemove the mailbox. Return su=
ccess of unlinking.=0A=0A=3Ditem * mailbox_size($local_part, $domain)=0A=0A=
Report size in bytes of mailbox.=0A=0A=3Dback 4=0A=0AThese paths can be adj=
usted by modifying C<Tpop3d::Mailbox>.=0A=0A=3Dhead1 BUGS=0A=0ABug reports =
and patches welcome.=0A=0A=3Dhead1 SEE ALSO=0A=0AL<Tpop3d::Passwd>, L<tpop3=
d>, L<tpop3d.conf>=0A=0A=3Dhead1 AUTHOR=0A=0ACopyright (C) 2002-3 Paul Make=
peace <http://paulm.com/>=0A=0AThis program is free software; you can redis=
tribute it and/or=0Amodify it under the same terms as Perl itself.=0A=0A=3D=
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename=tpop3d_passwd

#!/usr/bin/perl -w

use warnings;
use strict;
use Tpop3d::Mailbox qw(create_mailbox);
use Tpop3d::Passwd  qw(set_password);

sub usage {
	use File::Basename; my $me = basename $0;
	die "Usage: $me local_part\@domain [password]\n";

usage unless @ARGV == 1 or @ARGV == 2;
my ($local_part, $domain) = $ARGV[0] =~ /(\S+)\@(\S+)/;
usage unless defined $local_part and defined $domain;

my ($plaintext_password, $confirm);

if (defined $ARGV[1]) {
	$plaintext_password = $ARGV[1];
} else {
	system "stty -echo";
	for(;;) {
		print "Password: ";
		chomp($plaintext_password = <STDIN>);
		print "\nConfirm: ";
		chomp($confirm = <STDIN>);
		print "\n";
		if ($plaintext_password ne $confirm) {
			print "Passwords don't match. Try again.\n";
		} else {
	system "stty echo";

create_mailbox($local_part, $domain);
set_password($local_part, $domain, $plaintext_password);
print "Added $local_part\@$domain.\n";


=head1 NAME



tpop3d_passwd local_part@domain [password]


C<tpop3d_passwd> performs various duties to ensure an email address
is ready to accept mail and be retrieved using tpop3d. It is
designed to work with auth-flatfile and a particular schema where mail
is delivered to C</var/mail/$domain/$local_part> and whose POP password
is stored in a passwd-format in C</etc/mail/passwd/$domain>.

When presented with an email address tpop3d_passwd will,

=over 4

=item * Ensure the directory C</var/mail/$domain> exists and is owned
by C<mail>

=item * Create, if necessary, a zero-length mailbox file

=item * Ensure  C</etc/mail/passwd/$domain> exists

=item * Add or update an entry in  C</etc/mail/passwd/$domain>

=back 4

These paths can be adjusted by modifying C<Tpop3d::Passwd>.

=head1 BUGS

Doesn't check for existence of temporary new password file. Unlikely to
have any real impact but mentioned here for purity's sake.

=head1 SEE ALSO

L<Tpop3d::Passwd>, L<tpop3d>, L<tpop3d.conf>

=head1 AUTHOR

Copyright (C) 2002 Paul Makepeace <http://paulm.com/>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.