[tpop3d-discuss] auth_perl example script (corrected)

Dave Baker dave at dsb3.com
Wed, 26 Jun 2002 20:32:17 -0400

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. 


If anyone wants to give it a code audit, I'd appreciate any feedback.



- Dave Baker  :  dave@dsb3.com  :  dave@devbrain.com  :  http://dsb3.com/ -
GnuPG:  1024D/D7BCA55D / 09CD D148 57DE 711E 6708  B772 0DD4 51D5 D7BC A55D

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=