[tpop3d-discuss] auth_perl example script (corrected)
Dave Baker
dave at dsb3.com
Wed, 26 Jun 2002 20:32:17 -0400
--Boundary_(ID_McsF++OeydWnUyc17wFWDQ)
Content-type: text/plain; charset=us-ascii
Content-transfer-encoding: 7BIT
Content-disposition: inline
On Wed, Jun 26, 2002 at 12:40:20PM -0400, Dave Baker wrote:
> A while ago I sent a sample perl authentication script to the list.
> I've found a couple of bugs in it (re virtual domain authentication). If
> it's going to be rolled into contrib/ I'd like the chance to fix it up and
> resubmit before the release goes out.
>
Attached.
If anyone wants to give it a code audit, I'd appreciate any feedback.
Dave
--
- Dave Baker : dave@dsb3.com : dave@devbrain.com : http://dsb3.com/ -
GnuPG: 1024D/D7BCA55D / 09CD D148 57DE 711E 6708 B772 0DD4 51D5 D7BC A55D
--Boundary_(ID_McsF++OeydWnUyc17wFWDQ)
Content-type: application/x-perl; NAME=mail.auth.pl
Content-transfer-encoding: quoted-printable
Content-disposition: attachment; filename=mail.auth.pl
#!/usr/bin/perl -w -T=0A#=0A# Sample smtp/pop3 authentication code to look =
up in a qpopper style=0A# database file. Expects berkeley db file, will on=
ly work with the=0A# version(s) of db that your perl DB_File can talk to.=
=0A#=0A# (c) 2002 Dave Baker <dave@dsb3.com>=0A#=0A# Can be distributed and=
modified - I'd appreciate the credit if you do.=0A# This is still a work i=
n progress. Bugs may exist. Yadda Yadda Yadda.=0A#=0A#=0A# **************=
*********************************************************=0A# BE CA=
REFUL - this code may get executed with root privs =0A# *******************=
****************************************************=0A#=0A#=0A# Mail authe=
ntication extensions, written in perl. Single file shared=0A# between exim=
and tpop3d (both have libperl hooks), although each one=0A# only uses it's=
own functions. =0A#=0A# If there are syntax errors in this file, tpop3d w=
ill only report=0A# "Undefined subroutine" when it tries to call it's funct=
ion instead=0A# of reporting the real problem. I believe exim behaves slig=
htly better=0A# in this regard.=0A# =0A# Even though we're no longer uses q=
popper, I maintain a semblence of=0A# qpopper compatability with the "xor 0=
xff" obfuscation. The passwords=0A# are needed in plaintext for both cram-=
md5 and apop authentication so =0A# it makes sense to help avoid accidental=
viewing within the db file.=0A#=0A# This file is 'loaded' with a perl-hook=
in the config file that reads:=0A# do '/etc/mail/mail.auth.pl';=0A# =
=0A#=0A# MODIFICATION HISTORY:=0A#=0A# 2002-06-01 Dave Baker "exim.pl" cr=
eated=0A# 2002-06-03 Dave Baker "tpop3d.pl" created=0A# 2002-06-04 Dave =
Baker Merged together into "mail.auth.pl"=0A# 2002-06-12 Dave Baker Bug =
fix for tpop3d virtual domain think-o=0A#=0A#=0A#=0A# TODO: =0A# - Still ne=
ed to generalize read/write interface to avoid code duplication=0A# - Need =
to write hooks to also replace 'qpopauth' to allow users=0A# to set their=
own passwords, and passwords for the virtual domains=0A# they 'own'=0A#=
=0A# - Additional error checking, full code audit.=0A#=0A#=0A=0A# Required =
modules. If significantly large modules are needed by only=0A# some of the=
functions, they can be 'require'd instead of forcing all=0A# applications =
to load them into memory.=0A#=0Ause strict;=0Ause DB_File;=0Ause Digest::MD=
5;=0A=0A=0A# constants=0Ause vars qw/ $authdb /;=0A$authdb =3D "/etc/mail/m=
ail.auth.db";=0A=0A=0A# Exim: cram_md5()=0A#=0A# Takes username, and looks =
it up in our configured (constant) auth=0A# berkeley DB file. If found, pa=
ssword is deobfuscated and returned.=0A# Otherwise 'undef' is returned.=0A#=
=0A# Example usage:=0A# # in main configuration settings=0A# perl_start=
up =3D do '/etc/mail/mail.auth.pl'=0A# =0A# # in authentication configu=
ration settings=0A# cram_md5:=0A# driver =3D cram_md5=0A# public_=
name =3D CRAM-MD5=0A# server_secret =3D ${perl{cram_md5}{$1}}=0A#=0A#=
=0Asub cram_md5() {=0A=0A # Some exim's will pass a 'zeroth' dummy paramet=
er that needs to be ignored=0A # my ($dummy, $user) =3D @_;=0A my ($user)=
=3D @_;=0A=0A my $password =3D undef;=0A=0A # undef is plain 'fail' - we=
don't want to give hints as to filename=0A #die "DEBUG: file $file not th=
ere" unless -e $file;=0A return undef unless -e $authdb;=0A=0A my $dbh =
=3D tie my %DB, 'DB_File', $authdb, O_RDONLY, 0660, $DB_HASH;=0A #die "DEB=
UG: file $authdb not opened $!" unless $dbh;=0A return undef unless $dbh;=
=0A=0A # Install database filters - needed to handle \0 line endings.=0A =
# Note that the value field will have multiple \0 on the end=0A # dependin=
g on what was used to create the file.=0A #=0A $dbh->filter_fetch_key ( =
sub { s/\0$// } ) ;=0A $dbh->filter_store_key ( sub { $_ .=3D "\0" } )=
;=0A $dbh->filter_fetch_value( sub { s/\0+$// } ) ;=0A $dbh->filter_s=
tore_value( sub { $_ .=3D "\0" } ) ;=0A=0A # Need to xor stored password w=
ith 0xff, per qpopper's default=0A # obfuscation=0A $password =3D join(""=
, map { $_ ^ chr(255) } split (/|/, $DB{$user}));=0A=0A # close up=0A und=
ef $dbh;=0A untie %DB;=0A=0A # Return password or undef if not found.=0A =
return $password ? $password : undef;=0A=0A}=0A=0A=0A=0A=0A=0A=0A# tpop3d_=
apop()=0A#=0A# Given APOP login credentials, look up password in our mail.a=
uth.db =0A# and return accordingly.=0A#=0A# Example usage (trivial):=0A# =
auth-perl-enable: yes=0A# auth-perl-start: do '/etc/mail/mail.auth.pl';=
=0A# auth-perl-apop: tpop3d_apop=0A#=0A#=0A=0Asub tpop3d_apop {=0A=0A =
my ($packet) =3D @_;=0A=0A # logmsg doesn't get sent to user, so it's safe=
to include as long as=0A # suitable permissions are in place on the log f=
ile itself. We check=0A # if the password file is there, a file, and read=
able. =0A return { "result" =3D> "NO", logmsg =3D> "File not there or unre=
adable" } =0A unless (-e $authdb && -f $authdb && -r $authdb);=0A=0A=0A =
# start in known 'safe' position=0A my $password =3D undef;=0A=0A=0A # sq=
uidge into shorter variable names=0A my $user =3D $packet->{user} || "";=
=0A my $domain =3D $packet->{domain} || "";=0A=0A # hack domain off of $u=
ser if it's there=0A # TODO: handling user/domain input should be done a l=
ittle smarter=0A # rather than disassembling and then reassembling the str=
ings.=0A $user =3D~ s/[@%].*$//;=0A=0A # perform sanity checks on data co=
llected from user=0A if ($user =3D~ /[^a-zA-Z0-9._-]/o ||=0A $domain =
=3D~ /[^a-zA-Z0-9.-]/o ||=0A $packet->{digest} =3D~ /[^a-fA-F0-9]/o) {=
=0A return { "result" =3D> "NO", logmsg =3D> "Unclean input data" };=0A =
# return { "result" =3D> "NO", logmsg =3D> "Unclean input data $packet->=
{user} $packet->{domain} $packet->{digest}" };=0A }=0A=0A # todo - also p=
erform sanity checks on tpop3d provided data=0A=0A=0A my $mailbox =3D "/de=
v/null";=0A=0A =0A # given our user and domain information, work out what=
password=0A # we need to look up in the password file=0A=0A # No domain =
- take 'raw' user.=0A if (! $packet->{domain}) {=0A $mailbox =3D "/var/=
mail/$user";=0A }=0A # Have domain - use 'user@domain' (just tack domain =
back on)=0A # todo - lookup domain in /etc/mail/local-domains to make sure=
=0A # we should even be considering it, also grab "owner" data so we=0A =
# know what uid to run as=0A else {=0A # Note: build mailbox before we =
break user contents=0A $mailbox =3D "/var/mail/$domain/$user";=0A $us=
er .=3D '@' . $domain;=0A }=0A=0A =0A=0A my $dbh =3D tie my %DB, 'DB_Fi=
le', $authdb, O_RDONLY, 0660, $DB_HASH;=0A return { "result" =3D> "NO", "l=
ogmsg" =3D> "File $authdb failed with $!" } =0A unless $dbh;=0A=0A=0A # =
Install database filters - needed to handle \0 line endings.=0A # Note tha=
t the value field will have multiple \0 on the end=0A #=0A $dbh->filter_f=
etch_key ( sub { s/\0$// } ) ;=0A $dbh->filter_store_key ( sub { $_ .=
=3D "\0" } ) ;=0A $dbh->filter_fetch_value( sub { s/\0+$// } ) ;=0A $d=
bh->filter_store_value( sub { $_ .=3D "\0" } ) ;=0A=0A # Need to xor store=
d password with 0xff, per qpopper's default=0A # obfuscation=0A $password=
=3D join("", map { $_ ^ chr(255) } split (/|/, $DB{$user}));=0A=0A=0A # c=
lose up=0A undef $dbh;=0A untie %DB;=0A=0A # Fail if we have a blank pas=
sword, or have no password=0A return { "result" =3D> "NO", "logmsg" =3D> "=
Blank or no password" } =0A unless $password;=0A=0A=0A # password not ma=
tch?=0A if (lc($packet->{digest}) ne =0A lc(Digest::MD5::md5_hex($pac=
ket->{timestamp} . $password))) {=0A return { "result" =3D> "NO", "logms=
g" =3D> "Password does not match" };=0A }=0A=0A=0A # we made it?!=0A=0A =
# we have a couple of alternatives here for uid/gid. Either the main=0A #=
server can be running with root privs, in which case at this point=0A # w=
e either drop to pop:mail or work out what end-user ID we should be=0A # r=
unning as and drop to that. Alternatively, the main server just runs=0A #=
as pop:mail (the mail group ownership is what we need to read/write=0A # =
the maildrop files) and setting this uid/gid will have no effect.=0A #=0A =
# As a todo, we should determine what UID/EUID we're running as and=0A # =
make a determination at that point as to what uid/gid to return to=0A # th=
e calling program.=0A # =0A my ($uid, $gid) =3D ("pop", "mail");=0A=0A m=
y ($domain) =3D $packet->{domain} || "";=0A my ($mboxtype) =3D ("bsd");=0A=
=0A return {=0A result =3D> "YES",=0A uid =3D> $uid,=0A gid =
=3D> $gid,=0A domain =3D> $domain,=0A mailbox =3D> $mailbox,=0A mboxt=
ype =3D> $mboxtype,=0A };=0A=0A=0A}=0A=0A=0A# tpop3d_pass()=0A#=0A# Always=
returns failure since USER/PASS authentication is not supported.=0A# TODO:=
We actually want to avoid calling this procedure since that means=0A# the =
user *attempted* user/pass and thus sent their password over the=0A# networ=
k. tpop3d should be able to intercept the 'user' line and fail=0A# immedia=
tely.=0A#=0A=0Asub tpop3d_pass {=0A return { "result" =3D> "NO" };=0A}=0A=
=0A=0A=0A# habitual=0A1;=0A=0A=0A=
--Boundary_(ID_McsF++OeydWnUyc17wFWDQ)--