[tpop3d-discuss] [contrib] tpop3d_passwd, Tpop3d::Passwd, Tpop3d::Mailbox
Paul Makepeace
Paul.Makepeace at realprogrammers.com
Wed, 16 Jul 2003 02:40:24 +0100
--DocE+STaALJfprDB
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
--
Paul Makepeace ....................................... http://paulm.com/
"What is ? Schrodinger's cat."
-- http://paulm.com/toys/surrealism/
--DocE+STaALJfprDB
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
--DocE+STaALJfprDB
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=
cut=0A
--DocE+STaALJfprDB
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 {
last;
}
}
system "stty echo";
}
create_mailbox($local_part, $domain);
set_password($local_part, $domain, $plaintext_password);
print "Added $local_part\@$domain.\n";
__END__
=head1 NAME
tpop3d_passwd
=head1 SYNOPSIS
tpop3d_passwd local_part@domain [password]
=head1 DESCRIPTION
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
C</var/mail/$domain/$local_part>.
=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.
=cut
--DocE+STaALJfprDB--